{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Provides the 'NaviNote' type, representing notifications.
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)

-- | Determines how long a notification persists.
--
-- @since 0.1
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)

-- | @since 0.1
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

-- | TOML decoder for optional 'Timeout' with field name "timeout".
--
-- @since 0.1
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"

-- | 'NaviNote' represents desktop notifications.
--
-- @since 0.1
data NaviNote = MkNaviNote
  { -- | Text summary.
    NaviNote -> Text
summary :: Text,
    -- | Text body.
    NaviNote -> Maybe Text
body :: Maybe Text,
    -- | Urgency (e.g. low, critical)
    NaviNote -> Maybe UrgencyLevel
urgency :: Maybe UrgencyLevel,
    -- | Determines how long the notification stays on-screen.
    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

-- | @since 0.1
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)