Notification.hs

module Desktop.Portal.Notification
  ( -- * Add Notification
    AddNotificationOptions (..),
    NotificationPriority (..),
    NotificationIcon (..),
    NotificationButton (..),
    addNotificationOptions,
    addNotification,

    -- * Remove Notification
    RemoveNotificationOptions (..),
    removeNotification,

    -- * Signals
    NotificationActionInvokedCallback,
    handleNotificationActionInvoked,
  )
where

import Control.Exception (throwIO)
import Control.Monad (void)
import DBus (InterfaceName, Variant)
import DBus qualified
import DBus.Client qualified as DBus
import Data.ByteString.Lazy (ByteString)
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Maybe (catMaybes, listToMaybe)
import Data.Text (Text)
import Desktop.Portal.Internal (Client, SignalHandler, callMethod, handleSignal)
import Desktop.Portal.Util (toVariantPair, toVariantPair')
import Prelude hiding (id)

data AddNotificationOptions = AddNotificationOptions
  { id :: Text,
    title :: Maybe Text,
    body :: Maybe Text,
    priority :: Maybe NotificationPriority,
    icon :: Maybe NotificationIcon,
    defaultAction :: Maybe Text,
    defaultActionTarget :: Maybe Variant,
    buttons :: Maybe [NotificationButton]
  }
  deriving (Eq, Show)

data NotificationPriority
  = NotificationPriorityLow
  | NotificationPriorityNormal
  | NotificationPriorityHigh
  | NotificationPriorityUrgent
  deriving (Eq, Show)

data NotificationIcon
  = NotificationIconThemed [Text]
  | NotificationIconBytes ByteString
  deriving (Eq, Show)

data NotificationButton = NotificationButton
  { label_ :: Text,
    action :: Text,
    target :: Maybe Variant
  }
  deriving (Eq, Show)

addNotificationOptions ::
  -- | The id of the notification
  Text ->
  AddNotificationOptions
addNotificationOptions id =
  AddNotificationOptions
    { id,
      title = Nothing,
      body = Nothing,
      priority = Nothing,
      icon = Nothing,
      defaultAction = Nothing,
      defaultActionTarget = Nothing,
      buttons = Nothing
    }

newtype RemoveNotificationOptions = RemoveNotificationOptions
  {id :: Text}
  deriving (Eq, Show)

notificationInterface :: InterfaceName
notificationInterface = "org.freedesktop.portal.Notification"

addNotification :: Client -> AddNotificationOptions -> IO ()
addNotification client options =
  void $ callMethod client notificationInterface "AddNotification" [id, optionsArg]
  where
    id = DBus.toVariant options.id
    optionsArg =
      DBus.toVariant . Map.fromList . catMaybes $
        [ toVariantPair "title" options.title,
          toVariantPair "body" options.body,
          toVariantPair' encodePriority "priority" options.priority,
          toVariantPair' encodeIcon "icon" options.icon,
          toVariantPair "default-action" options.defaultAction,
          ("default-action-target",) <$> options.defaultActionTarget,
          toVariantPair' (fmap encodeButton) "buttons" options.buttons
        ]

removeNotification :: Client -> RemoveNotificationOptions -> IO ()
removeNotification client options =
  void $ callMethod client notificationInterface "RemoveNotification" [id]
  where
    id = DBus.toVariant options.id

type NotificationActionInvokedCallback =
  -- | The id of the notification that was clicked.
  Text ->
  -- | The name of the action that was invoked.
  Text ->
  -- | The target parameter that goes along with the action, if any.
  Maybe Variant ->
  -- | A command to run when the action is invoked.
  IO ()

-- | Listen for notification actions being invoked.
handleNotificationActionInvoked :: Client -> NotificationActionInvokedCallback -> IO SignalHandler
handleNotificationActionInvoked client handler =
  handleSignal client notificationInterface "ActionInvoked" $ \signalBody -> do
    case signalBody of
      [notificationId, actionName, parameter]
        | Just notificationId' <- DBus.fromVariant notificationId,
          Just actionName' <- DBus.fromVariant actionName,
          Just parameter' <- DBus.fromVariant parameter -> do
            handler notificationId' actionName' (listToMaybe parameter')
      _ ->
        throwIO . DBus.clientError $ "handleNotificationActionInvoked: could not parse signal body: " <> show signalBody

encodePriority :: NotificationPriority -> Text
encodePriority = \case
  NotificationPriorityLow -> "low"
  NotificationPriorityNormal -> "normal"
  NotificationPriorityHigh -> "high"
  NotificationPriorityUrgent -> "urgent"

encodeIcon :: NotificationIcon -> (Text, Variant)
encodeIcon = \case
  NotificationIconThemed iconNames -> ("themed", DBus.toVariant iconNames)
  NotificationIconBytes bytes -> ("bytes", DBus.toVariant bytes)

encodeButton :: NotificationButton -> Map Text Variant
encodeButton button =
  Map.fromList . catMaybes $
    [ toVariantPair "label" (Just button.label_),
      toVariantPair "action" (Just button.action),
      toVariantPair "target" button.target
    ]