-
Notifications
You must be signed in to change notification settings - Fork 0
/
NotifyServer.hs
60 lines (51 loc) · 2.06 KB
/
NotifyServer.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
{-# LANGUAGE OverloadedStrings #-}
module NotifyServer (
startServer
) where
import DBus
import DBus.Client
import DBus.Internal.Types
import Data.List (sort)
import Data.Maybe
import Debug.Trace
import Data.Map (Map)
import System.Exit (exitWith, ExitCode(..))
import Control.Concurrent (threadDelay)
import Data.Int
getServerInformation :: IO (String, String, String, String)
getServerInformation = return ("mnotify", "mnotify","0.1","0.1")
getCapabilities :: IO [String]
getCapabilities = return (traceShowId ["body"])
notify :: (String -> String -> IO ()) -> MethodCall -> IO Reply
notify drawRoutine mCall = (drawRoutine vSummary vBody) >> return reply
where reply = replyReturn [toVariant (0::Int32)]
bodyVariants = methodCallBody mCall
[name, rid, icon, summary, body, actions, hints, expire] = bodyVariants
vBody = unVar "No body found" body
vSummary = unVar "No summary" summary
unVar :: (IsVariant a) => a -> Variant -> a
unVar defaultValue variant = fromMaybe defaultValue (fromVariant variant)
notifyInSignature = [
TypeString,
TypeInt32,
TypeString,
TypeString,
TypeString,
TypeArray TypeString,
TypeDictionary TypeString TypeString,
TypeInt32
]
exportAndWait :: Client -> RequestNameReply -> (String -> String -> IO()) -> IO ()
exportAndWait client NameExists _ = do
putStrLn "Nmonad is already running. Exiting..."
exportAndWait client _ showMsgCallback = do
export client "/org/freedesktop/Notifications" [
autoMethod "org.freedesktop.Notifications" "GetServerInformation" getServerInformation,
autoMethod "org.freedesktop.Notifications" "GetCapabilities" getCapabilities,
method "org.freedesktop.Notifications" "Notify" (signature_ notifyInSignature) (signature_ [TypeInt32]) (notify showMsgCallback)
]
startServer :: (String -> String -> IO()) -> IO ()
startServer showMsgCallback = do
client <- connectSession
requestReply <- requestName client (busName_ "org.freedesktop.Notifications") [nameDoNotQueue]
exportAndWait client requestReply showMsgCallback