{-# LANGUAGE OverloadedStrings #-}
module XMonad.DBus (connect,subscribe,subscribeToPath,bodyToString,requestAccess,send,sendToPath) where

import Data.Maybe (mapMaybe)
import qualified DBus as D
import qualified DBus.Client as DC

busName :: BusName
busName = BusName
"org.XMonad.DBus"
interface :: InterfaceName
interface = InterfaceName
"org.XMonad.DBus"
pathPrefix :: String
pathPrefix = String
"/org/XMonad"
pathPrefixObjectPath :: ObjectPath
pathPrefixObjectPath = String -> ObjectPath
D.objectPath_ String
pathPrefix
member :: MemberName
member = MemberName
"Update"

connect :: IO DC.Client
connect :: IO Client
connect = IO Client
DC.connectSession

requestAccess :: Client -> IO RequestNameReply
requestAccess Client
c = Client -> BusName -> [RequestNameFlag] -> IO RequestNameReply
DC.requestName Client
c BusName
busName [RequestNameFlag
DC.nameAllowReplacement, RequestNameFlag
DC.nameReplaceExisting, RequestNameFlag
DC.nameDoNotQueue]


matchAnyPath :: DC.MatchRule
matchAnyPath :: MatchRule
matchAnyPath = MatchRule
DC.matchAny {
            matchInterface :: Maybe InterfaceName
DC.matchInterface = forall a. a -> Maybe a
Just InterfaceName
interface,
            matchPathNamespace :: Maybe ObjectPath
DC.matchPathNamespace = forall a. a -> Maybe a
Just ObjectPath
pathPrefixObjectPath,
            matchMember :: Maybe MemberName
DC.matchMember = forall a. a -> Maybe a
Just MemberName
member
        }

matchPath :: String -> DC.MatchRule
matchPath :: String -> MatchRule
matchPath String
name = MatchRule
DC.matchAny {
            matchInterface :: Maybe InterfaceName
DC.matchInterface = forall a. a -> Maybe a
Just InterfaceName
interface,
            matchPath :: Maybe ObjectPath
DC.matchPath = (forall (m :: * -> *). MonadThrow m => String -> m ObjectPath
D.parseObjectPath forall a b. (a -> b) -> a -> b
$ String
pathPrefixforall a. [a] -> [a] -> [a]
++String
"/"forall a. [a] -> [a] -> [a]
++String
name),
            matchMember :: Maybe MemberName
DC.matchMember = forall a. a -> Maybe a
Just MemberName
member
        }

subscribe :: Client -> (Signal -> IO ()) -> IO SignalHandler
subscribe Client
c Signal -> IO ()
handler = Client -> MatchRule -> (Signal -> IO ()) -> IO SignalHandler
DC.addMatch Client
c MatchRule
matchAnyPath Signal -> IO ()
handler
subscribeToPath :: Client -> String -> (Signal -> IO ()) -> IO SignalHandler
subscribeToPath Client
c String
path Signal -> IO ()
handler = Client -> MatchRule -> (Signal -> IO ()) -> IO SignalHandler
DC.addMatch Client
c (String -> MatchRule
matchPath String
path) Signal -> IO ()
handler

bodyToString :: D.Signal -> [String]
bodyToString :: Signal -> [String]
bodyToString Signal
s = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall a. IsVariant a => Variant -> Maybe a
D.fromVariant (Signal -> [Variant]
D.signalBody Signal
s)


send :: DC.Client -> String -> IO ()
send :: Client -> String -> IO ()
send Client
c String
s = Client -> Signal -> IO ()
DC.emit Client
c forall a b. (a -> b) -> a -> b
$ (ObjectPath -> InterfaceName -> MemberName -> Signal
D.signal ObjectPath
pathPrefixObjectPath InterfaceName
interface MemberName
member) {
    signalBody :: [Variant]
D.signalBody = [forall a. IsVariant a => a -> Variant
D.toVariant String
s]
    }

sendToPath :: DC.Client -> String -> String -> IO ()
sendToPath :: Client -> String -> String -> IO ()
sendToPath Client
c String
p String
s = Client -> Signal -> IO ()
DC.emit Client
c forall a b. (a -> b) -> a -> b
$ (ObjectPath -> InterfaceName -> MemberName -> Signal
D.signal (String -> ObjectPath
D.objectPath_ forall a b. (a -> b) -> a -> b
$ String
pathPrefixforall a. [a] -> [a] -> [a]
++String
"/"forall a. [a] -> [a] -> [a]
++String
p) InterfaceName
interface MemberName
member) {
    signalBody :: [Variant]
D.signalBody = [forall a. IsVariant a => a -> Variant
D.toVariant String
s]
    }