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
  { AddNotificationOptions -> Text
id :: Text,
    AddNotificationOptions -> Maybe Text
title :: Maybe Text,
    AddNotificationOptions -> Maybe Text
body :: Maybe Text,
    AddNotificationOptions -> Maybe NotificationPriority
priority :: Maybe NotificationPriority,
    AddNotificationOptions -> Maybe NotificationIcon
icon :: Maybe NotificationIcon,
    AddNotificationOptions -> Maybe Text
defaultAction :: Maybe Text,
    AddNotificationOptions -> Maybe Variant
defaultActionTarget :: Maybe Variant,
    AddNotificationOptions -> Maybe [NotificationButton]
buttons :: Maybe [NotificationButton]
  }
  deriving (AddNotificationOptions -> AddNotificationOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddNotificationOptions -> AddNotificationOptions -> Bool
$c/= :: AddNotificationOptions -> AddNotificationOptions -> Bool
== :: AddNotificationOptions -> AddNotificationOptions -> Bool
$c== :: AddNotificationOptions -> AddNotificationOptions -> Bool
Eq, Int -> AddNotificationOptions -> ShowS
[AddNotificationOptions] -> ShowS
AddNotificationOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddNotificationOptions] -> ShowS
$cshowList :: [AddNotificationOptions] -> ShowS
show :: AddNotificationOptions -> String
$cshow :: AddNotificationOptions -> String
showsPrec :: Int -> AddNotificationOptions -> ShowS
$cshowsPrec :: Int -> AddNotificationOptions -> ShowS
Show)

data NotificationPriority
  = NotificationPriorityLow
  | NotificationPriorityNormal
  | NotificationPriorityHigh
  | NotificationPriorityUrgent
  deriving (NotificationPriority -> NotificationPriority -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NotificationPriority -> NotificationPriority -> Bool
$c/= :: NotificationPriority -> NotificationPriority -> Bool
== :: NotificationPriority -> NotificationPriority -> Bool
$c== :: NotificationPriority -> NotificationPriority -> Bool
Eq, Int -> NotificationPriority -> ShowS
[NotificationPriority] -> ShowS
NotificationPriority -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NotificationPriority] -> ShowS
$cshowList :: [NotificationPriority] -> ShowS
show :: NotificationPriority -> String
$cshow :: NotificationPriority -> String
showsPrec :: Int -> NotificationPriority -> ShowS
$cshowsPrec :: Int -> NotificationPriority -> ShowS
Show)

data NotificationIcon
  = NotificationIconThemed [Text]
  | NotificationIconBytes ByteString
  deriving (NotificationIcon -> NotificationIcon -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NotificationIcon -> NotificationIcon -> Bool
$c/= :: NotificationIcon -> NotificationIcon -> Bool
== :: NotificationIcon -> NotificationIcon -> Bool
$c== :: NotificationIcon -> NotificationIcon -> Bool
Eq, Int -> NotificationIcon -> ShowS
[NotificationIcon] -> ShowS
NotificationIcon -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NotificationIcon] -> ShowS
$cshowList :: [NotificationIcon] -> ShowS
show :: NotificationIcon -> String
$cshow :: NotificationIcon -> String
showsPrec :: Int -> NotificationIcon -> ShowS
$cshowsPrec :: Int -> NotificationIcon -> ShowS
Show)

data NotificationButton = NotificationButton
  { NotificationButton -> Text
label_ :: Text,
    NotificationButton -> Text
action :: Text,
    NotificationButton -> Maybe Variant
target :: Maybe Variant
  }
  deriving (NotificationButton -> NotificationButton -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NotificationButton -> NotificationButton -> Bool
$c/= :: NotificationButton -> NotificationButton -> Bool
== :: NotificationButton -> NotificationButton -> Bool
$c== :: NotificationButton -> NotificationButton -> Bool
Eq, Int -> NotificationButton -> ShowS
[NotificationButton] -> ShowS
NotificationButton -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NotificationButton] -> ShowS
$cshowList :: [NotificationButton] -> ShowS
show :: NotificationButton -> String
$cshow :: NotificationButton -> String
showsPrec :: Int -> NotificationButton -> ShowS
$cshowsPrec :: Int -> NotificationButton -> ShowS
Show)

