{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

-- | Provides an effect for desktop notifications.
--
-- @since 0.1
module Effectful.Notify.Dynamic
  ( -- * Description
    -- $desc

    -- * Effect
    Notify (..),
    initNotifyEnv,
    notify,

    -- ** Handlers
    runNotify,

    -- ** Errors
    NotifyInitException (..),
    NotifyException (..),
    catchNonFatalNotify,
    tryNonFatalNotify,
    tryNonFatalNotify_,

    -- * Types

    -- ** System

    -- *** Platform-specific
    NotifySystem.NotifySystemOs (..),
    defaultNotifySystemOs,

    -- *** All platforms
    NotifySystem (..),
    defaultNotifySystem,
    notifySystemToOs,
    notifySystemFromOs,
    Os (..),
    NotifyParseException (..),

    -- ** Env
    NotifyEnv,
    notifyEnvToSystemOs,

    -- ** Notes
    Note,
    mkNote,
    setBody,
    getBody,
    setSummary,
    getSummary,
    setTimeout,
    getTimeout,
    setTitle,
    getTitle,
    setUrgency,
    getUrgency,

    -- ** Timeout
    NotifyTimeout (..),
    _NotifyTimeoutMillis,
    _NotifyTimeoutNever,

    -- ** NotifyUrgency
    NotifyUrgency (..),
    _NotifyUrgencyLow,
    _NotifyUrgencyNormal,
    _NotifyUrgencyCritical,
  )
where

import Control.Monad (void)
import Control.Monad.Catch qualified as C
import Data.Kind (Type)
import Effectful
  ( Dispatch (Dynamic),
    DispatchOf,
    Eff,
    Effect,
    IOE,
    type (:>),
  )
import Effectful.Dispatch.Dynamic (HasCallStack, reinterpret_, send)
import Effectful.Dynamic.Utils (ShowEffect (showEffectCons))
import Effectful.Notify.Internal.Data.Note
  ( Note,
    getBody,
    getSummary,
    getTimeout,
    getTitle,
    getUrgency,
    mkNote,
    setBody,
    setSummary,
    setTimeout,
    setTitle,
    setUrgency,
  )
import Effectful.Notify.Internal.Data.NotifyEnv (NotifyEnv, notifyEnvToSystemOs)
import Effectful.Notify.Internal.Data.NotifyException
  ( NotifyException (MkNotifyException, exception, fatal, note, notifySystem),
  )
import Effectful.Notify.Internal.Data.NotifyInitException
  ( NotifyInitException (MkNotifyInitException, unNotifyInitException),
  )
import Effectful.Notify.Internal.Data.NotifySystem
  ( NotifyParseException (MkNotifyParseException, os, system),
    NotifySystem
      ( NotifySystemAppleScript,
        NotifySystemDBus,
        NotifySystemNotifySend,
        NotifySystemWindows
      ),
    NotifySystemOs,
    defaultNotifySystem,
    defaultNotifySystemOs,
    notifySystemFromOs,
    notifySystemToOs,
  )
import Effectful.Notify.Internal.Data.NotifySystem qualified as NotifySystem
import Effectful.Notify.Internal.Data.NotifyTimeout
  ( NotifyTimeout (NotifyTimeoutMillis, NotifyTimeoutNever),
    _NotifyTimeoutMillis,
    _NotifyTimeoutNever,
  )
import Effectful.Notify.Internal.Data.NotifyUrgency
  ( NotifyUrgency (NotifyUrgencyCritical, NotifyUrgencyLow, NotifyUrgencyNormal),
    _NotifyUrgencyCritical,
    _NotifyUrgencyLow,
    _NotifyUrgencyNormal,
  )
import Effectful.Notify.Internal.Os (Os (Linux, Osx, Windows))
import Effectful.Notify.Static qualified as Static
import Optics.Core ((^.))

-- | Dynamic notify effect.
--
-- @since 0.1
type Notify :: Type -> (Type -> Type) -> Type -> Type
data Notify env :: Effect where
  InitNotifyEnv :: NotifySystemOs -> Notify env es env
  Notify :: env -> Note -> Notify env es ()

-- | @since 0.1
type instance DispatchOf (Notify _) = Dynamic

-- | @since 0.1
instance ShowEffect (Notify env) where
  showEffectCons :: forall (m :: * -> *) a. Notify env m a -> String
showEffectCons = \case
    InitNotifyEnv {} -> String
"InitNotifyEnv"
    Notify {} -> String
"Notify"

-- | Runs a 'Notify' effect in IO.
--
-- @since 0.1
runNotify ::
  forall es a.
  ( HasCallStack,
    IOE :> es
  ) =>
  Eff (Notify NotifyEnv : es) a ->
  Eff es a
runNotify :: forall (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, IOE :> es) =>
Eff (Notify NotifyEnv : es) a -> Eff es a
runNotify = (Eff (Notify : es) a -> Eff es a)
-> EffectHandler_ (Notify NotifyEnv) (Notify : es)
-> Eff (Notify NotifyEnv : es) a
-> Eff es a
forall (e :: (* -> *) -> * -> *)
       (handlerEs :: [(* -> *) -> * -> *]) a (es :: [(* -> *) -> * -> *])
       b.
(HasCallStack, DispatchOf e ~ 'Dynamic) =>
(Eff handlerEs a -> Eff es b)
-> EffectHandler_ e handlerEs -> Eff (e : es) a -> Eff es b
reinterpret_ Eff (Notify : es) a -> Eff es a
forall (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, IOE :> es) =>
Eff (Notify : es) a -> Eff es a
Static.runNotify (EffectHandler_ (Notify NotifyEnv) (Notify : es)
 -> Eff (Notify NotifyEnv : es) a -> Eff es a)
-> EffectHandler_ (Notify NotifyEnv) (Notify : es)
-> Eff (Notify NotifyEnv : es) a
-> Eff es a
forall a b. (a -> b) -> a -> b
$ \case
  InitNotifyEnv NotifySystemOs
sys -> NotifySystemOs -> Eff (Notify : es) NotifyEnv
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, Notify :> es) =>
NotifySystemOs -> Eff es NotifyEnv
Static.initNotifyEnv NotifySystemOs
sys
  Notify NotifyEnv
env Note
note -> NotifyEnv -> Note -> Eff (Notify : es) ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, Notify :> es) =>
NotifyEnv -> Note -> Eff es ()
Static.notify NotifyEnv
env Note
note

