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

-- | Provides environment for usage with NotifySend.
module Navi.Env.NotifySend
  ( NotifySendEnv (..),
    mkNotifySendEnv,
    naviToNotifySend,
  )
where

import DBus.Notify (UrgencyLevel (..))
import Navi.Config.Types (Config)
import Navi.Data.NaviLog (LogEnv)
import Navi.Data.NaviNote (NaviNote, Timeout (..))
import Navi.Env.Core
  ( Env (MkEnv),
    HasEvents (..),
    HasLogEnv (..),
    HasLogQueue (..),
    HasNoteQueue (..),
  )
import Navi.Prelude

-- | Concrete notify-send environment. Adds the dbus client.
newtype NotifySendEnv = MkNotifySendEnv
  { NotifySendEnv -> Env
coreEnv :: Env
  }

makeFieldLabelsNoPrefix ''NotifySendEnv

instance HasEvents NotifySendEnv where
  getEvents :: NotifySendEnv -> NonEmpty AnyEvent
getEvents = forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (a :: OpticKind).
Is k A_Getter =>
Optic' k is s a -> s -> a
view (forall (a :: OpticKind). IsLabel "coreEnv" a => a
#coreEnv forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "events" a => a
#events)
  {-# INLINEABLE getEvents #-}

instance HasLogEnv NotifySendEnv where
  getLogEnv :: NotifySendEnv -> LogEnv
getLogEnv = forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (a :: OpticKind).
Is k A_Getter =>
Optic' k is s a -> s -> a
view (forall (a :: OpticKind). IsLabel "coreEnv" a => a
#coreEnv forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "logEnv" a => a
#logEnv)
  {-# INLINEABLE getLogEnv #-}
  localLogEnv :: (LogEnv -> LogEnv) -> NotifySendEnv -> NotifySendEnv
localLogEnv = forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over' (forall (a :: OpticKind). IsLabel "coreEnv" a => a
#coreEnv forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "logEnv" a => a
#logEnv)
  {-# INLINEABLE localLogEnv #-}

instance HasLogQueue NotifySendEnv where
  getLogQueue :: NotifySendEnv -> TBQueue LogStr
getLogQueue = forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (a :: OpticKind).
Is k A_Getter =>
Optic' k is s a -> s -> a
view (forall (a :: OpticKind). IsLabel "coreEnv" a => a
#coreEnv forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "logQueue" a => a
#logQueue)
  {-# INLINEABLE getLogQueue #-}

instance HasNoteQueue NotifySendEnv where
  getNoteQueue :: NotifySendEnv -> TBQueue NaviNote
getNoteQueue = forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (a :: OpticKind).
Is k A_Getter =>
Optic' k is s a -> s -> a
view (forall (a :: OpticKind). IsLabel "coreEnv" a => a
#coreEnv forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "noteQueue" a => a
#noteQueue)
  {-# INLINEABLE getNoteQueue #-}

-- | Creates a 'NotifySendEnv' from the provided log types and configuration
-- data.
mkNotifySendEnv ::
  MonadSTM m =>
  LogEnv ->
  Config ->
  m NotifySendEnv
mkNotifySendEnv :: forall (m :: OpticKind -> OpticKind).
MonadSTM m =>
LogEnv -> Config -> m NotifySendEnv
mkNotifySendEnv LogEnv
logEnv Config
config = do
  TBQueue LogStr
logQueue <- forall (m :: OpticKind -> OpticKind) (a :: OpticKind).
(HasCallStack, MonadSTM m) =>
Natural -> m (TBQueue a)
newTBQueueM Natural
1000
  TBQueue NaviNote
noteQueue <- forall (m :: OpticKind -> OpticKind) (a :: OpticKind).
(HasCallStack, MonadSTM m) =>
Natural -> m (TBQueue a)
newTBQueueM Natural
1000
  pure $
    MkNotifySendEnv
      { $sel:coreEnv:MkNotifySendEnv :: Env
coreEnv =
          NonEmpty AnyEvent
-> LogEnv -> TBQueue LogStr -> TBQueue NaviNote -> Env
MkEnv
            (Config
config forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "events" a => a
#events)
            LogEnv
logEnv
            TBQueue LogStr
logQueue
            TBQueue NaviNote
noteQueue
      }
{-# INLINEABLE mkNotifySendEnv #-}

-- | Turns a 'NaviNote' into a string to be sent with the notify-send tool.
naviToNotifySend :: NaviNote -> Text
naviToNotifySend :: NaviNote -> Text
naviToNotifySend NaviNote
naviNote = Text
txt
  where
    txt :: Text
txt =
      Text
"notify-send \""
        forall (a :: OpticKind). Semigroup a => a -> a -> a
<> NaviNote
naviNote forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "summary" a => a
#summary
        forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
"\" "
        forall (a :: OpticKind). Semigroup a => a -> a -> a
<> forall (b :: OpticKind) (a :: OpticKind).
b -> (a -> b) -> Maybe a -> b
maybe Text
"" (\Text
b -> Text
" \"" forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
b forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
"\" ") (NaviNote
naviNote forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "body" a => a
#body)
        forall (a :: OpticKind). Semigroup a => a -> a -> a
<> forall (b :: OpticKind) (a :: OpticKind).
b -> (a -> b) -> Maybe a -> b
maybe Text
"" forall {a :: OpticKind}. IsString a => UrgencyLevel -> a
ulToNS (NaviNote
naviNote forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "urgency" a => a
#urgency)
        forall (a :: OpticKind). Semigroup a => a -> a -> a
<> forall (b :: OpticKind) (a :: OpticKind).
b -> (a -> b) -> Maybe a -> b
maybe Text
"" Timeout -> Text
timeoutToNS (NaviNote
naviNote forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "timeout" a => a
#timeout)

    ulToNS :: UrgencyLevel -> a
ulToNS UrgencyLevel
Low = a
" --urgency low "
    ulToNS UrgencyLevel
Normal = a
" --urgency normal "
    ulToNS UrgencyLevel
Critical = a
" --urgency critical "

    timeoutToNS :: Timeout -> Text
timeoutToNS Timeout
Never = Text
""
    timeoutToNS (Seconds Word16
s) =
      String -> Text
pack forall (a :: OpticKind) b. (a -> b) -> a -> b
$
        String
" --expire-time "
          forall (a :: OpticKind). Semigroup a => a -> a -> a
<> forall (a :: OpticKind). Show a => a -> String
show (Word16
s forall (a :: OpticKind). Num a => a -> a -> a
* Word16
1_000)
          forall (a :: OpticKind). Semigroup a => a -> a -> a
<> String
" "
{-# INLINEABLE naviToNotifySend #-}