addNotificationOptions ::
  -- | The id of the notification
  Text ->
  AddNotificationOptions
addNotificationOptions :: Text -> AddNotificationOptions
addNotificationOptions Text
id =
  AddNotificationOptions
    { Text
id :: Text
$sel:id:AddNotificationOptions :: Text
id,
      $sel:title:AddNotificationOptions :: Maybe Text
title = forall a. Maybe a
Nothing,
      $sel:body:AddNotificationOptions :: Maybe Text
body = forall a. Maybe a
Nothing,
      $sel:priority:AddNotificationOptions :: Maybe NotificationPriority
priority = forall a. Maybe a
Nothing,
      $sel:icon:AddNotificationOptions :: Maybe NotificationIcon
icon = forall a. Maybe a
Nothing,
      $sel:defaultAction:AddNotificationOptions :: Maybe Text
defaultAction = forall a. Maybe a
Nothing,
      $sel:defaultActionTarget:AddNotificationOptions :: Maybe Variant
defaultActionTarget = forall a. Maybe a
Nothing,
      $sel:buttons:AddNotificationOptions :: Maybe [NotificationButton]
buttons = forall a. Maybe a
Nothing
    }

newtype RemoveNotificationOptions = RemoveNotificationOptions
  {RemoveNotificationOptions -> Text
id :: Text}
  deriving (RemoveNotificationOptions -> RemoveNotificationOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RemoveNotificationOptions -> RemoveNotificationOptions -> Bool
$c/= :: RemoveNotificationOptions -> RemoveNotificationOptions -> Bool
== :: RemoveNotificationOptions -> RemoveNotificationOptions -> Bool
$c== :: RemoveNotificationOptions -> RemoveNotificationOptions -> Bool
Eq, Int -> RemoveNotificationOptions -> ShowS
[RemoveNotificationOptions] -> ShowS
RemoveNotificationOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RemoveNotificationOptions] -> ShowS
$cshowList :: [RemoveNotificationOptions] -> ShowS
show :: RemoveNotificationOptions -> String
$cshow :: RemoveNotificationOptions -> String
showsPrec :: Int -> RemoveNotificationOptions -> ShowS
$cshowsPrec :: Int -> RemoveNotificationOptions -> ShowS
Show)

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

addNotification :: Client -> AddNotificationOptions -> IO ()
addNotification :: Client -> AddNotificationOptions -> IO ()
addNotification Client
client AddNotificationOptions
options =
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Client -> InterfaceName -> MemberName -> [Variant] -> IO [Variant]
callMethod Client
client InterfaceName
notificationInterface MemberName
"AddNotification" [Variant
id, Variant
optionsArg]
  where
    id :: Variant
id = forall a. IsVariant a => a -> Variant
DBus.toVariant AddNotificationOptions
options.id
    optionsArg :: Variant
optionsArg =
      forall a. IsVariant a => a -> Variant
