{-# LANGUAGE UndecidableInstances #-}

-- | Provides effects for sending notifications.
module Shrun.Notify.MonadNotify
  ( MonadNotify (..),
    ShrunNote (..),
    NotifyException (..),
    exitFailureToStderr,
  )
where

import DBus.Notify (UrgencyLevel)
import Data.ByteString.Lazy qualified as BSL
import Data.Text qualified as T
import Shrun.Data.Text (UnlinedText)
import Shrun.Notify.Types
  ( NotifySystemMerged,
    NotifyTimeout,
    displayNotifySystem,
  )
import Shrun.Prelude

-- | Holds notification data.
data ShrunNote = MkShrunNote
  { ShrunNote -> UnlinedText
summary :: UnlinedText,
    ShrunNote -> UnlinedText
body :: UnlinedText,
    ShrunNote -> UrgencyLevel
urgency :: UrgencyLevel,
    ShrunNote -> NotifyTimeout
timeout :: NotifyTimeout
  }
  deriving stock (ShrunNote -> ShrunNote -> Bool
(ShrunNote -> ShrunNote -> Bool)
-> (ShrunNote -> ShrunNote -> Bool) -> Eq ShrunNote
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ShrunNote -> ShrunNote -> Bool
== :: ShrunNote -> ShrunNote -> Bool
$c/= :: ShrunNote -> ShrunNote -> Bool
/= :: ShrunNote -> ShrunNote -> Bool
Eq, Int -> ShrunNote -> ShowS
[ShrunNote] -> ShowS
ShrunNote -> String
(Int -> ShrunNote -> ShowS)
-> (ShrunNote -> String)
-> ([ShrunNote] -> ShowS)
-> Show ShrunNote
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ShrunNote -> ShowS
showsPrec :: Int -> ShrunNote -> ShowS
$cshow :: ShrunNote -> String
show :: ShrunNote -> String
$cshowList :: [ShrunNote] -> ShowS
showList :: [ShrunNote] -> ShowS
Show)

instance
  ( k ~ A_Lens,
    a ~ UnlinedText,
    b ~ UnlinedText
  ) =>
  LabelOptic "summary" k ShrunNote ShrunNote a b
  where
  labelOptic :: Optic k NoIx ShrunNote ShrunNote a b
labelOptic =
    LensVL ShrunNote ShrunNote a b -> Lens ShrunNote ShrunNote a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL
      (LensVL ShrunNote ShrunNote a b -> Lens ShrunNote ShrunNote a b)
-> LensVL ShrunNote ShrunNote a b -> Lens ShrunNote ShrunNote a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f
         (MkShrunNote UnlinedText
_summary UnlinedText
_body UrgencyLevel
_urgency NotifyTimeout
_timeout) ->
          (UnlinedText -> ShrunNote) -> f UnlinedText -> f ShrunNote
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap
            (\UnlinedText
summary' -> UnlinedText
-> UnlinedText -> UrgencyLevel -> NotifyTimeout -> ShrunNote
MkShrunNote UnlinedText
summary' UnlinedText
_body UrgencyLevel
_urgency NotifyTimeout
_timeout)
            (a -> f b
f a
UnlinedText
_summary)
  {-# INLINE labelOptic #-}

instance
  ( k ~ A_Lens,
    a ~ UrgencyLevel,
    b ~ UrgencyLevel
  ) =>
  LabelOptic "urgency" k ShrunNote ShrunNote a b
  where
  labelOptic :: Optic k NoIx ShrunNote ShrunNote a b
labelOptic =
    LensVL ShrunNote ShrunNote a b -> Lens ShrunNote ShrunNote a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL
      (LensVL ShrunNote ShrunNote a b -> Lens ShrunNote ShrunNote a b)
-> LensVL ShrunNote ShrunNote a b -> Lens ShrunNote ShrunNote a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f
         (MkShrunNote UnlinedText
_summary UnlinedText
_body UrgencyLevel
_urgency NotifyTimeout
_timeout) ->
          (UrgencyLevel -> ShrunNote) -> f UrgencyLevel -> f ShrunNote
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap
            (\UrgencyLevel
urgency' -> UnlinedText
-> UnlinedText -> UrgencyLevel -> NotifyTimeout -> ShrunNote
MkShrunNote UnlinedText
_summary UnlinedText
_body UrgencyLevel
urgency' NotifyTimeout
_timeout)
            (a -> f b
f a
UrgencyLevel
_urgency)
  {-# INLINE labelOptic #-}

instance
  ( k ~ A_Lens,
    a ~ NotifyTimeout,
    b ~ NotifyTimeout
  ) =>
  LabelOptic "timeout" k ShrunNote ShrunNote a b
  where
  labelOptic :: Optic k NoIx ShrunNote ShrunNote a b
labelOptic =
    LensVL ShrunNote ShrunNote a b -> Lens ShrunNote ShrunNote a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL
      (LensVL ShrunNote ShrunNote a b -> Lens ShrunNote ShrunNote a b)
-> LensVL ShrunNote ShrunNote a b -> Lens ShrunNote ShrunNote a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f
         (MkShrunNote UnlinedText
_summary UnlinedText
_body UrgencyLevel
_urgency NotifyTimeout
_timeout) ->
          (NotifyTimeout -> ShrunNote) -> f NotifyTimeout -> f ShrunNote
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap
            (UnlinedText
-> UnlinedText -> UrgencyLevel -> NotifyTimeout -> ShrunNote
MkShrunNote UnlinedText
_summary UnlinedText
_body UrgencyLevel
_urgency)
            (a -> f b
f a
NotifyTimeout
_timeout)
  {-# INLINE labelOptic #-}

instance
  ( k ~ A_Lens,
    a ~ UnlinedText,
    b ~ UnlinedText
  ) =>
  LabelOptic "body" k ShrunNote ShrunNote a b
  where
  labelOptic :: Optic k NoIx ShrunNote ShrunNote a b
labelOptic =
    LensVL ShrunNote ShrunNote a b -> Lens ShrunNote ShrunNote a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL
      (LensVL ShrunNote ShrunNote a b -> Lens ShrunNote ShrunNote a b)
-> LensVL ShrunNote ShrunNote a b -> Lens ShrunNote ShrunNote a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f
         (MkShrunNote UnlinedText
_summary UnlinedText
_body UrgencyLevel
_urgency NotifyTimeout
_timeout) ->
          (UnlinedText -> ShrunNote) -> f UnlinedText -> f ShrunNote
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap
            (\UnlinedText
body' -> UnlinedText
-> UnlinedText -> UrgencyLevel -> NotifyTimeout -> ShrunNote
MkShrunNote UnlinedText
_summary UnlinedText
body' UrgencyLevel
_urgency NotifyTimeout
_timeout)
            (a -> f b
f a
UnlinedText
_body)
  {-# INLINE labelOptic #-}

-- | Exception for sending desktop notifications.
data NotifyException = MkNotifyException ShrunNote NotifySystemMerged Text
  deriving stock (NotifyException -> NotifyException -> Bool
(NotifyException -> NotifyException -> Bool)
-> (NotifyException -> NotifyException -> Bool)
-> Eq NotifyException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NotifyException -> NotifyException -> Bool
== :: NotifyException -> NotifyException -> Bool
$c/= :: NotifyException -> NotifyException -> Bool
/= :: NotifyException -> NotifyException -> Bool
Eq, Int -> NotifyException -> ShowS
[NotifyException] -> ShowS
NotifyException -> String
(Int -> NotifyException -> ShowS)
-> (NotifyException -> String)
-> ([NotifyException] -> ShowS)
-> Show NotifyException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NotifyException -> ShowS
showsPrec :: Int -> NotifyException -> ShowS
$cshow :: NotifyException -> String
show :: NotifyException -> String
$cshowList :: [NotifyException] -> ShowS
showList :: [NotifyException] -> ShowS
Show)

instance Exception NotifyException where
  displayException :: NotifyException -> String
displayException (MkNotifyException ShrunNote
note NotifySystemMerged
system Text
message) =
    [String] -> String
forall a. Monoid a => [a] -> a
mconcat
      [ String
"Exception sending notification with system '",
        NotifySystemMerged -> String
forall a (p :: ConfigPhase). IsString a => NotifySystemP p -> a
displayNotifySystem NotifySystemMerged
system,
        String
"' and note '",
        ShrunNote -> String
forall a. Show a => a -> String
show ShrunNote
note,
        String
"': ",
        Text -> String
T.unpack Text
message
      ]

-- | General effect for sending notifications.
class (Monad m) => MonadNotify m where
  notify :: (HasCallStack) => ShrunNote -> m (Maybe NotifyException)

-- | Maps (ExitCode, stderr) to Just stderr, if the exit code is
-- ExitFailure.
exitFailureToStderr :: (ExitCode, BSL.ByteString) -> Maybe ByteString
exitFailureToStderr :: (ExitCode, ByteString) -> Maybe ByteString
exitFailureToStderr (ExitCode
ex, ByteString
stderr) = case ExitCode
ex of
  ExitCode
ExitSuccess -> Maybe ByteString
forall a. Maybe a
Nothing
  ExitFailure Int
_ -> ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> ByteString
BSL.toStrict ByteString
stderr)