module Desktop.Portal.Notification
(
AddNotificationOptions (..),
NotificationPriority (..),
NotificationIcon (..),
NotificationButton (..),
addNotificationOptions,
addNotification,
RemoveNotificationOptions (..),
removeNotification,
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
(AddNotificationOptions -> AddNotificationOptions -> Bool)
-> (AddNotificationOptions -> AddNotificationOptions -> Bool)
-> Eq AddNotificationOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AddNotificationOptions -> AddNotificationOptions -> Bool
== :: AddNotificationOptions -> AddNotificationOptions -> Bool
$c/= :: AddNotificationOptions -> AddNotificationOptions -> Bool
/= :: AddNotificationOptions -> AddNotificationOptions -> Bool
Eq, Int -> AddNotificationOptions -> ShowS
[AddNotificationOptions] -> ShowS
AddNotificationOptions -> String
(Int -> AddNotificationOptions -> ShowS)
-> (AddNotificationOptions -> String)
-> ([AddNotificationOptions] -> ShowS)
-> Show AddNotificationOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AddNotificationOptions -> ShowS
showsPrec :: Int -> AddNotificationOptions -> ShowS
$cshow :: AddNotificationOptions -> String
show :: AddNotificationOptions -> String
$cshowList :: [AddNotificationOptions] -> ShowS
showList :: [AddNotificationOptions] -> ShowS
Show)
data NotificationPriority
= NotificationPriorityLow
| NotificationPriorityNormal
| NotificationPriorityHigh
| NotificationPriorityUrgent
deriving (NotificationPriority -> NotificationPriority -> Bool
(NotificationPriority -> NotificationPriority -> Bool)
-> (NotificationPriority -> NotificationPriority -> Bool)
-> Eq NotificationPriority
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NotificationPriority -> NotificationPriority -> Bool
== :: NotificationPriority -> NotificationPriority -> Bool
$c/= :: NotificationPriority -> NotificationPriority -> Bool
/= :: NotificationPriority -> NotificationPriority -> Bool
Eq, Int -> NotificationPriority -> ShowS
[NotificationPriority] -> ShowS
NotificationPriority -> String
(Int -> NotificationPriority -> ShowS)
-> (NotificationPriority -> String)
-> ([NotificationPriority] -> ShowS)
-> Show NotificationPriority
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NotificationPriority -> ShowS
showsPrec :: Int -> NotificationPriority -> ShowS
$cshow :: NotificationPriority -> String
show :: NotificationPriority -> String
$cshowList :: [NotificationPriority] -> ShowS
showList :: [NotificationPriority] -> ShowS
Show)
data NotificationIcon
= NotificationIconThemed [Text]
| NotificationIconBytes ByteString
deriving (NotificationIcon -> NotificationIcon -> Bool
(NotificationIcon -> NotificationIcon -> Bool)
-> (NotificationIcon -> NotificationIcon -> Bool)
-> Eq NotificationIcon
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NotificationIcon -> NotificationIcon -> Bool
== :: NotificationIcon -> NotificationIcon -> Bool
$c/= :: NotificationIcon -> NotificationIcon -> Bool
/= :: NotificationIcon -> NotificationIcon -> Bool
Eq, Int -> NotificationIcon -> ShowS
[NotificationIcon] -> ShowS
NotificationIcon -> String
(Int -> NotificationIcon -> ShowS)
-> (NotificationIcon -> String)
-> ([NotificationIcon] -> ShowS)
-> Show NotificationIcon
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NotificationIcon -> ShowS
showsPrec :: Int -> NotificationIcon -> ShowS
$cshow :: NotificationIcon -> String
show :: NotificationIcon -> String
$cshowList :: [NotificationIcon] -> ShowS
showList :: [NotificationIcon] -> ShowS
Show)
data NotificationButton = NotificationButton
{ NotificationButton -> Text
label_ :: Text,
NotificationButton -> Text
action :: Text,
NotificationButton -> Maybe Variant
target :: Maybe Variant
}
deriving (NotificationButton -> NotificationButton -> Bool
(NotificationButton -> NotificationButton -> Bool)
-> (NotificationButton -> NotificationButton -> Bool)
-> Eq NotificationButton
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NotificationButton -> NotificationButton -> Bool
== :: NotificationButton -> NotificationButton -> Bool
$c/= :: NotificationButton -> NotificationButton -> Bool
/= :: NotificationButton -> NotificationButton -> Bool
Eq, Int -> NotificationButton -> ShowS
[NotificationButton] -> ShowS
NotificationButton -> String
(Int -> NotificationButton -> ShowS)
-> (NotificationButton -> String)
-> ([NotificationButton] -> ShowS)
-> Show NotificationButton
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NotificationButton -> ShowS
showsPrec :: Int -> NotificationButton -> ShowS
$cshow :: NotificationButton -> String
show :: NotificationButton -> String
$cshowList :: [NotificationButton] -> ShowS
showList :: [NotificationButton] -> ShowS
Show)
addNotificationOptions ::
Text ->
AddNotificationOptions
addNotificationOptions :: Text -> AddNotificationOptions
addNotificationOptions Text
id =
AddNotificationOptions
{ Text
$sel:id:AddNotificationOptions :: Text
id :: Text
id,
$sel:title:AddNotificationOptions :: Maybe Text
title = Maybe Text
forall a. Maybe a
Nothing,
$sel:body:AddNotificationOptions :: Maybe Text
body = Maybe Text
forall a. Maybe a
Nothing,
$sel:priority:AddNotificationOptions :: Maybe NotificationPriority
priority = Maybe NotificationPriority
forall a. Maybe a
Nothing,
$sel:icon:AddNotificationOptions :: Maybe NotificationIcon
icon = Maybe NotificationIcon
forall a. Maybe a
Nothing,
$sel:defaultAction:AddNotificationOptions :: Maybe Text
defaultAction = Maybe Text
forall a. Maybe a
Nothing,
$sel:defaultActionTarget:AddNotificationOptions :: Maybe Variant
defaultActionTarget = Maybe Variant
forall a. Maybe a
Nothing,
$sel:buttons:AddNotificationOptions :: Maybe [NotificationButton]
buttons = Maybe [NotificationButton]
forall a. Maybe a
Nothing
}
newtype RemoveNotificationOptions = RemoveNotificationOptions
{RemoveNotificationOptions -> Text
id :: Text}
deriving (RemoveNotificationOptions -> RemoveNotificationOptions -> Bool
(RemoveNotificationOptions -> RemoveNotificationOptions -> Bool)
-> (RemoveNotificationOptions -> RemoveNotificationOptions -> Bool)
-> Eq RemoveNotificationOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RemoveNotificationOptions -> RemoveNotificationOptions -> Bool
== :: RemoveNotificationOptions -> RemoveNotificationOptions -> Bool
$c/= :: RemoveNotificationOptions -> RemoveNotificationOptions -> Bool
/= :: RemoveNotificationOptions -> RemoveNotificationOptions -> Bool
Eq, Int -> RemoveNotificationOptions -> ShowS
[RemoveNotificationOptions] -> ShowS
RemoveNotificationOptions -> String
(Int -> RemoveNotificationOptions -> ShowS)
-> (RemoveNotificationOptions -> String)
-> ([RemoveNotificationOptions] -> ShowS)
-> Show RemoveNotificationOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RemoveNotificationOptions -> ShowS
showsPrec :: Int -> RemoveNotificationOptions -> ShowS
$cshow :: RemoveNotificationOptions -> String
show :: RemoveNotificationOptions -> String
$cshowList :: [RemoveNotificationOptions] -> ShowS
showList :: [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 =
IO [Variant] -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO [Variant] -> IO ()) -> IO [Variant] -> IO ()
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 = Text -> Variant
forall a. IsVariant a => a -> Variant
DBus.toVariant AddNotificationOptions
options.id
optionsArg :: Variant
optionsArg =
Map Text Variant -> Variant
forall a. IsVariant a => a -> Variant
DBus.toVariant (Map Text Variant -> Variant)
-> ([Maybe (Text, Variant)] -> Map Text Variant)
-> [Maybe (Text, Variant)]
-> Variant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Variant)] -> Map Text Variant
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, Variant)] -> Map Text Variant)
-> ([Maybe (Text, Variant)] -> [(Text, Variant)])
-> [Maybe (Text, Variant)]
-> Map Text Variant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Text, Variant)] -> [(Text, Variant)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Text, Variant)] -> Variant)
-> [Maybe (Text, Variant)] -> Variant
forall a b. (a -> b) -> a -> b
$
[ Text -> Maybe Text -> Maybe (Text, Variant)
forall a. IsVariant a => Text -> Maybe a -> Maybe (Text, Variant)
toVariantPair Text
"title" AddNotificationOptions
options.title,
Text -> Maybe Text -> Maybe (Text, Variant)
forall a. IsVariant a => Text -> Maybe a -> Maybe (Text, Variant)
toVariantPair Text
"body" AddNotificationOptions
options.body,
(NotificationPriority -> Text)
-> Text -> Maybe NotificationPriority -> Maybe (Text, Variant)
forall b a.
IsVariant b =>
(a -> b) -> Text -> Maybe a -> Maybe (Text, Variant)
toVariantPair' NotificationPriority -> Text
encodePriority Text
"priority" AddNotificationOptions
options.priority,
(NotificationIcon -> (Text, Variant))
-> Text -> Maybe NotificationIcon -> Maybe (Text, Variant)
forall b a.
IsVariant b =>
(a -> b) -> Text -> Maybe a -> Maybe (Text, Variant)
toVariantPair' NotificationIcon -> (Text, Variant)
encodeIcon Text
"icon" AddNotificationOptions
options.icon,
Text -> Maybe Text -> Maybe (Text, Variant)
forall a. IsVariant a => Text -> Maybe a -> Maybe (Text, Variant)
toVariantPair Text
"default-action" AddNotificationOptions
options.defaultAction,
(Text
"default-action-target",) (Variant -> (Text, Variant))
-> Maybe Variant -> Maybe (Text, Variant)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AddNotificationOptions
options.defaultActionTarget,
([NotificationButton] -> [Map Text Variant])
-> Text -> Maybe [NotificationButton] -> Maybe (Text, Variant)
forall b a.
IsVariant b =>
(a -> b) -> Text -> Maybe a -> Maybe (Text, Variant)
toVariantPair' ((NotificationButton -> Map Text Variant)
-> [NotificationButton] -> [Map Text Variant]
forall a b. (a -> b) -> [a] -> [b]
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 =
IO [Variant] -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO [Variant] -> IO ()) -> IO [Variant] -> IO ()
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 = Text -> Variant
forall a. IsVariant a => a -> Variant
DBus.toVariant RemoveNotificationOptions
options.id
type NotificationActionInvokedCallback =
Text ->
Text ->
Maybe Variant ->
IO ()
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" (([Variant] -> IO ()) -> IO SignalHandler)
-> ([Variant] -> IO ()) -> IO SignalHandler
forall a b. (a -> b) -> a -> b
$ \[Variant]
signalBody -> do
case [Variant]
signalBody of
[Variant
notificationId, Variant
actionName, Variant
parameter]
| Just Text
notificationId' <- Variant -> Maybe Text
forall a. IsVariant a => Variant -> Maybe a
DBus.fromVariant Variant
notificationId,
Just Text
actionName' <- Variant -> Maybe Text
forall a. IsVariant a => Variant -> Maybe a
DBus.fromVariant Variant
actionName,
Just [Variant]
parameter' <- Variant -> Maybe [Variant]
forall a. IsVariant a => Variant -> Maybe a
DBus.fromVariant Variant
parameter -> do
NotificationActionInvokedCallback
handler Text
notificationId' Text
actionName' ([Variant] -> Maybe Variant
forall a. [a] -> Maybe a
listToMaybe [Variant]
parameter')
[Variant]
_ ->
ClientError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (ClientError -> IO ())
-> (String -> ClientError) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ClientError
DBus.clientError (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"handleNotificationActionInvoked: could not parse signal body: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Variant] -> String
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", [Text] -> Variant
forall a. IsVariant a => a -> Variant
DBus.toVariant [Text]
iconNames)
NotificationIconBytes ByteString
bytes -> (Text
"bytes", ByteString -> Variant
forall a. IsVariant a => a -> Variant
DBus.toVariant ByteString
bytes)
encodeButton :: NotificationButton -> Map Text Variant
encodeButton :: NotificationButton -> Map Text Variant
encodeButton NotificationButton
button =
[(Text, Variant)] -> Map Text Variant
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, Variant)] -> Map Text Variant)
-> ([Maybe (Text, Variant)] -> [(Text, Variant)])
-> [Maybe (Text, Variant)]
-> Map Text Variant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Text, Variant)] -> [(Text, Variant)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Text, Variant)] -> Map Text Variant)
-> [Maybe (Text, Variant)] -> Map Text Variant
forall a b. (a -> b) -> a -> b
$
[ Text -> Maybe Text -> Maybe (Text, Variant)
forall a. IsVariant a => Text -> Maybe a -> Maybe (Text, Variant)
toVariantPair Text
"label" (Text -> Maybe Text
forall a. a -> Maybe a
Just NotificationButton
button.label_),
Text -> Maybe Text -> Maybe (Text, Variant)
forall a. IsVariant a => Text -> Maybe a -> Maybe (Text, Variant)
toVariantPair Text
"action" (Text -> Maybe Text
forall a. a -> Maybe a
Just NotificationButton
button.action),
Text -> Maybe Variant -> Maybe (Text, Variant)
forall a. IsVariant a => Text -> Maybe a -> Maybe (Text, Variant)
toVariantPair Text
"target" NotificationButton
button.target
]