{-# 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 :: String
-> Maybe Icon
-> String
-> Maybe Body
-> [(Action, String)]
-> [Hint]
-> Timeout
-> Note
Note { appName :: String
appName=String
""
                   , appImage :: Maybe Icon
appImage=Maybe Icon
forall a. Maybe a
Nothing
                   , summary :: String
summary=String
""
                   , body :: Maybe Body
body=Maybe Body
forall a. Maybe a
Nothing
                   , actions :: [(Action, String)]
actions=[]
                   , hints :: [Hint]
hints=[]
                   , expiry :: Timeout
expiry=Timeout
Dependent
                   }

-- |Contents of a notification
data Note = Note { Note -> String
appName :: String
                 , Note -> Maybe Icon
appImage :: Maybe Icon
                 , Note -> String
summary :: String
                 , Note -> Maybe Body
body :: Maybe Body
                 , Note -> [(Action, String)]
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
/= :: Note -> Note -> Bool
$c/= :: Note -> Note -> Bool
== :: Note -> Note -> Bool
$c== :: Note -> Note -> Bool
Eq, Int -> Note -> ShowS
[Note] -> ShowS
Note -> String
(Int -> Note -> ShowS)
-> (Note -> String) -> ([Note] -> ShowS) -> Show Note
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Note] -> ShowS
$cshowList :: [Note] -> ShowS
show :: Note -> String
$cshow :: Note -> String
showsPrec :: Int -> Note -> ShowS
$cshowsPrec :: Int -> 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
/= :: Body -> Body -> Bool
$c/= :: Body -> Body -> Bool
== :: Body -> Body -> Bool
$c== :: Body -> Body -> Bool
Eq, Int -> Body -> ShowS
[Body] -> ShowS
Body -> String
(Int -> Body -> ShowS)
-> (Body -> String) -> ([Body] -> ShowS) -> Show Body
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Body] -> ShowS
$cshowList :: [Body] -> ShowS
show :: Body -> String
$cshow :: Body -> String
showsPrec :: Int -> Body -> ShowS
$cshowsPrec :: Int -> 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
/= :: Timeout -> Timeout -> Bool
$c/= :: Timeout -> Timeout -> Bool
== :: Timeout -> Timeout -> Bool
$c== :: Timeout -> Timeout -> Bool
Eq, Int -> Timeout -> ShowS
[Timeout] -> ShowS
Timeout -> String
(Int -> Timeout -> ShowS)
-> (Timeout -> String) -> ([Timeout] -> ShowS) -> Show Timeout
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Timeout] -> ShowS
$cshowList :: [Timeout] -> ShowS
show :: Timeout -> String
$cshow :: Timeout -> String
showsPrec :: Int -> Timeout -> ShowS
$cshowsPrec :: Int -> Timeout -> ShowS
Show)

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

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