-- | Initialize the notification environment.
--
-- @since 0.1
initNotifyEnv ::
  forall env es.
  ( HasCallStack,
    Notify env :> es
  ) =>
  NotifySystemOs ->
  Eff es env
initNotifyEnv :: forall env (es :: [(* -> *) -> * -> *]).
(HasCallStack, Notify env :> es) =>
NotifySystemOs -> Eff es env
initNotifyEnv = Notify env (Eff es) env -> Eff es env
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (Notify env (Eff es) env -> Eff es env)
-> (NotifySystemOs -> Notify env (Eff es) env)
-> NotifySystemOs
-> Eff es env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NotifySystemOs -> Notify env (Eff es) env
forall env (es :: * -> *). NotifySystemOs -> Notify env es env
InitNotifyEnv

-- | Send a notification.
--
-- @since 0.1
notify ::
  forall env es.
  ( HasCallStack,
    Notify env :> es
  ) =>
  env ->
  Note ->
  Eff es ()
notify :: forall env (es :: [(* -> *) -> * -> *]).
(HasCallStack, Notify env :> es) =>
env -> Note -> Eff es ()
notify env
env = Notify env (Eff es) () -> Eff es ()
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (Notify env (Eff es) () -> Eff es ())
-> (Note -> Notify env (Eff es) ()) -> Note -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. env -> Note -> Notify env (Eff es) ()
forall env (es :: * -> *). env -> Note -> Notify env es ()
Notify env
env

-- | Runs 'notify' and runs the handler on any non-fatal 'NotifyException's.
-- Any other exceptions are rethrown.
--
-- @since 0.1
catchNonFatalNotify ::
  forall env es.
  ( HasCallStack,
    Notify env :> es
  ) =>
  -- | Env.
  env ->
  -- | Note.
  Note ->
  -- | Handler.
  (NotifyException -> Eff es ()) ->
  Eff es ()
catchNonFatalNotify :: forall env (es :: [(* -> *) -> * -> *]).
(HasCallStack, Notify env :> es) =>
env -> Note -> (NotifyException -> Eff es ()) -> Eff es ()
catchNonFatalNotify env
env Note
note NotifyException -> Eff es ()
handler =
  env -> Note -> Eff es ()
forall env (es :: [(* -> *) -> * -> *]).
(HasCallStack, Notify env :> es) =>
env -> Note -> Eff es ()
notify env
env Note
note Eff es () -> (NotifyException -> Eff es ()) -> Eff es ()
forall e a.
(HasCallStack, Exception e) =>
Eff es a -> (e -> Eff es a) -> Eff es a
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
`C.catch` \NotifyException
ne ->
    if NotifyException
ne NotifyException -> Optic' A_Lens NoIx NotifyException Bool -> Bool
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx NotifyException Bool
#fatal
      then NotifyException -> Eff es ()
forall e a. (HasCallStack, Exception e) => e -> Eff es a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
C.throwM NotifyException
ne
      else NotifyException -> Eff es ()
handler NotifyException
ne

-- | Like 'notify', but catches non-fatal 'NotifyException'.
--
-- @since 0.1
tryNonFatalNotify ::
  forall env es.
  ( HasCallStack,
    Notify env :> es
  ) =>
  -- | Env.
  env ->
  -- | Note.
  Note ->
  Eff es (Maybe NotifyException)