DBus.toVariant forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$
        [ forall a. IsVariant a => Text -> Maybe a -> Maybe (Text, Variant)
toVariantPair Text
"title" AddNotificationOptions
options.title,
          forall a. IsVariant a => Text -> Maybe a -> Maybe (Text, Variant)
toVariantPair Text
"body" AddNotificationOptions
options.body,
          forall b a.
IsVariant b =>
(a -> b) -> Text -> Maybe a -> Maybe (Text, Variant)
toVariantPair' NotificationPriority -> Text
encodePriority Text
"priority" AddNotificationOptions
options.priority,
          forall b a.
IsVariant b =>
(a -> b) -> Text -> Maybe a -> Maybe (Text, Variant)
toVariantPair' NotificationIcon -> (Text, Variant)
encodeIcon Text
"icon" AddNotificationOptions
options.icon,
          forall a. IsVariant a => Text -> Maybe a -> Maybe (Text, Variant)
toVariantPair Text
"default-action" AddNotificationOptions
options.defaultAction,
          (Text
"default-action-target",) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AddNotificationOptions
options.defaultActionTarget,
          forall b a.
IsVariant b =>
(a -> b) -> Text -> Maybe a -> Maybe (Text, Variant)
toVariantPair' (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NotificationButton -> Map Text Variant
encodeButton) Text
"buttons" AddNotificationOptions
options.buttons
        ]

removeNotification :: Client -> RemoveNotificationOptions -> IO ()
removeNotification :: Client -> RemoveNotificationOptions -> IO ()
removeNotification Client
client RemoveNotificationOptions
options =
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Client -> InterfaceName -> MemberName -> [Variant] -> IO [Variant]
callMethod Client
client InterfaceName
notificationInterface MemberName
"RemoveNotification" [Variant
id]
  where
    id :: Variant
id = forall a. IsVariant a => a -> Variant
DBus.toVariant RemoveNotificationOptions
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 -> NotificationActionInvokedCallback -> IO SignalHandler
handleNotificationActionInvoked Client
client NotificationActionInvokedCallback
handler =
  Client
-> InterfaceName
-> MemberName
-> ([Variant] -> IO ())
-> IO SignalHandler
handleSignal Client
client InterfaceName
notificationInterface MemberName
"ActionInvoked" forall a b. (a -> b) -> a -> b
$ \[Variant]
signalBody -> do
    case [Variant]
signalBody of
      [Variant
notificationId, Variant
actionName, Variant
parameter]
        | Just Text
notificationId' <- forall a. IsVariant a => Variant -> Maybe a
DBus.fromVariant Variant
notificationId,
          Just Text
actionName' <- forall a. IsVariant a => Variant -> Maybe a
DBus.fromVariant Variant
actionName,
          Just [Variant]
parameter' <- forall a. IsVariant a => Variant -> Maybe a
DBus.fromVariant Variant
parameter -> do
            NotificationActionInvokedCallback
handler Text
notificationId' Text
actionName' (forall a. [a] -> Maybe a
listToMaybe [Variant]
parameter')
      [Variant]
_ ->
        forall e a. Exception e => e -> IO a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ClientError
DBus.clientError forall a b. (a -> b) -> a -> b
$ String
"handleNotificationActionInvoked: could not parse signal body: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show [Variant]
signalBody

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

encodeIcon :: NotificationIcon -> (Text, Variant)
encodeIcon :: NotificationIcon -> (Text, Variant)
encodeIcon = \case
  NotificationIconThemed [Text]
iconNames -> (Text
"themed", forall a. IsVariant a => a -> Variant
DBus.toVariant [Text]
iconNames)
  NotificationIconBytes ByteString
bytes -> (Text
"bytes", forall a. IsVariant a => a -> Variant
DBus.toVariant ByteString
bytes)

encodeButton :: NotificationButton -> Map Text Variant
encodeButton :: NotificationButton -> Map Text Variant
encodeButton NotificationButton
button =
  forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$
    [ forall a. IsVariant a => Text -> Maybe a -> Maybe (Text, Variant)
toVariantPair Text
"label" (forall a. a -> Maybe a
Just NotificationButton
button.label_),
      forall a. IsVariant a => Text -> Maybe a -> Maybe (Text, Variant)
toVariantPair Text
"action" (forall a. a -> Maybe a
Just NotificationButton
button.action),
      forall a. IsVariant a => Text -> Maybe a -> Maybe (Text, Variant)
toVariantPair Text
"target" NotificationButton
button.target
    ]