{-# LANGUAGE CPP #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-unused-imports #-}

module Shrun.Configuration.Data.Notify
  ( NotifyP (..),
    NotifyArgs,
    NotifyToml,
    NotifyMerged,
    NotifyEnv,
    mergeNotifyLogging,
    toEnv,
  )
where

import Shrun.Configuration.Data.ConfigPhase
  ( ConfigPhase
      ( ConfigPhaseArgs,
        ConfigPhaseEnv,
        ConfigPhaseMerged,
        ConfigPhaseToml
      ),
    ConfigPhaseF,
  )
import Shrun.Configuration.Data.WithDisabled
  ( WithDisabled (Disabled, With, Without),
    (<>?),
    (<>?.),
  )
import Shrun.Configuration.Data.WithDisabled qualified as WD
import Shrun.Configuration.Default (Default, def)
import Shrun.Notify.MonadDBus (MonadDBus (connectSession))
import Shrun.Notify.Types
  ( LinuxNotifySystemMismatch (LinuxNotifySystemMismatchAppleScript),
    NotifyAction,
    NotifySystemEnv,
    NotifySystemP (AppleScript, DBus, NotifySend),
    NotifyTimeout,
    OsxNotifySystemMismatch
      ( OsxNotifySystemMismatchDBus,
        OsxNotifySystemMismatchNotifySend
      ),
    displayNotifySystem,
    mergeNotifySystem,
  )
import Shrun.Prelude

-- See NOTE: [Args vs. Toml mandatory fields]

-- | Notify action is mandatory if we are running notifications.
type NotifyActionF :: ConfigPhase -> Type
type family NotifyActionF p where
  NotifyActionF ConfigPhaseArgs = WithDisabled NotifyAction
  NotifyActionF ConfigPhaseToml = NotifyAction
  NotifyActionF ConfigPhaseMerged = NotifyAction
  NotifyActionF ConfigPhaseEnv = NotifyAction

-- | Holds notification config.
type NotifyP :: ConfigPhase -> Type
data NotifyP p = MkNotifyP
  { -- | Actions for which to send notifications.
    forall (p :: ConfigPhase). NotifyP p -> NotifyActionF p
action :: NotifyActionF p,
    -- | The notification system to use.
    forall (p :: ConfigPhase).
NotifyP p -> ConfigPhaseF p (NotifySystemP p)
system :: ConfigPhaseF p (NotifySystemP p),
    -- | when to timeout successful notifications.
    forall (p :: ConfigPhase).
NotifyP p -> ConfigPhaseF p NotifyTimeout
timeout :: ConfigPhaseF p NotifyTimeout
  }

instance
  ( k ~ A_Lens,
    a ~ NotifyActionF p,
    b ~ NotifyActionF p
  ) =>
  LabelOptic "action" k (NotifyP p) (NotifyP p) a b
  where
  labelOptic :: Optic k NoIx (NotifyP p) (NotifyP p) a b
labelOptic =
    LensVL (NotifyP p) (NotifyP p) a b
-> Lens (NotifyP p) (NotifyP p) a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL
      (LensVL (NotifyP p) (NotifyP p) a b
 -> Lens (NotifyP p) (NotifyP p) a b)
-> LensVL (NotifyP p) (NotifyP p) a b
-> Lens (NotifyP p) (NotifyP p) a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f
         (MkNotifyP NotifyActionF p
_action ConfigPhaseF p (NotifySystemP p)
_system ConfigPhaseF p NotifyTimeout
_timeout) ->
          (b -> NotifyP p) -> f b -> f (NotifyP p)
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap
            (\b
action' -> NotifyActionF p
-> ConfigPhaseF p (NotifySystemP p)
-> ConfigPhaseF p NotifyTimeout
-> NotifyP p
forall (p :: ConfigPhase).
NotifyActionF p
-> ConfigPhaseF p (NotifySystemP p)
-> ConfigPhaseF p NotifyTimeout
-> NotifyP p
MkNotifyP b
NotifyActionF p
action' ConfigPhaseF p (NotifySystemP p)
_system ConfigPhaseF p NotifyTimeout
_timeout)
            (a -> f b
f a
NotifyActionF p
_action)
  {-# INLINE labelOptic #-}

instance
  ( k ~ A_Lens,
    a ~ ConfigPhaseF p (NotifySystemP p),
    b ~ ConfigPhaseF p (NotifySystemP p)
  ) =>
  LabelOptic "system" k (NotifyP p) (NotifyP p) a b
  where
  labelOptic :: Optic k NoIx (NotifyP p) (NotifyP p) a b
labelOptic =
    LensVL (NotifyP p) (NotifyP p) a b
-> Lens (NotifyP p) (NotifyP p) a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL
      (LensVL (NotifyP p) (NotifyP p) a b
 -> Lens (NotifyP p) (NotifyP p) a b)
-> LensVL (NotifyP p) (NotifyP p) a b
-> Lens (NotifyP p) (NotifyP p) a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f
         (MkNotifyP NotifyActionF p
_action ConfigPhaseF p (NotifySystemP p)
_system ConfigPhaseF p NotifyTimeout
_timeout) ->
          (b -> NotifyP p) -> f b -> f (NotifyP p)
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap
            (\b
system' -> NotifyActionF p
-> ConfigPhaseF p (NotifySystemP p)
-> ConfigPhaseF p NotifyTimeout
-> NotifyP p
forall (p :: ConfigPhase).
NotifyActionF p
-> ConfigPhaseF p (NotifySystemP p)
-> ConfigPhaseF p NotifyTimeout
-> NotifyP p
MkNotifyP NotifyActionF p
_action b
ConfigPhaseF p (NotifySystemP p)
system' ConfigPhaseF p NotifyTimeout
_timeout)
            (a -> f b
f a
ConfigPhaseF p (NotifySystemP p)
_system)
  {-# INLINE labelOptic #-}

instance
  ( k ~ A_Lens,
    a ~ ConfigPhaseF p NotifyTimeout,
    b ~ ConfigPhaseF p NotifyTimeout
  ) =>
  LabelOptic "timeout" k (NotifyP p) (NotifyP p) a b
  where
  labelOptic :: Optic k NoIx (NotifyP p) (NotifyP p) a b
labelOptic =
    LensVL (NotifyP p) (NotifyP p) a b
-> Lens (NotifyP p) (NotifyP p) a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL
      (LensVL (NotifyP p) (NotifyP p) a b
 -> Lens (NotifyP p) (NotifyP p) a b)
-> LensVL (NotifyP p) (NotifyP p) a b
-> Lens (NotifyP p) (NotifyP p) a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f
         (MkNotifyP NotifyActionF p
_action ConfigPhaseF p (NotifySystemP p)
_system ConfigPhaseF p NotifyTimeout
_timeout) ->
          (b -> NotifyP p) -> f b -> f (NotifyP p)
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap
            (NotifyActionF p
-> ConfigPhaseF p (NotifySystemP p)
-> ConfigPhaseF p NotifyTimeout
-> NotifyP p
forall (p :: ConfigPhase).
NotifyActionF p
-> ConfigPhaseF p (NotifySystemP p)
-> ConfigPhaseF p NotifyTimeout
-> NotifyP p
MkNotifyP NotifyActionF p
_action ConfigPhaseF p (NotifySystemP p)
_system)
            (a -> f b
f a
ConfigPhaseF p NotifyTimeout
_timeout)
  {-# INLINE labelOptic #-}

type NotifyArgs = NotifyP ConfigPhaseArgs

type NotifyToml = NotifyP ConfigPhaseToml

type NotifyMerged = NotifyP ConfigPhaseMerged

type NotifyEnv = NotifyP ConfigPhaseEnv

deriving stock instance Eq (NotifyP ConfigPhaseArgs)

deriving stock instance Show (NotifyP ConfigPhaseArgs)

deriving stock instance Eq (NotifyP ConfigPhaseToml)

deriving stock instance Show (NotifyP ConfigPhaseToml)

deriving stock instance Eq (NotifyP ConfigPhaseMerged)

deriving stock instance Show (NotifyP ConfigPhaseMerged)

-- Only Default instance is for Args, since others require the action.
instance Default NotifyArgs where
  def :: NotifyArgs
def =
    MkNotifyP
      { system :: ConfigPhaseF 'ConfigPhaseArgs NotifySystemArgs
system = WithDisabled NotifySystemArgs
ConfigPhaseF 'ConfigPhaseArgs NotifySystemArgs
forall a. Default a => a
def,
        action :: NotifyActionF 'ConfigPhaseArgs
action = WithDisabled NotifyAction
NotifyActionF 'ConfigPhaseArgs
forall a. Default a => a
def,
        timeout :: ConfigPhaseF 'ConfigPhaseArgs NotifyTimeout
timeout = WithDisabled NotifyTimeout
ConfigPhaseF 'ConfigPhaseArgs NotifyTimeout
forall a. Default a => a
def
      }

-- | Merges args and toml configs.
mergeNotifyLogging ::
  NotifyArgs ->
  Maybe NotifyToml ->
  Maybe NotifyMerged
mergeNotifyLogging :: NotifyArgs -> Maybe NotifyToml -> Maybe NotifyMerged
mergeNotifyLogging NotifyArgs
args Maybe NotifyToml
mToml =
  Maybe NotifyAction
mAction Maybe NotifyAction
-> (NotifyAction -> NotifyMerged) -> Maybe NotifyMerged
forall (f :: Type -> Type) a b. Functor f => f a -> (a -> b) -> f b
<&> \NotifyAction
action ->
    let toml :: NotifyToml
        toml :: NotifyToml
toml = NotifyToml -> Maybe NotifyToml -> NotifyToml
forall a. a -> Maybe a -> a
fromMaybe (NotifyAction -> NotifyToml
defaultNotifyToml NotifyAction
action) Maybe NotifyToml
mToml
     in MkNotifyP
          { NotifyAction
NotifyActionF 'ConfigPhaseMerged
action :: NotifyActionF 'ConfigPhaseMerged
action :: NotifyAction
action,
            system :: ConfigPhaseF 'ConfigPhaseMerged (NotifySystemP 'ConfigPhaseMerged)
system =
              WithDisabled NotifySystemArgs
-> Maybe NotifySystemToml -> NotifySystemP 'ConfigPhaseMerged
mergeNotifySystem (NotifyArgs
args NotifyArgs
-> Optic' A_Lens NoIx NotifyArgs (WithDisabled NotifySystemArgs)
-> WithDisabled NotifySystemArgs
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx NotifyArgs (WithDisabled NotifySystemArgs)
#system) (NotifyToml
toml NotifyToml
-> Optic' A_Lens NoIx NotifyToml (Maybe NotifySystemToml)
-> Maybe NotifySystemToml
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx NotifyToml (Maybe NotifySystemToml)
#system),
            timeout :: ConfigPhaseF 'ConfigPhaseMerged NotifyTimeout
timeout =
              (NotifyArgs
args NotifyArgs
-> Optic' A_Lens NoIx NotifyArgs (WithDisabled NotifyTimeout)
-> WithDisabled NotifyTimeout
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx NotifyArgs (WithDisabled NotifyTimeout)
#timeout) WithDisabled NotifyTimeout -> Maybe NotifyTimeout -> NotifyTimeout
forall a. Default a => WithDisabled a -> Maybe a -> a
<>?. (NotifyToml
toml NotifyToml
-> Optic' A_Lens NoIx NotifyToml (Maybe NotifyTimeout)
-> Maybe NotifyTimeout
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx NotifyToml (Maybe NotifyTimeout)
#timeout)
          }
  where
    mAction :: Maybe NotifyAction
mAction = case (NotifyArgs
args NotifyArgs
-> Optic' A_Lens NoIx NotifyArgs (WithDisabled NotifyAction)
-> WithDisabled NotifyAction
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx NotifyArgs (WithDisabled NotifyAction)
#action, Maybe NotifyToml
mToml) of
      -- 1. Logging globally disabled
      (WithDisabled NotifyAction
Disabled, Maybe NotifyToml
_) -> Maybe NotifyAction
forall a. Maybe a
Nothing
      -- 2. No Args and no Toml
      (WithDisabled NotifyAction
Without, Maybe NotifyToml
Nothing) -> Maybe NotifyAction
forall a. Maybe a
Nothing
      (With NotifyAction
p, Maybe NotifyToml
_) -> NotifyAction -> Maybe NotifyAction
forall a. a -> Maybe a
Just NotifyAction
p
      (WithDisabled NotifyAction
_, Just NotifyToml
toml) -> NotifyAction -> Maybe NotifyAction
forall a. a -> Maybe a
Just (NotifyAction -> Maybe NotifyAction)
-> NotifyAction -> Maybe NotifyAction
forall a b. (a -> b) -> a -> b
$ NotifyToml
toml NotifyToml
-> Optic' A_Lens NoIx NotifyToml NotifyAction -> NotifyAction
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx NotifyToml NotifyAction
#action

instance DecodeTOML NotifyToml where
  tomlDecoder :: Decoder NotifyToml
tomlDecoder =
    NotifyAction
-> Maybe NotifySystemToml -> Maybe NotifyTimeout -> NotifyToml
NotifyActionF 'ConfigPhaseToml
-> ConfigPhaseF 'ConfigPhaseToml NotifySystemToml
-> ConfigPhaseF 'ConfigPhaseToml NotifyTimeout
-> NotifyToml
forall (p :: ConfigPhase).
NotifyActionF p
-> ConfigPhaseF p (NotifySystemP p)
-> ConfigPhaseF p NotifyTimeout
-> NotifyP p
MkNotifyP
      (NotifyAction
 -> Maybe NotifySystemToml -> Maybe NotifyTimeout -> NotifyToml)
-> Decoder NotifyAction
-> Decoder
     (Maybe NotifySystemToml -> Maybe NotifyTimeout -> NotifyToml)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder NotifyAction -> Text -> Decoder NotifyAction
forall a. Decoder a -> Text -> Decoder a
getFieldWith Decoder NotifyAction
forall a. DecodeTOML a => Decoder a
tomlDecoder Text
"action"
      Decoder
  (Maybe NotifySystemToml -> Maybe NotifyTimeout -> NotifyToml)
-> Decoder (Maybe NotifySystemToml)
-> Decoder (Maybe NotifyTimeout -> NotifyToml)
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 NotifySystemToml
-> Text -> Decoder (Maybe NotifySystemToml)
forall a. Decoder a -> Text -> Decoder (Maybe a)
getFieldOptWith Decoder NotifySystemToml
forall a. DecodeTOML a => Decoder a
tomlDecoder Text
"system"
      Decoder (Maybe NotifyTimeout -> NotifyToml)
-> Decoder (Maybe NotifyTimeout) -> Decoder NotifyToml
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 NotifyTimeout -> Text -> Decoder (Maybe NotifyTimeout)
forall a. Decoder a -> Text -> Decoder (Maybe a)
getFieldOptWith Decoder NotifyTimeout
forall a. DecodeTOML a => Decoder a
tomlDecoder Text
"timeout"

#if OSX

toEnv ::
  ( HasCallStack,
    MonadThrow m
  ) =>
  NotifyMerged ->
  m NotifyEnv
toEnv notifyMerged = case systemMerged of
  DBus _ -> throwM OsxNotifySystemMismatchDBus
  NotifySend -> throwM OsxNotifySystemMismatchNotifySend
  AppleScript -> pure $ mkNotify notifyMerged AppleScript
  where
    systemMerged = notifyMerged ^. #system

#else

toEnv ::
  ( HasCallStack,
    MonadDBus m,
    MonadThrow m
  ) =>
  NotifyMerged ->
  m NotifyEnv
toEnv :: forall (m :: Type -> Type).
(HasCallStack, MonadDBus m, MonadThrow m) =>
NotifyMerged -> m NotifyEnv
toEnv NotifyMerged
notifyMerged = case NotifySystemP 'ConfigPhaseMerged
systemMerged of
  NotifySystemP 'ConfigPhaseMerged
AppleScript -> LinuxNotifySystemMismatch -> m NotifyEnv
forall (m :: Type -> Type) e a.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
throwM LinuxNotifySystemMismatch
LinuxNotifySystemMismatchAppleScript
  DBus DBusF 'ConfigPhaseMerged
_ -> NotifyMerged -> NotifySystemEnv -> NotifyEnv
mkNotify NotifyMerged
notifyMerged (NotifySystemEnv -> NotifyEnv)
-> (Client -> NotifySystemEnv) -> Client -> NotifyEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Client -> NotifySystemEnv
DBusF 'ConfigPhaseEnv -> NotifySystemEnv
forall (p :: ConfigPhase). DBusF p -> NotifySystemP p
DBus (Client -> NotifyEnv) -> m Client -> m NotifyEnv
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> m Client
forall (m :: Type -> Type). (MonadDBus m, HasCallStack) => m Client
connectSession
  NotifySystemP 'ConfigPhaseMerged
NotifySend -> NotifyEnv -> m NotifyEnv
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (NotifyEnv -> m NotifyEnv) -> NotifyEnv -> m NotifyEnv
forall a b. (a -> b) -> a -> b
$ NotifyMerged -> NotifySystemEnv -> NotifyEnv
mkNotify NotifyMerged
notifyMerged NotifySystemEnv
forall (p :: ConfigPhase). NotifySystemP p
NotifySend
  where
    systemMerged :: NotifySystemP 'ConfigPhaseMerged
systemMerged = NotifyMerged
notifyMerged NotifyMerged
-> Optic'
     A_Lens NoIx NotifyMerged (NotifySystemP 'ConfigPhaseMerged)
-> NotifySystemP 'ConfigPhaseMerged
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx NotifyMerged (NotifySystemP 'ConfigPhaseMerged)
#system

#endif

mkNotify :: NotifyMerged -> NotifySystemEnv -> NotifyEnv
mkNotify :: NotifyMerged -> NotifySystemEnv -> NotifyEnv
mkNotify NotifyMerged
notifyToml NotifySystemEnv
systemP2 =
  MkNotifyP
    { system :: ConfigPhaseF 'ConfigPhaseEnv NotifySystemEnv
system = ConfigPhaseF 'ConfigPhaseEnv NotifySystemEnv
NotifySystemEnv
systemP2,
      action :: NotifyActionF 'ConfigPhaseEnv
action = NotifyMerged
notifyToml NotifyMerged
-> Optic' A_Lens NoIx NotifyMerged NotifyAction -> NotifyAction
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx NotifyMerged NotifyAction
#action,
      timeout :: ConfigPhaseF 'ConfigPhaseEnv NotifyTimeout
timeout = NotifyMerged
notifyToml NotifyMerged
-> Optic' A_Lens NoIx NotifyMerged NotifyTimeout -> NotifyTimeout
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx NotifyMerged NotifyTimeout
#timeout
    }

defaultNotifyToml :: NotifyAction -> NotifyToml
defaultNotifyToml :: NotifyAction -> NotifyToml
defaultNotifyToml NotifyAction
action =
  MkNotifyP
    { system :: ConfigPhaseF 'ConfigPhaseToml NotifySystemToml
system = Maybe NotifySystemToml
ConfigPhaseF 'ConfigPhaseToml NotifySystemToml
forall a. Maybe a
Nothing,
      action :: NotifyActionF 'ConfigPhaseToml
action = NotifyAction
NotifyActionF 'ConfigPhaseToml
action,
      timeout :: ConfigPhaseF 'ConfigPhaseToml NotifyTimeout
timeout = Maybe NotifyTimeout
ConfigPhaseF 'ConfigPhaseToml NotifyTimeout
forall a. Maybe a
Nothing
    }