tryNonFatalNotify :: forall env (es :: [(* -> *) -> * -> *]).
(HasCallStack, Notify env :> es) =>
env -> Note -> Eff es (Maybe NotifyException)
tryNonFatalNotify env
env Note
note =
  Eff es () -> Eff es (Either NotifyException ())
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> m (Either e a)
C.try (env -> Note -> Eff es ()
forall env (es :: [(* -> *) -> * -> *]).
(HasCallStack, Notify env :> es) =>
env -> Note -> Eff es ()
notify env
env Note
note) Eff es (Either NotifyException ())
-> (Either NotifyException () -> Eff es (Maybe NotifyException))
-> Eff es (Maybe NotifyException)
forall a b. Eff es a -> (a -> Eff es b) -> Eff es b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left NotifyException
ex ->
      if NotifyException
ex NotifyException -> Optic' A_Lens NoIx NotifyException Bool -> Bool
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx NotifyException Bool
#fatal
        then NotifyException -> Eff es (Maybe NotifyException)
forall e a. (HasCallStack, Exception e) => e -> Eff es a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
C.throwM NotifyException
ex
        else Maybe NotifyException -> Eff es (Maybe NotifyException)
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe NotifyException -> Eff es (Maybe NotifyException))
-> Maybe NotifyException -> Eff es (Maybe NotifyException)
forall a b. (a -> b) -> a -> b
$ NotifyException -> Maybe NotifyException
forall a. a -> Maybe a
Just NotifyException
ex
    Right ()
_ -> Maybe NotifyException -> Eff es (Maybe NotifyException)
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe NotifyException
forall a. Maybe a
Nothing

-- | Like 'tryNonFatalNotify', but catches and discards the exception.
--
-- @since 0.1
tryNonFatalNotify_ ::
  forall env es.
  ( HasCallStack,
    Notify env :> es
  ) =>
  -- | Env.
  env ->
  -- | Note.
  Note ->
  Eff es ()
tryNonFatalNotify_ :: forall env (es :: [(* -> *) -> * -> *]).
(HasCallStack, Notify env :> es) =>
env -> Note -> Eff es ()
tryNonFatalNotify_ env
env = Eff es (Maybe NotifyException) -> Eff es ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Eff es (Maybe NotifyException) -> Eff es ())
-> (Note -> Eff es (Maybe NotifyException)) -> Note -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. env -> Note -> Eff es (Maybe NotifyException)
forall env (es :: [(* -> *) -> * -> *]).
(HasCallStack, Notify env :> es) =>
env -> Note -> Eff es (Maybe NotifyException)
tryNonFatalNotify env
env

-- $desc
--
-- @notify-effectful@ is a library for implementing cross-platform desktop
-- notifications. Currently supports:
--
-- - Linux: Supports @dbus@ and @notify-send@. That is, if there is a
--   running dbus notification server, it can be used directly.
--   @notify-send (libnotify)@ can also be used, though it also requires a
--   running dbus server.
--
-- - Osx: Supports built-in @apple-script@ i.e. @osascript@.
--
-- - Windows: Unsupported. Functions are mere stubs that will compile
--   (with a warning) and do nothing at runtime.
--
-- ==== Usage
--
-- General usage involves choosing the notification system and using that
-- to initialize the environment:
--
-- @
-- -- choose system
-- let systemOs :: 'NotifySystemOs'
--     systemOs = ...
--
-- -- prepare environment
-- notifyEnv <- 'initNotifyEnv' systemOs
--
-- -- send notification
-- let note =
--       'mkNote' "A summary"
--         & 'setBody' "Some notification"
--         & 'setTitle' "My Application"
--
-- 'notify' notifyEnv note
-- @
--
-- Choosing the system is more interesting. If we do not care about being
-- cross-platform, we can simply choose a 'NotifySystemOs' directly
-- and pass it to init:
--
-- @
-- -- The NotifySystemOsDBus constructor is only available on linux.
-- let systemOs :: 'NotifySystemOs'
--     systemOs = NotifySystemOsDBus
--
-- notifyEnv <- 'initNotifyEnv' systemOs
-- ...
-- @
--
-- If we need to work on several platforms, we can instead use 'NotifySystem',
-- which includes every possible notification system and is available on all
-- platforms. We then pass it to 'notifySystemToOs', which -- if successful --
-- will return the 'NotifySystemOs' and we can continue as normal.
--
-- @
-- -- All NotifySystem constructors are available on all platforms.
-- let system :: 'NotifySystem'
--     system = ...
--
-- systemOs <- 'notifySystemToOs' system \>\>= \\case
--   Left ex -> throwM ex
--   Right s -> pure s
-- notifyEnv <- 'initNotifyEnv' systemOs
-- ...
-- @
--
-- If a system is chosen that is unavailable on the current platform,
-- a 'NotifyParseException' will be returned.