iconString :: Icon -> String
iconString (File String
fp) = String
"file://" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fp
iconString (Icon String
name) = String
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
/= :: UrgencyLevel -> UrgencyLevel -> Bool
$c/= :: UrgencyLevel -> UrgencyLevel -> Bool
== :: UrgencyLevel -> UrgencyLevel -> Bool
$c== :: 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
min :: UrgencyLevel -> UrgencyLevel -> UrgencyLevel
$cmin :: UrgencyLevel -> UrgencyLevel -> UrgencyLevel
max :: UrgencyLevel -> UrgencyLevel -> UrgencyLevel
$cmax :: UrgencyLevel -> UrgencyLevel -> UrgencyLevel
>= :: UrgencyLevel -> UrgencyLevel -> Bool
$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
compare :: UrgencyLevel -> UrgencyLevel -> Ordering
$ccompare :: UrgencyLevel -> UrgencyLevel -> Ordering
$cp1Ord :: Eq 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
enumFromThenTo :: UrgencyLevel -> UrgencyLevel -> UrgencyLevel -> [UrgencyLevel]
$cenumFromThenTo :: UrgencyLevel -> UrgencyLevel -> UrgencyLevel -> [UrgencyLevel]
enumFromTo :: UrgencyLevel -> UrgencyLevel -> [UrgencyLevel]
$cenumFromTo :: UrgencyLevel -> UrgencyLevel -> [UrgencyLevel]
enumFromThen :: UrgencyLevel -> UrgencyLevel -> [UrgencyLevel]
$cenumFromThen :: UrgencyLevel -> UrgencyLevel -> [UrgencyLevel]
enumFrom :: UrgencyLevel -> [UrgencyLevel]
$cenumFrom :: UrgencyLevel -> [UrgencyLevel]
fromEnum :: UrgencyLevel -> Int
$cfromEnum :: UrgencyLevel -> Int
toEnum :: Int -> UrgencyLevel
$ctoEnum :: Int -> UrgencyLevel
pred :: UrgencyLevel -> UrgencyLevel
$cpred :: UrgencyLevel -> UrgencyLevel
succ :: UrgencyLevel -> UrgencyLevel
$csucc :: UrgencyLevel -> UrgencyLevel
Enum, Int -> UrgencyLevel -> ShowS
[UrgencyLevel] -> ShowS
UrgencyLevel -> String
(Int -> UrgencyLevel -> ShowS)
-> (UrgencyLevel -> String)
-> ([UrgencyLevel] -> ShowS)
-> Show UrgencyLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UrgencyLevel] -> ShowS
$cshowList :: [UrgencyLevel] -> ShowS
show :: UrgencyLevel -> String
$cshow :: UrgencyLevel -> String
showsPrec :: Int -> UrgencyLevel -> ShowS
$cshowsPrec :: Int -> 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
/= :: Hint -> Hint -> Bool
$c/= :: Hint -> Hint -> Bool
== :: Hint -> Hint -> Bool
$c== :: Hint -> Hint -> Bool
Eq, Int -> Hint -> ShowS
[Hint] -> ShowS
Hint -> String
(Int -> Hint -> ShowS)
-> (Hint -> String) -> ([Hint] -> ShowS) -> Show Hint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Hint] -> ShowS
$cshowList :: [Hint] -> ShowS
show :: Hint -> String
$cshow :: Hint -> String
showsPrec :: Int -> Hint -> ShowS
$cshowsPrec :: Int -> 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
/= :: Category -> Category -> Bool
$c/= :: Category -> Category -> Bool
== :: Category -> Category -> Bool
$c== :: Category -> Category -> Bool
Eq, Int -> Category -> ShowS
[Category] -> ShowS
Category -> String
(Int -> Category -> ShowS)
-> (Category -> String) -> ([Category] -> ShowS) -> Show Category
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Category] -> ShowS
$cshowList :: [Category] -> ShowS
show :: Category -> String
$cshow :: Category -> String
showsPrec :: Int -> Category -> ShowS
$cshowsPrec :: Int -> 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 :: Word32 -> Notification
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 :: Maybe BusName
methodCallDestination=BusName -> Maybe BusName
forall a. a -> Maybe a
Just BusName
busname
	, methodCallBody :: [Variant]
methodCallBody=[Variant]
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. [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)
            [ String -> Variant
forall a. IsVariant a => a -> Variant
toVariant (String -> Variant) -> (Note -> String) -> Note -> Variant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Note -> String
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)
               , String -> Variant
forall a. IsVariant a => a -> Variant
toVariant (String -> Variant) -> (Note -> String) -> Note -> Variant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String)
-> (Note -> Maybe String) -> Note -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Icon -> String) -> Maybe Icon -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Icon -> String
iconString (Maybe Icon -> Maybe String)
-> (Note -> Maybe Icon) -> Note -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Note -> Maybe Icon
appImage
               , String -> Variant
forall a. IsVariant a => a -> Variant
toVariant (String -> Variant) -> (Note -> String) -> Note -> Variant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Note -> String
summary
               , String -> Variant
forall a. IsVariant a => a -> Variant
toVariant (String -> Variant) -> (Note -> String) -> Note -> Variant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String)
-> (Note -> Maybe String) -> Note -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Body -> String) -> Maybe Body -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Body -> String
flattenBody (Maybe Body -> Maybe String)
-> (Note -> Maybe Body) -> Note -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Note -> Maybe Body
body
               , [String] -> Variant
forall a. IsVariant a => a -> Variant
toVariant ([String] -> Variant) -> (Note -> [String]) -> Note -> Variant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Action, String)] -> [String]
actionsArray ([(Action, String)] -> [String])
-> (Note -> [(Action, String)]) -> Note -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Note -> [(Action, String)]
actions
               , Map String Variant -> Variant
forall a. IsVariant a => a -> Variant
toVariant (Map String Variant -> Variant)
-> (Note -> Map String Variant) -> Note -> Variant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Hint] -> Map String Variant
hintsDict ([Hint] -> Map String Variant)
-> (Note -> [Hint]) -> Note -> Map String 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
/= :: Capability -> Capability -> Bool
$c/= :: Capability -> Capability -> Bool
== :: Capability -> Capability -> Bool
$c== :: 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
readListPrec :: ReadPrec [Capability]
$creadListPrec :: ReadPrec [Capability]
readPrec :: ReadPrec Capability
$creadPrec :: ReadPrec Capability
readList :: ReadS [Capability]
$creadList :: ReadS [Capability]
readsPrec :: Int -> ReadS Capability
$creadsPrec :: Int -> ReadS Capability
Read, Int -> Capability -> ShowS
[Capability] -> ShowS
Capability -> String
(Int -> Capability -> ShowS)
-> (Capability -> String)
-> ([Capability] -> ShowS)
-> Show Capability
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Capability] -> ShowS
$cshowList :: [Capability] -> ShowS
show :: Capability -> String
$cshow :: Capability -> String
showsPrec :: Int -> Capability -> ShowS
$cshowsPrec :: Int -> Capability -> ShowS
Show)

