{-# LANGUAGE OverloadedStrings #-}
-- |A library for issuing notifications using FreeDesktop.org Desktop
-- Notifications protocol. This protocol is used to communicate with services
-- such as Ubuntu's NotifyOSD.
--
-- This library does not yet support receiving events relating to notifications,
-- or images in notifications: if you need that functionality please contact the maintainer.
module DBus.Notify
    (
    -- * Usage
    -- $usage

    -- * Displaying notifications
      notify
    , replace
    , Notification
    , mkSessionClient
    , connectSession
    , Client
    -- * Constructing notifications
    , blankNote
    , Note (..)
    , Body (..)
    , URL
    , Timeout (..)
    , Action (..)
    , Image
    , Icon (..)
    , Category (..)
    , UrgencyLevel (..)
    , Hint (..)
    -- * Capabilities
    , getCapabilities
    , Capability (..)
    ) where

import DBus
import DBus.Client
import Control.Applicative
import Data.Maybe (fromMaybe, fromJust)
import Data.Int
import Data.Word
import Data.Char (isLower, toLower)
import Control.Arrow (first, second, (***))
import qualified Data.Map as M

-- $usage
-- A DBUS 'Client' is needed to display notifications, so the first step is to
-- create one. The notification service will usually run on the session bus (the DBUS
-- instance responsible for messages within a desktop session) so you can use
-- 'sessionConnect' to create the client.
--
-- To display a notification, first construct a 'Note'. This can be done in pure
-- code. Notifications can have actions, categories, etc. associated to them but
-- we will just show a simple example (these features are not supported by all
-- notification services anyway).
--
-- Use the function 'notify' to display a 'Note'. This returns a handle which
-- can be passed to 'replace' to replace a notification.
--
-- @
--import DBus.Notify
--
--main = do
--         client <- sessionConnect
--         let startNote = appNote { summary=\"Starting\"
--                                 , body=(Just $ Text \"Calculating fib(33).\") }
--         notification <- notify client startNote
--         let endNote = appNote { summary=\"Finished\"
--                               , body=(Just . Text . show $ fib33) }
--         fib33 \`seq\` replace client notification endNote
--     where
--         appNote = blankNote { appName=\"Fibonacci Demonstration\" }
--         fib 0 = 0
--         fib 1 = 1
--         fib n = fib (n-1) + fib (n-2)
--         fib33 = fib 33
-- @

{-# DEPRECATED mkSessionClient "Use DBus.Client.connectSession" #-}
mkSessionClient :: IO Client
mkSessionClient :: IO Client
mkSessionClient = IO Client
connectSession

-- |A 'Note' with default values.
-- All fields are blank except for 'expiry', which is 'Dependent'.
blankNote :: Note
blankNote :: Note
blankNote = Note { appName :: [Char]
appName=[Char]
""
                   , appImage :: Maybe Icon
appImage=Maybe Icon
forall a. Maybe a
Nothing
                   , summary :: [Char]
summary=[Char]
""
                   , body :: Maybe Body
body=Maybe Body
forall a. Maybe a
Nothing
                   , actions :: [(Action, [Char])]
actions=[]
                   , hints :: [Hint]
hints=[]
                   , expiry :: Timeout
expiry=Timeout
Dependent
                   }

-- |Contents of a notification
data Note = Note { Note -> [Char]
appName :: String
                 , Note -> Maybe Icon
appImage :: Maybe Icon
                 , Note -> [Char]
summary :: String
                 , Note -> Maybe Body
body :: Maybe Body
                 , Note -> [(Action, [Char])]
actions :: [(Action, String)]
                 , Note -> [Hint]
hints :: [Hint]
                 , Note -> Timeout
expiry :: Timeout
                 }
    deriving (Note -> Note -> Bool
(Note -> Note -> Bool) -> (Note -> Note -> Bool) -> Eq Note
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Note -> Note -> Bool
== :: Note -> Note -> Bool
$c/= :: Note -> Note -> Bool
/= :: Note -> Note -> Bool
Eq, Int -> Note -> ShowS
[Note] -> ShowS
Note -> [Char]
(Int -> Note -> ShowS)
-> (Note -> [Char]) -> ([Note] -> ShowS) -> Show Note
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Note -> ShowS
showsPrec :: Int -> Note -> ShowS
$cshow :: Note -> [Char]
show :: Note -> [Char]
$cshowList :: [Note] -> ShowS
showList :: [Note] -> ShowS
Show)

-- |Message bodies may contain simple markup.
-- NotifyOSD doesn't support any markup.
data Body =   Text String
            | Bold Body
            | Italic Body
            | Underline Body
            | Hyperlink URL Body
            | Img URL String
            | Concat Body Body
    deriving (Body -> Body -> Bool
(Body -> Body -> Bool) -> (Body -> Body -> Bool) -> Eq Body
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Body -> Body -> Bool
== :: Body -> Body -> Bool
$c/= :: Body -> Body -> Bool
/= :: Body -> Body -> Bool
Eq, Int -> Body -> ShowS
[Body] -> ShowS
Body -> [Char]
(Int -> Body -> ShowS)
-> (Body -> [Char]) -> ([Body] -> ShowS) -> Show Body
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Body -> ShowS
showsPrec :: Int -> Body -> ShowS
$cshow :: Body -> [Char]
show :: Body -> [Char]
$cshowList :: [Body] -> ShowS
showList :: [Body] -> ShowS
Show)

type URL = String

-- |Length of time to display notifications. NotifyOSD seems to ignore these.
data Timeout =   Never              -- ^Wait to be dismissed by user
               | Dependent          -- ^Let the notification service decide
               | Milliseconds Int32 -- ^Show notification for a fixed duration
                                    -- (must be positive)
    deriving (Timeout -> Timeout -> Bool
(Timeout -> Timeout -> Bool)
-> (Timeout -> Timeout -> Bool) -> Eq Timeout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Timeout -> Timeout -> Bool
== :: Timeout -> Timeout -> Bool
$c/= :: Timeout -> Timeout -> Bool
/= :: Timeout -> Timeout -> Bool
Eq, Int -> Timeout -> ShowS
[Timeout] -> ShowS
Timeout -> [Char]
(Int -> Timeout -> ShowS)
-> (Timeout -> [Char]) -> ([Timeout] -> ShowS) -> Show Timeout
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Timeout -> ShowS
showsPrec :: Int -> Timeout -> ShowS
$cshow :: Timeout -> [Char]
show :: Timeout -> [Char]
$cshowList :: [Timeout] -> ShowS
showList :: [Timeout] -> ShowS
Show)

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

-- |Images are not yet supported
newtype Image = Image { Image -> [Char]
bitmap :: String }
    deriving (Image -> Image -> Bool
(Image -> Image -> Bool) -> (Image -> Image -> Bool) -> Eq Image
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Image -> Image -> Bool
== :: Image -> Image -> Bool
$c/= :: Image -> Image -> Bool
/= :: Image -> Image -> Bool
Eq, Int -> Image -> ShowS
[Image] -> ShowS
Image -> [Char]
(Int -> Image -> ShowS)
-> (Image -> [Char]) -> ([Image] -> ShowS) -> Show Image
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Image -> ShowS
showsPrec :: Int -> Image -> ShowS
$cshow :: Image -> [Char]
show :: Image -> [Char]
$cshowList :: [Image] -> ShowS
showList :: [Image] -> ShowS
Show)

-- |An Icon is either a path to an image, or a name in an icon theme
data Icon = File FilePath | Icon String
    deriving (Icon -> Icon -> Bool
(Icon -> Icon -> Bool) -> (Icon -> Icon -> Bool) -> Eq Icon
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Icon -> Icon -> Bool
== :: Icon -> Icon -> Bool
$c/= :: Icon -> Icon -> Bool
/= :: Icon -> Icon -> Bool
Eq, Int -> Icon -> ShowS
[Icon] -> ShowS
Icon -> [Char]
(Int -> Icon -> ShowS)
-> (Icon -> [Char]) -> ([Icon] -> ShowS) -> Show Icon
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Icon -> ShowS
showsPrec :: Int -> Icon -> ShowS
$cshow :: Icon -> [Char]
show :: Icon -> [Char]
$cshowList :: [Icon] -> ShowS
showList :: [Icon] -> ShowS
Show)

iconString :: Icon -> [Char]
iconString (File [Char]
fp) = [Char]
"file://" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
fp
iconString (Icon [Char]
name) = [Char]
name

-- |Urgency of the notification. Notifications may be prioritised by urgency.
data UrgencyLevel =   Low
                    | Normal
                    | Critical -- ^Critical notifications require user attention
    deriving (UrgencyLevel -> UrgencyLevel -> Bool
(UrgencyLevel -> UrgencyLevel -> Bool)
-> (UrgencyLevel -> UrgencyLevel -> Bool) -> Eq UrgencyLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UrgencyLevel -> UrgencyLevel -> Bool
== :: UrgencyLevel -> UrgencyLevel -> Bool
$c/= :: UrgencyLevel -> UrgencyLevel -> Bool
/= :: UrgencyLevel -> UrgencyLevel -> Bool
Eq, Eq UrgencyLevel
Eq UrgencyLevel =>
(UrgencyLevel -> UrgencyLevel -> Ordering)
-> (UrgencyLevel -> UrgencyLevel -> Bool)
-> (UrgencyLevel -> UrgencyLevel -> Bool)
-> (UrgencyLevel -> UrgencyLevel -> Bool)
-> (UrgencyLevel -> UrgencyLevel -> Bool)
-> (UrgencyLevel -> UrgencyLevel -> UrgencyLevel)
-> (UrgencyLevel -> UrgencyLevel -> UrgencyLevel)
-> Ord UrgencyLevel
UrgencyLevel -> UrgencyLevel -> Bool
UrgencyLevel -> UrgencyLevel -> Ordering
UrgencyLevel -> UrgencyLevel -> UrgencyLevel
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: UrgencyLevel -> UrgencyLevel -> Ordering
compare :: UrgencyLevel -> UrgencyLevel -> Ordering
$c< :: UrgencyLevel -> UrgencyLevel -> Bool
< :: UrgencyLevel -> UrgencyLevel -> Bool
$c<= :: UrgencyLevel -> UrgencyLevel -> Bool
<= :: UrgencyLevel -> UrgencyLevel -> Bool
$c> :: UrgencyLevel -> UrgencyLevel -> Bool
> :: UrgencyLevel -> UrgencyLevel -> Bool
$c>= :: UrgencyLevel -> UrgencyLevel -> Bool
>= :: UrgencyLevel -> UrgencyLevel -> Bool
$cmax :: UrgencyLevel -> UrgencyLevel -> UrgencyLevel
max :: UrgencyLevel -> UrgencyLevel -> UrgencyLevel
$cmin :: UrgencyLevel -> UrgencyLevel -> UrgencyLevel
min :: UrgencyLevel -> UrgencyLevel -> UrgencyLevel
Ord, Int -> UrgencyLevel
UrgencyLevel -> Int
UrgencyLevel -> [UrgencyLevel]
UrgencyLevel -> UrgencyLevel
UrgencyLevel -> UrgencyLevel -> [UrgencyLevel]
UrgencyLevel -> UrgencyLevel -> UrgencyLevel -> [UrgencyLevel]
(UrgencyLevel -> UrgencyLevel)
-> (UrgencyLevel -> UrgencyLevel)
-> (Int -> UrgencyLevel)
-> (UrgencyLevel -> Int)
-> (UrgencyLevel -> [UrgencyLevel])
-> (UrgencyLevel -> UrgencyLevel -> [UrgencyLevel])
-> (UrgencyLevel -> UrgencyLevel -> [UrgencyLevel])
-> (UrgencyLevel -> UrgencyLevel -> UrgencyLevel -> [UrgencyLevel])
-> Enum UrgencyLevel
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: UrgencyLevel -> UrgencyLevel
succ :: UrgencyLevel -> UrgencyLevel
$cpred :: UrgencyLevel -> UrgencyLevel
pred :: UrgencyLevel -> UrgencyLevel
$ctoEnum :: Int -> UrgencyLevel
toEnum :: Int -> UrgencyLevel
$cfromEnum :: UrgencyLevel -> Int
fromEnum :: UrgencyLevel -> Int
$cenumFrom :: UrgencyLevel -> [UrgencyLevel]
enumFrom :: UrgencyLevel -> [UrgencyLevel]
$cenumFromThen :: UrgencyLevel -> UrgencyLevel -> [UrgencyLevel]
enumFromThen :: UrgencyLevel -> UrgencyLevel -> [UrgencyLevel]
$cenumFromTo :: UrgencyLevel -> UrgencyLevel -> [UrgencyLevel]
enumFromTo :: UrgencyLevel -> UrgencyLevel -> [UrgencyLevel]
$cenumFromThenTo :: UrgencyLevel -> UrgencyLevel -> UrgencyLevel -> [UrgencyLevel]
enumFromThenTo :: UrgencyLevel -> UrgencyLevel -> UrgencyLevel -> [UrgencyLevel]
Enum, Int -> UrgencyLevel -> ShowS
[UrgencyLevel] -> ShowS
UrgencyLevel -> [Char]
(Int -> UrgencyLevel -> ShowS)
-> (UrgencyLevel -> [Char])
-> ([UrgencyLevel] -> ShowS)
-> Show UrgencyLevel
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UrgencyLevel -> ShowS
showsPrec :: Int -> UrgencyLevel -> ShowS
$cshow :: UrgencyLevel -> [Char]
show :: UrgencyLevel -> [Char]
$cshowList :: [UrgencyLevel] -> ShowS
showList :: [UrgencyLevel] -> ShowS
Show)

-- |Various hints about how the notification should be displayed
data Hint =   Urgency UrgencyLevel
            | Category Category
            -- DesktopEntry ApplicationDesktopID
            | ImageData Image
            | ImagePath Icon
            | SoundFile FilePath
            | SuppressSound Bool
            | X Int32
            | Y Int32
    deriving (Hint -> Hint -> Bool
(Hint -> Hint -> Bool) -> (Hint -> Hint -> Bool) -> Eq Hint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Hint -> Hint -> Bool
== :: Hint -> Hint -> Bool
$c/= :: Hint -> Hint -> Bool
/= :: Hint -> Hint -> Bool
Eq, Int -> Hint -> ShowS
[Hint] -> ShowS
Hint -> [Char]
(Int -> Hint -> ShowS)
-> (Hint -> [Char]) -> ([Hint] -> ShowS) -> Show Hint
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Hint -> ShowS
showsPrec :: Int -> Hint -> ShowS
$cshow :: Hint -> [Char]
show :: Hint -> [Char]
$cshowList :: [Hint] -> ShowS
showList :: [Hint] -> ShowS
Show)

-- |Categorisation of (some) notifications
data Category =   Device | DeviceAdded | DeviceError | DeviceRemoved
                | Email | EmailArrived | EmailBounced
                | Im | ImError | ImReceived
                | Network | NetworkConnected | NetworkDisconnected | NetworkError
                | Presence | PresenceOffline | PresenceOnline
                | Transfer | TransferComplete | TransferError
    deriving (Category -> Category -> Bool
(Category -> Category -> Bool)
-> (Category -> Category -> Bool) -> Eq Category
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Category -> Category -> Bool
== :: Category -> Category -> Bool
$c/= :: Category -> Category -> Bool
/= :: Category -> Category -> Bool
Eq, Int -> Category -> ShowS
[Category] -> ShowS
Category -> [Char]
(Int -> Category -> ShowS)
-> (Category -> [Char]) -> ([Category] -> ShowS) -> Show Category
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Category -> ShowS
showsPrec :: Int -> Category -> ShowS
$cshow :: Category -> [Char]
show :: Category -> [Char]
$cshowList :: [Category] -> ShowS
showList :: [Category] -> ShowS
Show)

data ClosedReason = Expired | Dismissed | CloseNotificationCalled
data NotificationEvent = ActionInvoked Action | Closed ClosedReason

-- |A handle on a displayed notification
-- The notification may not have reached the screen yet, and may already have
-- been closed.
data Notification = Notification { Notification -> Word32
notificationId :: Word32 }

-- |Display a notification.
-- Return a handle which can be used to replace the notification.
notify :: Client -> Note -> IO Notification
notify :: Client -> Note -> IO Notification
notify Client
cl = Client -> Notification -> Note -> IO Notification
replace Client
cl (Notification { notificationId :: Word32
notificationId=Word32
0 })

callNotificationMethod :: Client -> MemberName -> [Variant] -> IO MethodReturn
callNotificationMethod Client
client MemberName
methodName [Variant]
args =
    Client -> MethodCall -> IO MethodReturn
call_ Client
client (MethodCall -> IO MethodReturn) -> MethodCall -> IO MethodReturn
forall a b. (a -> b) -> a -> b
$ (ObjectPath -> InterfaceName -> MemberName -> MethodCall
methodCall ObjectPath
path InterfaceName
iface MemberName
methodName)
	{ methodCallDestination=Just busname
	, methodCallBody=args
	}
    where
        busname :: BusName
busname = BusName
"org.freedesktop.Notifications"
        path :: ObjectPath
path = ObjectPath
"/org/freedesktop/Notifications"
        iface :: InterfaceName
iface = InterfaceName
"org.freedesktop.Notifications"

-- |Replace an existing notification.
-- If the notification has already been closed, a new one will be created.
replace :: Client -> Notification -> Note -> IO Notification
replace :: Client -> Notification -> Note -> IO Notification
replace Client
cl (Notification { notificationId :: Notification -> Word32
notificationId=Word32
replaceId }) Note
note =
    Word32 -> Notification
Notification (Word32 -> Notification)
-> (MethodReturn -> Word32) -> MethodReturn -> Notification
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Word32 -> Word32
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Word32 -> Word32)
-> (MethodReturn -> Maybe Word32) -> MethodReturn -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Variant -> Maybe Word32
forall a. IsVariant a => Variant -> Maybe a
fromVariant (Variant -> Maybe Word32)
-> (MethodReturn -> Variant) -> MethodReturn -> Maybe Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Variant] -> Variant
forall a. HasCallStack => [a] -> a
head ([Variant] -> Variant)
-> (MethodReturn -> [Variant]) -> MethodReturn -> Variant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MethodReturn -> [Variant]
methodReturnBody (MethodReturn -> Notification)
-> IO MethodReturn -> IO Notification
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        Client -> MemberName -> [Variant] -> IO MethodReturn
callNotificationMethod Client
cl MemberName
"Notify" [Variant]
args
    where
        args :: [Variant]
args = ((Note -> Variant) -> Variant) -> [Note -> Variant] -> [Variant]
forall a b. (a -> b) -> [a] -> [b]
map ((Note -> Variant) -> Note -> Variant
forall a b. (a -> b) -> a -> b
$ Note
note)
            [ [Char] -> Variant
forall a. IsVariant a => a -> Variant
toVariant ([Char] -> Variant) -> (Note -> [Char]) -> Note -> Variant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Note -> [Char]
appName
               , Variant -> Note -> Variant
forall a b. a -> b -> a
const (Variant -> Note -> Variant) -> Variant -> Note -> Variant
forall a b. (a -> b) -> a -> b
$ Word32 -> Variant
forall a. IsVariant a => a -> Variant
toVariant (Word32
replaceId::Word32)
               , [Char] -> Variant
forall a. IsVariant a => a -> Variant
toVariant ([Char] -> Variant) -> (Note -> [Char]) -> Note -> Variant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
"" (Maybe [Char] -> [Char])
-> (Note -> Maybe [Char]) -> Note -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Icon -> [Char]) -> Maybe Icon -> Maybe [Char]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Icon -> [Char]
iconString (Maybe Icon -> Maybe [Char])
-> (Note -> Maybe Icon) -> Note -> Maybe [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Note -> Maybe Icon
appImage
               , [Char] -> Variant
forall a. IsVariant a => a -> Variant
toVariant ([Char] -> Variant) -> (Note -> [Char]) -> Note -> Variant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Note -> [Char]
summary
               , [Char] -> Variant
forall a. IsVariant a => a -> Variant
toVariant ([Char] -> Variant) -> (Note -> [Char]) -> Note -> Variant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
"" (Maybe [Char] -> [Char])
-> (Note -> Maybe [Char]) -> Note -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Body -> [Char]) -> Maybe Body -> Maybe [Char]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Body -> [Char]
flattenBody (Maybe Body -> Maybe [Char])
-> (Note -> Maybe Body) -> Note -> Maybe [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Note -> Maybe Body
body
               , [[Char]] -> Variant
forall a. IsVariant a => a -> Variant
toVariant ([[Char]] -> Variant) -> (Note -> [[Char]]) -> Note -> Variant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Action, [Char])] -> [[Char]]
actionsArray ([(Action, [Char])] -> [[Char]])
-> (Note -> [(Action, [Char])]) -> Note -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Note -> [(Action, [Char])]
actions
               , Map [Char] Variant -> Variant
forall a. IsVariant a => a -> Variant
toVariant (Map [Char] Variant -> Variant)
-> (Note -> Map [Char] Variant) -> Note -> Variant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Hint] -> Map [Char] Variant
hintsDict ([Hint] -> Map [Char] Variant)
-> (Note -> [Hint]) -> Note -> Map [Char] Variant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Note -> [Hint]
hints
               , Int32 -> Variant
forall a. IsVariant a => a -> Variant
toVariant (Int32 -> Variant) -> (Note -> Int32) -> Note -> Variant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Timeout -> Int32
timeoutInt (Timeout -> Int32) -> (Note -> Timeout) -> Note -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Note -> Timeout
expiry
               ]

data Capability =   ActionsCap | BodyCap | BodyHyperlinksCap | BodyImagesCap
                  | BodyMarkupCap | IconMultiCap | IconStaticCap | SoundCap
                  | UnknownCap String
    deriving (Capability -> Capability -> Bool
(Capability -> Capability -> Bool)
-> (Capability -> Capability -> Bool) -> Eq Capability
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Capability -> Capability -> Bool
== :: Capability -> Capability -> Bool
$c/= :: Capability -> Capability -> Bool
/= :: Capability -> Capability -> Bool
Eq, ReadPrec [Capability]
ReadPrec Capability
Int -> ReadS Capability
ReadS [Capability]
(Int -> ReadS Capability)
-> ReadS [Capability]
-> ReadPrec Capability
-> ReadPrec [Capability]
-> Read Capability
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Capability
readsPrec :: Int -> ReadS Capability
$creadList :: ReadS [Capability]
readList :: ReadS [Capability]
$creadPrec :: ReadPrec Capability
readPrec :: ReadPrec Capability
$creadListPrec :: ReadPrec [Capability]
readListPrec :: ReadPrec [Capability]
Read, Int -> Capability -> ShowS
[Capability] -> ShowS
Capability -> [Char]
(Int -> Capability -> ShowS)
-> (Capability -> [Char])
-> ([Capability] -> ShowS)
-> Show Capability
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Capability -> ShowS
showsPrec :: Int -> Capability -> ShowS
$cshow :: Capability -> [Char]
show :: Capability -> [Char]
$cshowList :: [Capability] -> ShowS
showList :: [Capability] -> ShowS
Show)

-- |Determine the server's capabilities
getCapabilities :: Client -> IO [Capability]
getCapabilities :: Client -> IO [Capability]
getCapabilities Client
cl = ([Char] -> Capability) -> [[Char]] -> [Capability]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Capability
readCapability ([[Char]] -> [Capability])
-> (MethodReturn -> [[Char]]) -> MethodReturn -> [Capability]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe [[Char]] -> [[Char]]
forall a. HasCallStack => Maybe a -> a
fromJust
                    (Maybe [[Char]] -> [[Char]])
-> (MethodReturn -> Maybe [[Char]]) -> MethodReturn -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Variant -> Maybe [[Char]]
forall a. IsVariant a => Variant -> Maybe a
fromVariant (Variant -> Maybe [[Char]])
-> (MethodReturn -> Variant) -> MethodReturn -> Maybe [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Variant] -> Variant
forall a. HasCallStack => [a] -> a
head ([Variant] -> Variant)
-> (MethodReturn -> [Variant]) -> MethodReturn -> Variant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MethodReturn -> [Variant]
methodReturnBody
                    (MethodReturn -> [Capability])
-> IO MethodReturn -> IO [Capability]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Client -> MemberName -> [Variant] -> IO MethodReturn
callNotificationMethod Client
cl MemberName
"GetCapabilities" []

readCapability :: String -> Capability
readCapability :: [Char] -> Capability
readCapability [Char]
s = case [Char]
s of
                    [Char]
"actions" -> Capability
ActionsCap
                    [Char]
"body" -> Capability
BodyCap
                    [Char]
"body-hyperlinks" -> Capability
BodyHyperlinksCap
                    [Char]
"body-images" -> Capability
BodyImagesCap
                    [Char]
"body-markup" -> Capability
BodyMarkupCap
                    [Char]
"icon-multi" -> Capability
IconMultiCap
                    [Char]
"icon-static" -> Capability
IconStaticCap
                    [Char]
"sound" -> Capability
SoundCap
                    [Char]
s -> [Char] -> Capability
UnknownCap [Char]
s

timeoutInt :: Timeout -> Int32
timeoutInt :: Timeout -> Int32
timeoutInt Timeout
Never = Int32
0
timeoutInt Timeout
Dependent = -Int32
1
timeoutInt (Milliseconds Int32
n)
    | Int32
n Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
> Int32
0     = Int32
n
    | Bool
otherwise = [Char] -> Int32
forall a. HasCallStack => [Char] -> a
error [Char]
"notification timeout not positive"

flattenBody :: Body -> String
flattenBody :: Body -> [Char]
flattenBody (Text [Char]
s) = (Char -> [Char]) -> ShowS
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> [Char]
escape [Char]
s
    where
        escape :: Char -> [Char]
escape Char
'>' = [Char]
"&gt;"
        escape Char
'<' = [Char]
"&lt;"
        escape Char
'&' = [Char]
"&amp;"
        escape Char
x = [Char
x]
flattenBody (Bold Body
b) = [Char]
"<b>" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Body -> [Char]
flattenBody Body
b [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"</b>"
flattenBody (Italic Body
b) = [Char]
"<i>" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Body -> [Char]
flattenBody Body
b [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"</i>"
flattenBody (Underline Body
b) = [Char]
"<u>" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Body -> [Char]
flattenBody Body
b [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"</u>"
flattenBody (Hyperlink [Char]
h Body
b) = [Char]
"<a href=\"" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
h [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\">" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Body -> [Char]
flattenBody Body
b [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"</a>"
flattenBody (Img [Char]
h [Char]
alt) = [Char]
"<img src=\"" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
h [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\" alt=\"" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
alt [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\"/>"
flattenBody (Concat Body
b1 Body
b2) = Body -> [Char]
flattenBody Body
b1 [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Body -> [Char]
flattenBody Body
b2

--actionsArray :: [(Action, String)] -> [[String]]
actionsArray :: [(Action, [Char])] -> [[Char]]
actionsArray = ((Action, [Char]) -> [[Char]]) -> [(Action, [Char])] -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Action, [Char]) -> [[Char]]
pairList
    where
        pairList :: (Action, [Char]) -> [[Char]]
pairList (Action
a, [Char]
b) = [Action -> [Char]
actionName Action
a, [Char]
b]

hintsDict :: [Hint] -> M.Map String Variant
hintsDict :: [Hint] -> Map [Char] Variant
hintsDict = [([Char], Variant)] -> Map [Char] Variant
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([([Char], Variant)] -> Map [Char] Variant)
-> ([Hint] -> [([Char], Variant)]) -> [Hint] -> Map [Char] Variant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Hint -> ([Char], Variant)) -> [Hint] -> [([Char], Variant)]
forall a b. (a -> b) -> [a] -> [b]
map Hint -> ([Char], Variant)
hint
    where
        hint :: Hint -> (String, Variant)
        hint :: Hint -> ([Char], Variant)
hint (Urgency UrgencyLevel
u) = ([Char]
"urgency", Word8 -> Variant
forall a. IsVariant a => a -> Variant
toVariant (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ UrgencyLevel -> Int
forall a. Enum a => a -> Int
fromEnum UrgencyLevel
u :: Word8))
        hint (Category Category
c) = ([Char]
"category", [Char] -> Variant
forall a. IsVariant a => a -> Variant
toVariant ([Char] -> Variant) -> [Char] -> Variant
forall a b. (a -> b) -> a -> b
$ Category -> [Char]
catName Category
c)
        hint (ImagePath Icon
p) = ([Char]
"image-path", [Char] -> Variant
forall a. IsVariant a => a -> Variant
toVariant ([Char] -> Variant) -> [Char] -> Variant
forall a b. (a -> b) -> a -> b
$ Icon -> [Char]
iconString Icon
p)
        hint (ImageData Image
i) = ([Char]
"image-data", [Char] -> Variant
forall a. IsVariant a => a -> Variant
toVariant ([Char] -> Variant) -> [Char] -> Variant
forall a b. (a -> b) -> a -> b
$ Image -> [Char]
bitmap Image
i)
        hint (SoundFile [Char]
s) = ([Char]
"sound-file", [Char] -> Variant
forall a. IsVariant a => a -> Variant
toVariant [Char]
s)
        hint (SuppressSound Bool
b) = ([Char]
"suppress-sound", Bool -> Variant
forall a. IsVariant a => a -> Variant
toVariant Bool
b)
        hint (X Int32
x) = ([Char]
"x", Int32 -> Variant
forall a. IsVariant a => a -> Variant
toVariant Int32
x)
        hint (Y Int32
y) = ([Char]
"x", Int32 -> Variant
forall a. IsVariant a => a -> Variant
toVariant Int32
y)

-- HACK: Assumes the constructor for category foo.bar is FooBar and
-- categories have no capital letters
catName :: Category -> String
catName :: Category -> [Char]
catName Category
c = ShowS
catName' (Category -> [Char]
forall a. Show a => a -> [Char]
show Category
c)
    where
        catName' :: ShowS
catName' (Char
c:[Char]
cs) = (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Char
cChar -> ShowS
forall a. a -> [a] -> [a]
: (([Char] -> ShowS) -> ([Char], [Char]) -> [Char]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Char] -> ShowS
forall a. [a] -> [a] -> [a]
(++) (([Char], [Char]) -> [Char])
-> ([Char] -> ([Char], [Char])) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> ([Char], [Char]) -> ([Char], [Char])
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (Char
'.'Char -> ShowS
forall a. a -> [a] -> [a]
:) (([Char], [Char]) -> ([Char], [Char]))
-> ([Char] -> ([Char], [Char])) -> [Char] -> ([Char], [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isLower ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [Char]
cs)