{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}
module Navi.Data.NaviNote
( NaviNote (..),
urgencyLevelOptDecoder,
Timeout (..),
timeoutOptDecoder,
replaceOut,
)
where
import DBus.Notify (UrgencyLevel)
import Data.Bits (toIntegralSized)
import Data.Text qualified as T
import Navi.Prelude
import Navi.Utils (urgencyLevelOptDecoder)
data Timeout
= Never
| Seconds Word16
deriving stock (Timeout -> Timeout -> Bool
(Timeout -> Timeout -> Bool)
-> (Timeout -> Timeout -> Bool) -> Eq Timeout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Timeout -> Timeout -> Bool
== :: Timeout -> Timeout -> Bool
$c/= :: Timeout -> Timeout -> Bool
/= :: Timeout -> Timeout -> Bool
Eq, Eq Timeout
Eq Timeout =>
(Timeout -> Timeout -> Ordering)
-> (Timeout -> Timeout -> Bool)
-> (Timeout -> Timeout -> Bool)
-> (Timeout -> Timeout -> Bool)
-> (Timeout -> Timeout -> Bool)
-> (Timeout -> Timeout -> Timeout)
-> (Timeout -> Timeout -> Timeout)
-> Ord Timeout
Timeout -> Timeout -> Bool
Timeout -> Timeout -> Ordering
Timeout -> Timeout -> Timeout
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Timeout -> Timeout -> Ordering
compare :: Timeout -> Timeout -> Ordering
$c< :: Timeout -> Timeout -> Bool
< :: Timeout -> Timeout -> Bool
$c<= :: Timeout -> Timeout -> Bool
<= :: Timeout -> Timeout -> Bool
$c> :: Timeout -> Timeout -> Bool
> :: Timeout -> Timeout -> Bool
$c>= :: Timeout -> Timeout -> Bool
>= :: Timeout -> Timeout -> Bool
$cmax :: Timeout -> Timeout -> Timeout
max :: Timeout -> Timeout -> Timeout
$cmin :: Timeout -> Timeout -> Timeout
min :: Timeout -> Timeout -> Timeout
Ord, Int -> Timeout -> ShowS
[Timeout] -> ShowS
Timeout -> String
(Int -> Timeout -> ShowS)
-> (Timeout -> String) -> ([Timeout] -> ShowS) -> Show Timeout
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Timeout -> ShowS
showsPrec :: Int -> Timeout -> ShowS
$cshow :: Timeout -> String
show :: Timeout -> String
$cshowList :: [Timeout] -> ShowS
showList :: [Timeout] -> ShowS
Show)
instance DecodeTOML Timeout where
tomlDecoder :: Decoder Timeout
tomlDecoder = (Value -> DecodeM Timeout) -> Decoder Timeout
forall a. (Value -> DecodeM a) -> Decoder a
makeDecoder ((Value -> DecodeM Timeout) -> Decoder Timeout)
-> (Value -> DecodeM Timeout) -> Decoder Timeout
forall a b. (a -> b) -> a -> b
$ \case
String Text
"never" -> Timeout -> DecodeM Timeout
forall a. a -> DecodeM a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Timeout
Never
String Text
bad -> Text -> Value -> DecodeM Timeout
forall a. Text -> Value -> DecodeM a
invalidValue Text
strErr (Text -> Value
String Text
bad)
Integer Integer
i -> case Integer -> Maybe Word16
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
toIntegralSized Integer
i of
Just Word16
i' -> Timeout -> DecodeM Timeout
forall a. a -> DecodeM a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Timeout -> DecodeM Timeout) -> Timeout -> DecodeM Timeout
forall a b. (a -> b) -> a -> b
$ Word16 -> Timeout
Seconds Word16
i'
Maybe Word16
Nothing -> Text -> Value -> DecodeM Timeout
forall a. Text -> Value -> DecodeM a
invalidValue Text
tooLargeErr (Integer -> Value
Integer Integer
i)
Value
badTy -> Value -> DecodeM Timeout
forall a. Value -> DecodeM a
typeMismatch Value
badTy
where
tooLargeErr :: Text
tooLargeErr = Text
"Timeout integer too large. Max is: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word16 -> Text
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 = Decoder Timeout -> Text -> Decoder (Maybe Timeout)
forall a. Decoder a -> Text -> Decoder (Maybe a)
getFieldOptWith Decoder Timeout
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
(NaviNote -> NaviNote -> Bool)
-> (NaviNote -> NaviNote -> Bool) -> Eq NaviNote
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NaviNote -> NaviNote -> Bool
== :: NaviNote -> NaviNote -> Bool
$c/= :: NaviNote -> NaviNote -> Bool
/= :: NaviNote -> NaviNote -> Bool
Eq, Eq NaviNote
Eq NaviNote =>
(NaviNote -> NaviNote -> Ordering)
-> (NaviNote -> NaviNote -> Bool)
-> (NaviNote -> NaviNote -> Bool)
-> (NaviNote -> NaviNote -> Bool)
-> (NaviNote -> NaviNote -> Bool)
-> (NaviNote -> NaviNote -> NaviNote)
-> (NaviNote -> NaviNote -> NaviNote)
-> Ord NaviNote
NaviNote -> NaviNote -> Bool
NaviNote -> NaviNote -> Ordering
NaviNote -> NaviNote -> NaviNote
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: NaviNote -> NaviNote -> Ordering
compare :: NaviNote -> NaviNote -> Ordering
$c< :: NaviNote -> NaviNote -> Bool
< :: NaviNote -> NaviNote -> Bool
$c<= :: NaviNote -> NaviNote -> Bool
<= :: NaviNote -> NaviNote -> Bool
$c> :: NaviNote -> NaviNote -> Bool
> :: NaviNote -> NaviNote -> Bool
$c>= :: NaviNote -> NaviNote -> Bool
>= :: NaviNote -> NaviNote -> Bool
$cmax :: NaviNote -> NaviNote -> NaviNote
max :: NaviNote -> NaviNote -> NaviNote
$cmin :: NaviNote -> NaviNote -> NaviNote
min :: NaviNote -> NaviNote -> NaviNote
Ord, Int -> NaviNote -> ShowS
[NaviNote] -> ShowS
NaviNote -> String
(Int -> NaviNote -> ShowS)
-> (NaviNote -> String) -> ([NaviNote] -> ShowS) -> Show NaviNote
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NaviNote -> ShowS
showsPrec :: Int -> NaviNote -> ShowS
$cshow :: NaviNote -> String
show :: NaviNote -> String
$cshowList :: [NaviNote] -> ShowS
showList :: [NaviNote] -> ShowS
Show)
makeFieldLabelsNoPrefix ''NaviNote
instance DecodeTOML NaviNote where
tomlDecoder :: Decoder NaviNote
tomlDecoder =
Text
-> Maybe Text -> Maybe UrgencyLevel -> Maybe Timeout -> NaviNote
MkNaviNote
(Text
-> Maybe Text -> Maybe UrgencyLevel -> Maybe Timeout -> NaviNote)
-> Decoder Text
-> Decoder
(Maybe Text -> Maybe UrgencyLevel -> Maybe Timeout -> NaviNote)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Decoder Text
forall a. DecodeTOML a => Text -> Decoder a
getField Text
"summary"
Decoder
(Maybe Text -> Maybe UrgencyLevel -> Maybe Timeout -> NaviNote)
-> Decoder (Maybe Text)
-> Decoder (Maybe UrgencyLevel -> Maybe Timeout -> NaviNote)
forall a b. Decoder (a -> b) -> Decoder a -> Decoder b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Text -> Decoder (Maybe Text)
forall a. DecodeTOML a => Text -> Decoder (Maybe a)
getFieldOpt Text
"body"
Decoder (Maybe UrgencyLevel -> Maybe Timeout -> NaviNote)
-> Decoder (Maybe UrgencyLevel)
-> Decoder (Maybe Timeout -> NaviNote)
forall a b. Decoder (a -> b) -> Decoder a -> Decoder b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Decoder (Maybe UrgencyLevel)
urgencyLevelOptDecoder
Decoder (Maybe Timeout -> NaviNote)
-> Decoder (Maybe Timeout) -> Decoder NaviNote
forall a b. Decoder (a -> b) -> Decoder a -> Decoder b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Decoder (Maybe Timeout)
timeoutOptDecoder
replaceOut :: Text -> NaviNote -> NaviNote
replaceOut :: Text -> NaviNote -> NaviNote
replaceOut Text
outVal = Optic An_AffineTraversal NoIx NaviNote NaviNote Text Text
-> (Text -> Text) -> NaviNote -> NaviNote
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over' (Optic A_Lens NoIx NaviNote NaviNote (Maybe Text) (Maybe Text)
#body Optic A_Lens NoIx NaviNote NaviNote (Maybe Text) (Maybe Text)
-> Optic A_Prism NoIx (Maybe Text) (Maybe Text) Text Text
-> Optic An_AffineTraversal NoIx NaviNote NaviNote Text Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx (Maybe Text) (Maybe Text) Text Text
forall a b. Prism (Maybe a) (Maybe b) a b
_Just) (HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"$out" Text
outVal)