{-# LANGUAGE UndecidableInstances #-}

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

import Data.Text qualified as T
import Effects.Notify qualified as Notify
import Shrun.Configuration.Env.Types
  ( HasAnyError,
    HasCommands,
    HasLogging,
    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 (withRegion))
import Shrun.Logging.Types
  ( Log (MkLog, cmd, lvl, mode, msg),
    LogLevel (LevelError),
    LogMode (LogModeFinish),
  )
import Shrun.Logging.Types qualified as Types
import Shrun.Prelude
import Shrun.Utils qualified as U

newtype NotifyMessage = UnsafeNotifyMessage {NotifyMessage -> Text
unNotifyMessage :: Text}
  deriving stock (NotifyMessage -> NotifyMessage -> Bool
(NotifyMessage -> NotifyMessage -> Bool)
-> (NotifyMessage -> NotifyMessage -> Bool) -> Eq NotifyMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NotifyMessage -> NotifyMessage -> Bool
== :: NotifyMessage -> NotifyMessage -> Bool
$c/= :: NotifyMessage -> NotifyMessage -> Bool
/= :: NotifyMessage -> NotifyMessage -> Bool
Eq, Int -> NotifyMessage -> ShowS
[NotifyMessage] -> ShowS
NotifyMessage -> String
(Int -> NotifyMessage -> ShowS)
-> (NotifyMessage -> String)
-> ([NotifyMessage] -> ShowS)
-> Show NotifyMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NotifyMessage -> ShowS
showsPrec :: Int -> NotifyMessage -> ShowS
$cshow :: NotifyMessage -> String
show :: NotifyMessage -> String
$cshowList :: [NotifyMessage] -> ShowS
showList :: [NotifyMessage] -> ShowS
Show)
  deriving newtype (String -> NotifyMessage
(String -> NotifyMessage) -> IsString NotifyMessage
forall a. (String -> a) -> IsString a
$cfromString :: String -> NotifyMessage
fromString :: String -> NotifyMessage
IsString)

instance
  ( k ~ A_Getter,
    a ~ Text,
    b ~ Text
  ) =>
  LabelOptic "unNotifyMessage" k NotifyMessage NotifyMessage a b
  where
  labelOptic :: Optic k NoIx NotifyMessage NotifyMessage a b
labelOptic = (NotifyMessage -> a) -> Getter NotifyMessage a
forall s a. (s -> a) -> Getter s a
to (\(UnsafeNotifyMessage Text
x) -> a
Text
x)
  {-# INLINE labelOptic #-}

fromUnlined :: UnlinedText -> NotifyMessage
fromUnlined :: UnlinedText -> NotifyMessage
fromUnlined = Text -> NotifyMessage
UnsafeNotifyMessage (Text -> NotifyMessage)
-> (UnlinedText -> Text) -> UnlinedText -> NotifyMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Optic' A_Getter NoIx UnlinedText Text -> UnlinedText -> Text
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Getter NoIx UnlinedText Text
#unUnlinedText

-- | Sends a notification if they are With (linux only). Logs any failed
-- sends.
sendNotif ::
  forall m env notifyEnv.
  ( HasAnyError env,
    HasCallStack,
    HasCommands env,
    HasLogging env m,
    HasNotifyConfig env notifyEnv,
    MonadAtomic m,
    MonadCatch m,
    MonadNotify m,
    MonadReader env m,
    MonadRegionLogger m,
    MonadTime m,
    NotifyEnvF m ~ notifyEnv
  ) =>
  -- | Notif summary
  NotifyMessage ->
  -- | Notif body
  NotifyMessage ->
  -- | Notif urgency
  NotifyUrgency ->
  m ()
sendNotif :: forall (m :: Type -> Type) env notifyEnv.
(HasAnyError env, HasCallStack, HasCommands env, HasLogging env m,
 HasNotifyConfig env notifyEnv, MonadAtomic m, MonadCatch m,
 MonadNotify m, MonadReader env m, MonadRegionLogger m, MonadTime m,
 NotifyEnvF m ~ notifyEnv) =>
NotifyMessage -> NotifyMessage -> NotifyUrgency -> m ()
sendNotif NotifyMessage
summary NotifyMessage
body NotifyUrgency
urgency = do
  (env -> Maybe (NotificationEnv notifyEnv))
-> m (Maybe (NotificationEnv notifyEnv))
forall r (m :: Type -> Type) a. MonadReader r m => (r -> a) -> m a
asks (forall env r.
HasNotifyConfig env r =>
env -> Maybe (NotificationEnv r)
getNotifyConfig @env @notifyEnv) m (Maybe (NotificationEnv notifyEnv))
-> (Maybe (NotificationEnv notifyEnv) -> 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 (NotificationEnv notifyEnv)
Nothing -> () -> m ()
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()
    Just NotificationEnv notifyEnv
notifyConfig ->
      notifyEnv -> NotifyTimeout -> m ()
notifyWithErrorLogging
        (NotificationEnv notifyEnv
notifyConfig NotificationEnv notifyEnv
-> Optic' A_Lens NoIx (NotificationEnv notifyEnv) notifyEnv
-> notifyEnv
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (NotificationEnv notifyEnv) notifyEnv
#system)
        (NotificationEnv notifyEnv
notifyConfig NotificationEnv notifyEnv
-> Optic' A_Lens NoIx (NotificationEnv notifyEnv) NotifyTimeout
-> NotifyTimeout
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (NotificationEnv notifyEnv) NotifyTimeout
#timeout)
  where
    notifyWithErrorLogging :: notifyEnv -> NotifyTimeout -> m ()
notifyWithErrorLogging notifyEnv
notifyEnv NotifyTimeout
timeout =
      NotifyEnvF m -> Note -> m (Maybe NotifyException)
forall (m :: Type -> Type).
(HasCallStack, MonadCatch m, MonadNotify m) =>
NotifyEnvF m -> Note -> m (Maybe NotifyException)
Notify.tryNonFatalNotify notifyEnv
NotifyEnvF m
notifyEnv (NotifyTimeout -> Note
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, HasCommandLogging env, HasCommands env,
 MonadAtomic 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, MonadAtomic m,
 MonadReader env m) =>
m ()
setAnyErrorTrue
      Region m -> Log -> m ()
forall (m :: Type -> Type) env.
(HasCallStack, HasCommands env, HasLogging env m, MonadAtomic m,
 MonadReader env 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 :: LogMessage
msg =
              UnlinedText -> LogMessage
Types.fromUnlined
                (UnlinedText -> LogMessage) -> UnlinedText -> LogMessage
forall a b. (a -> b) -> a -> b
$ 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 -> Note
mkNote NotifyTimeout
timeout =
      Text -> Note
Notify.mkNote (NotifyMessage
summary NotifyMessage -> Optic' A_Getter NoIx NotifyMessage Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Getter NoIx NotifyMessage Text
#unNotifyMessage)
        Note -> (Note -> Note) -> Note
forall a b. a -> (a -> b) -> b
& Maybe Text -> Note -> Note
Notify.setBody (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ NotifyMessage
body NotifyMessage -> Optic' A_Getter NoIx NotifyMessage Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Getter NoIx NotifyMessage Text
#unNotifyMessage)
        Note -> (Note -> Note) -> Note
forall a b. a -> (a -> b) -> b
& Maybe NotifyTimeout -> Note -> Note
Notify.setTimeout (NotifyTimeout -> Maybe NotifyTimeout
forall a. a -> Maybe a
Just NotifyTimeout
timeout)
        Note -> (Note -> Note) -> Note
forall a b. a -> (a -> b) -> b
& Maybe Text -> Note -> Note
Notify.setTitle (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Shrun")
        Note -> (Note -> Note) -> Note
forall a b. a -> (a -> b) -> b
& Maybe NotifyUrgency -> Note -> Note
Notify.setUrgency (NotifyUrgency -> Maybe NotifyUrgency
forall a. a -> Maybe a
Just NotifyUrgency
urgency)

formatNotifyMessage :: UnlinedText -> [UnlinedText] -> NotifyMessage
formatNotifyMessage :: UnlinedText -> [UnlinedText] -> NotifyMessage
formatNotifyMessage UnlinedText
timeTxt [UnlinedText]
messages =
  Text -> NotifyMessage
UnsafeNotifyMessage
    (Text -> NotifyMessage)
-> ([UnlinedText] -> Text) -> [UnlinedText] -> NotifyMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> [Text] -> Text
T.intercalate Text
"\n"
    ([Text] -> Text)
-> ([UnlinedText] -> [Text]) -> [UnlinedText] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (UnlinedText -> Text) -> [UnlinedText] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Text
U.stripControlAll (Text -> Text) -> (UnlinedText -> Text) -> UnlinedText -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Optic' A_Getter NoIx UnlinedText Text -> UnlinedText -> Text
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Getter NoIx UnlinedText Text
#unUnlinedText)
    ([UnlinedText] -> NotifyMessage) -> [UnlinedText] -> NotifyMessage
forall a b. (a -> b) -> a -> b
$ UnlinedText
timeTxt
    UnlinedText -> [UnlinedText] -> [UnlinedText]
forall a. a -> [a] -> [a]
: [UnlinedText]
messages