-- | Module for sending notifications.
module Shrun.Notify
  ( sendNotif,
  )
where

import DBus.Notify (UrgencyLevel)
import Shrun.Configuration.Env.Types
  ( HasAnyError,
    HasCommonLogging,
    HasConsoleLogging,
    HasFileLogging,
    HasNotifyConfig (getNotifyConfig),
    setAnyErrorTrue,
  )
import Shrun.Data.Text (UnlinedText)
import Shrun.Data.Text qualified as ShrunText
import Shrun.Logging qualified as Logging
import Shrun.Logging.MonadRegionLogger (MonadRegionLogger (Region, withRegion))
import Shrun.Logging.Types
  ( Log (MkLog, cmd, lvl, mode, msg),
    LogLevel (LevelError),
    LogMode (LogModeFinish),
  )
import Shrun.Notify.MonadNotify
  ( MonadNotify (notify),
    ShrunNote (MkShrunNote, body, summary, timeout, urgency),
  )
import Shrun.Prelude

-- | Sends a notification if they are enabled (linux only). Logs any failed
-- sends.
sendNotif ::
  ( HasAnyError env,
    HasCallStack,
    HasCommonLogging env,
    HasConsoleLogging env (Region m),
    HasFileLogging env,
    HasNotifyConfig env,
    MonadNotify m,
    MonadReader env m,
    MonadRegionLogger m,
    MonadSTM m,
    MonadTime m
  ) =>
  -- | Notif summary
  UnlinedText ->
  -- | Notif body
  UnlinedText ->
  -- | Notif urgency
  UrgencyLevel ->
  m ()
sendNotif :: forall env (m :: Type -> Type).
(HasAnyError env, HasCallStack, HasCommonLogging env,
 HasConsoleLogging env (Region m), HasFileLogging env,
 HasNotifyConfig env, MonadNotify m, MonadReader env m,
 MonadRegionLogger m, MonadSTM m, MonadTime m) =>
UnlinedText -> UnlinedText -> UrgencyLevel -> m ()
sendNotif UnlinedText
summary UnlinedText
body UrgencyLevel
urgency = do
  Maybe NotifyEnv
cfg <- (env -> Maybe NotifyEnv) -> m (Maybe NotifyEnv)
forall r (m :: Type -> Type) a. MonadReader r m => (r -> a) -> m a
asks env -> Maybe NotifyEnv
forall env. HasNotifyConfig env => env -> Maybe NotifyEnv
getNotifyConfig
  (NotifyTimeout -> m ()) -> Maybe NotifyTimeout -> m ()
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ NotifyTimeout -> m ()
notifyWithErrorLogging (Maybe NotifyEnv
cfg Maybe NotifyEnv
-> Optic' An_AffineTraversal NoIx (Maybe NotifyEnv) NotifyTimeout
-> Maybe NotifyTimeout
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? (Prism (Maybe NotifyEnv) (Maybe NotifyEnv) NotifyEnv NotifyEnv
forall a b. Prism (Maybe a) (Maybe b) a b
_Just Prism (Maybe NotifyEnv) (Maybe NotifyEnv) NotifyEnv NotifyEnv
-> Optic
     A_Lens NoIx NotifyEnv NotifyEnv NotifyTimeout NotifyTimeout
-> Optic' An_AffineTraversal NoIx (Maybe NotifyEnv) NotifyTimeout
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_Lens NoIx NotifyEnv NotifyEnv NotifyTimeout NotifyTimeout
#timeout))
  where
    notifyWithErrorLogging :: NotifyTimeout -> m ()
notifyWithErrorLogging NotifyTimeout
timeout =
      ShrunNote -> m (Maybe NotifyException)
forall (m :: Type -> Type).
(MonadNotify m, HasCallStack) =>
ShrunNote -> m (Maybe NotifyException)
notify (NotifyTimeout -> ShrunNote
mkNote NotifyTimeout
timeout) m (Maybe NotifyException)
-> (Maybe NotifyException -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe NotifyException
Nothing -> () -> m ()
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()
        Just NotifyException
notifyEx -> RegionLayout -> (Region m -> m ()) -> m ()
forall a. HasCallStack => RegionLayout -> (Region m -> m a) -> m a
forall (m :: Type -> Type) a.
(MonadRegionLogger m, HasCallStack) =>
RegionLayout -> (Region m -> m a) -> m a
withRegion RegionLayout
Linear (NotifyException -> Region m -> m ()
forall {env} {m :: Type -> Type} {e}.
(HasFileLogging env, HasConsoleLogging env (Region m),
 HasCommonLogging env, MonadSTM m, HasAnyError env,
 MonadReader env m, MonadTime m, Exception e) =>
e -> Region m -> m ()
logEx NotifyException
notifyEx)

    logEx :: e -> Region m -> m ()
logEx e
ex Region m
r = do
      -- set exit code
      m ()
forall env (m :: Type -> Type).
(HasAnyError env, HasCallStack, MonadReader env m, MonadSTM m) =>
m ()
setAnyErrorTrue
      Region m -> Log -> m ()
forall env (m :: Type -> Type).
(HasCallStack, HasCommonLogging env,
 HasConsoleLogging env (Region m), HasFileLogging env,
 MonadReader env m, MonadSTM m, MonadTime m) =>
Region m -> Log -> m ()
Logging.putRegionLog Region m
r
        (Log -> m ()) -> Log -> m ()
forall a b. (a -> b) -> a -> b
$ MkLog
          { cmd :: Maybe CommandP1
cmd = Maybe CommandP1
forall a. Maybe a
Nothing,
            msg :: UnlinedText
msg =
              UnlinedText
"Could not send notification: "
                UnlinedText -> UnlinedText -> UnlinedText
forall a. Semigroup a => a -> a -> a
<> Text -> UnlinedText
ShrunText.fromTextReplace (String -> Text
pack (e -> String
forall e. Exception e => e -> String
displayException e
ex)),
            lvl :: LogLevel
lvl = LogLevel
LevelError,
            mode :: LogMode
mode = LogMode
LogModeFinish
          }
    mkNote :: NotifyTimeout -> ShrunNote
mkNote NotifyTimeout
timeout =
      MkShrunNote
        { UnlinedText
summary :: UnlinedText
summary :: UnlinedText
summary,
          UnlinedText
body :: UnlinedText
body :: UnlinedText
body,
          UrgencyLevel
urgency :: UrgencyLevel
urgency :: UrgencyLevel
urgency,
          NotifyTimeout
timeout :: NotifyTimeout
timeout :: NotifyTimeout
timeout
        }