{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}
module Navi.Data.NaviNote
( NaviNote (..),
Timeout (..),
_Never,
_Seconds,
timeoutOptDecoder,
)
where
import DBus.Notify (UrgencyLevel (..))
import Data.Bits (toIntegralSized)
import Navi.Prelude
import Navi.Utils (urgencyLevelOptDecoder)
data Timeout
= Never
| Seconds !Word16
deriving stock (Timeout -> Timeout -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Timeout -> Timeout -> Bool
$c/= :: Timeout -> Timeout -> Bool
== :: Timeout -> Timeout -> Bool
$c== :: Timeout -> Timeout -> Bool
Eq, Int -> Timeout -> ShowS
[Timeout] -> ShowS
Timeout -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Timeout] -> ShowS
$cshowList :: [Timeout] -> ShowS
show :: Timeout -> String
$cshow :: Timeout -> String
showsPrec :: Int -> Timeout -> ShowS
$cshowsPrec :: Int -> Timeout -> ShowS
Show)
makePrisms ''Timeout
instance DecodeTOML Timeout where
tomlDecoder :: Decoder Timeout
tomlDecoder = forall a. (Value -> DecodeM a) -> Decoder a
makeDecoder forall a b. (a -> b) -> a -> b
$ \case
String Text
"never" -> forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Timeout
Never
String Text
bad -> forall a. Text -> Value -> DecodeM a
invalidValue Text
strErr (Text -> Value
String Text
bad)
Integer Integer
i -> case forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
toIntegralSized Integer
i of
Just Word16
i' -> forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Word16 -> Timeout
Seconds Word16
i'
Maybe Word16
Nothing -> forall a. Text -> Value -> DecodeM a
invalidValue Text
tooLargeErr (Integer -> Value
Integer Integer
i)
Value
badTy -> forall a. Value -> DecodeM a
typeMismatch Value
badTy
where
tooLargeErr :: Text
tooLargeErr = Text
"Timeout integer too large. Max is: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt Word16
maxW16
strErr :: Text
strErr = Text
"Unexpected timeout. Only valid string is 'never'."
maxW16 :: Word16
maxW16 = forall a. Bounded a => a
maxBound @Word16
timeoutOptDecoder :: Decoder (Maybe Timeout)
timeoutOptDecoder :: Decoder (Maybe Timeout)
timeoutOptDecoder = forall a. Decoder a -> Text -> Decoder (Maybe a)
getFieldOptWith forall a. DecodeTOML a => Decoder a
tomlDecoder Text
"timeout"
data NaviNote = MkNaviNote
{
NaviNote -> Text
summary :: !Text,
NaviNote -> Maybe Text
body :: !(Maybe Text),
NaviNote -> Maybe UrgencyLevel
urgency :: !(Maybe UrgencyLevel),
NaviNote -> Maybe Timeout
timeout :: !(Maybe Timeout)
}
deriving stock (NaviNote -> NaviNote -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NaviNote -> NaviNote -> Bool
$c/= :: NaviNote -> NaviNote -> Bool
== :: NaviNote -> NaviNote -> Bool
$c== :: NaviNote -> NaviNote -> Bool
Eq, Int -> NaviNote -> ShowS
[NaviNote] -> ShowS
NaviNote -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NaviNote] -> ShowS
$cshowList :: [NaviNote] -> ShowS
show :: NaviNote -> String
$cshow :: NaviNote -> String
showsPrec :: Int -> NaviNote -> ShowS
$cshowsPrec :: Int -> NaviNote -> ShowS
Show)
makeFieldLabelsNoPrefix ''NaviNote
instance DecodeTOML NaviNote where
tomlDecoder :: Decoder NaviNote
tomlDecoder =
Text
-> Maybe Text -> Maybe UrgencyLevel -> Maybe Timeout -> NaviNote
MkNaviNote
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. DecodeTOML a => Text -> Decoder a
getField Text
"summary"
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> forall a. DecodeTOML a => Text -> Decoder (Maybe a)
getFieldOpt Text
"body"
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Decoder (Maybe UrgencyLevel)
urgencyLevelOptDecoder
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Decoder (Maybe Timeout)
timeoutOptDecoder