-- |Determine the server's capabilities
getCapabilities :: Client -> IO [Capability]
getCapabilities :: Client -> IO [Capability]
getCapabilities Client
cl = (String -> Capability) -> [String] -> [Capability]
forall a b. (a -> b) -> [a] -> [b]
map String -> Capability
readCapability ([String] -> [Capability])
-> (MethodReturn -> [String]) -> MethodReturn -> [Capability]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe [String] -> [String]
forall a. HasCallStack => Maybe a -> a
fromJust
                    (Maybe [String] -> [String])
-> (MethodReturn -> Maybe [String]) -> MethodReturn -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Variant -> Maybe [String]
forall a. IsVariant a => Variant -> Maybe a
fromVariant (Variant -> Maybe [String])
-> (MethodReturn -> Variant) -> MethodReturn -> Maybe [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Variant] -> Variant
forall a. [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 :: String -> Capability
readCapability String
s = case String
s of
                    String
"actions" -> Capability
ActionsCap
                    String
"body" -> Capability
BodyCap
                    String
"body-hyperlinks" -> Capability
BodyHyperlinksCap
                    String
"body-images" -> Capability
BodyImagesCap
                    String
"body-markup" -> Capability
BodyMarkupCap
                    String
"icon-multi" -> Capability
IconMultiCap
                    String
"icon-static" -> Capability
IconStaticCap
                    String
"sound" -> Capability
SoundCap
                    String
s -> String -> Capability
UnknownCap String
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 = String -> Int32
forall a. HasCallStack => String -> a
error String
"notification timeout not positive"

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

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

hintsDict :: [Hint] -> M.Map String Variant
hintsDict :: [Hint] -> Map String Variant
hintsDict = [(String, Variant)] -> Map String Variant
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(String, Variant)] -> Map String Variant)
-> ([Hint] -> [(String, Variant)]) -> [Hint] -> Map String Variant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Hint -> (String, Variant)) -> [Hint] -> [(String, Variant)]
forall a b. (a -> b) -> [a] -> [b]
map Hint -> (String, Variant)
hint
    where
        hint :: Hint -> (String, Variant)
        hint :: Hint -> (String, Variant)
hint (Urgency UrgencyLevel
u) = (String
"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) = (String
"category", String -> Variant
forall a. IsVariant a => a -> Variant
toVariant (String -> Variant) -> String -> Variant
forall a b. (a -> b) -> a -> b
$ Category -> String
catName Category
c)
        hint (ImagePath Icon
p) = (String
"image-path", String -> Variant
forall a. IsVariant a => a -> Variant
toVariant (String -> Variant) -> String -> Variant
forall a b. (a -> b) -> a -> b
$ Icon -> String
iconString Icon
p)
        hint (ImageData Image
i) = (String
"image-data", String -> Variant
forall a. IsVariant a => a -> Variant
toVariant (String -> Variant) -> String -> Variant
forall a b. (a -> b) -> a -> b
$ Image -> String
bitmap Image
i)
        hint (SoundFile String
s) = (String
"sound-file", String -> Variant
forall a. IsVariant a => a -> Variant
toVariant String
s)
        hint (SuppressSound Bool
b) = (String
"suppress-sound", Bool -> Variant
forall a. IsVariant a => a -> Variant
toVariant Bool
b)
        hint (X Int32
x) = (String
"x", Int32 -> Variant
forall a. IsVariant a => a -> Variant
toVariant Int32
x)
        hint (Y Int32
y) = (String
"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 -> String
catName Category
c = ShowS
catName' (Category -> String
forall a. Show a => a -> String
show Category
c)
    where
        catName' :: ShowS
catName' (Char
c:String
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]
: ((String -> ShowS) -> (String, String) -> String
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> ShowS
forall a. [a] -> [a] -> [a]
(++) ((String, String) -> String)
-> (String -> (String, String)) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> (String, String) -> (String, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (Char
'.'Char -> ShowS
forall a. a -> [a] -> [a]
:) ((String, String) -> (String, String))
-> (String -> (String, String)) -> String -> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isLower ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
cs)