{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module SignalDBus.Interface (
withConn,
withConnNum,
withReceiveMessages,
callSC,
callSC_,
callControl,
callControl_,
getGroupProp,
setGroupProp,
callGroup_,
) where
import Data.String (fromString)
import DBus hiding (ReceivedMessage(..))
import DBus.Client
import UnliftIO.Chan
import UnliftIO.Exception (bracket, catch)
import UnliftIO (MonadIO, MonadUnliftIO, liftIO, toIO, throwIO)
import SignalDBus.Types
withConnS :: MonadUnliftIO m => String -> (SignalConn -> m a) -> m a
withConnS :: forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (SignalConn -> m a) -> m a
withConnS String
s = forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
(ObjectPath -> Client -> SignalConn
SignalConn (forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ String
"/org/asamk/Signal" forall a. [a] -> [a] -> [a]
++ String
s) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Client
connectSession)
forall a b. (a -> b) -> a -> b
$ \(SignalConn ObjectPath
_ Client
c) -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Client -> IO ()
disconnect Client
c
withConn :: MonadUnliftIO m => (SignalConn -> m a) -> m a
withConn :: forall (m :: * -> *) a.
MonadUnliftIO m =>
(SignalConn -> m a) -> m a
withConn = forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (SignalConn -> m a) -> m a
withConnS String
""
withConnNum :: MonadUnliftIO m => String -> (SignalConn -> m a) -> m a
withConnNum :: forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (SignalConn -> m a) -> m a
withConnNum String
n = forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (SignalConn -> m a) -> m a
withConnS forall a b. (a -> b) -> a -> b
$ forall a. IsString a => String -> a
fromString String
"/_" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [a]
tail String
n
withReceiveMessages :: MonadUnliftIO m
=> SignalConn
-> (m ReceivedMessage -> m a)
-> m a
withReceiveMessages :: forall (m :: * -> *) a.
MonadUnliftIO m =>
SignalConn -> (m ReceivedMessage -> m a) -> m a
withReceiveMessages sc :: SignalConn
sc@(SignalConn ObjectPath
_ Client
c) m ReceivedMessage -> m a
cb = do
Chan ReceivedMessage
ch <- forall (m :: * -> *) a. MonadIO m => m (Chan a)
newChan
IO a
action <- forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (IO a)
toIO forall a b. (a -> b) -> a -> b
$ m ReceivedMessage -> m a
cb forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => Chan a -> m a
readChan Chan ReceivedMessage
ch
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
(Client -> MatchRule -> (Signal -> IO ()) -> IO SignalHandler
addMatch Client
c MatchRule
match forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *}.
MonadUnliftIO m =>
(ReceivedMessage -> m ()) -> Signal -> m ()
processSig forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => Chan a -> a -> m ()
writeChan Chan ReceivedMessage
ch)
(Client -> SignalHandler -> IO ()
removeMatch Client
c)
forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const IO a
action
where match :: MatchRule
match = MatchRule
matchAny { matchInterface :: Maybe InterfaceName
matchInterface = forall a. a -> Maybe a
Just InterfaceName
"org.asamk.Signal" }
getGroup :: MonadUnliftIO m => Variant -> m (Maybe Group)
getGroup :: forall (m :: * -> *). MonadUnliftIO m => Variant -> m (Maybe Group)
getGroup Variant
g = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just (forall (m :: * -> *) a.
(MonadIO m, IsVariant a) =>
MemberName -> [Variant] -> SignalConn -> m a
callSC MemberName
"getGroup" [Variant
g] SignalConn
sc)
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \ClientError
e -> forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing) (ClientError
e :: ClientError)
processSig :: (ReceivedMessage -> m ()) -> Signal -> m ()
processSig ReceivedMessage -> m ()
fwd Signal
s = do
let memb :: MemberName
memb = Signal -> MemberName
signalMember Signal
s
body :: [Variant]
body = Signal -> [Variant]
signalBody Signal
s
Maybe ReceivedMessage
m <- case (MemberName
memb, [Variant]
body) of
(MemberName
"SyncMessageReceived", [Variant
ts, Variant
n, Variant
_, Variant
g, Variant
msg, Variant
as]) -> do
Maybe Group
may_g <- forall (m :: * -> *). MonadUnliftIO m => Variant -> m (Maybe Group)
getGroup Variant
g
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Timestamp
-> String -> Maybe Group -> String -> [String] -> ReceivedMessage
SyncMessage forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IsVariant a => Variant -> Maybe a
fromVariant Variant
ts forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. IsVariant a => Variant -> Maybe a
fromVariant Variant
n
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Group
may_g forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. IsVariant a => Variant -> Maybe a
fromVariant Variant
msg forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. IsVariant a => Variant -> Maybe a
fromVariant Variant
as
(MemberName
"ReceiptReceived", [Variant
ts, Variant
n]) ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Timestamp -> String -> ReceivedMessage
Receipt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IsVariant a => Variant -> Maybe a
fromVariant Variant
ts forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. IsVariant a => Variant -> Maybe a
fromVariant Variant
n
(MemberName
"MessageReceived", [Variant
ts, Variant
n, Variant
g, Variant
msg, Variant
as]) -> do
Maybe Group
may_g <- forall (m :: * -> *). MonadUnliftIO m => Variant -> m (Maybe Group)
getGroup Variant
g
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Timestamp
-> String -> Maybe Group -> String -> [String] -> ReceivedMessage
Message forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IsVariant a => Variant -> Maybe a
fromVariant Variant
ts forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. IsVariant a => Variant -> Maybe a
fromVariant Variant
n
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Group
may_g forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. IsVariant a => Variant -> Maybe a
fromVariant Variant
msg forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. IsVariant a => Variant -> Maybe a
fromVariant Variant
as
(MemberName, [Variant])
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. Maybe a
Nothing
case Maybe ReceivedMessage
m of
Just ReceivedMessage
x -> ReceivedMessage -> m ()
fwd ReceivedMessage
x
Maybe ReceivedMessage
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
callControl :: (MonadIO m, IsVariant a) => MemberName -> [Variant] -> SignalConn -> m a
callControl :: forall (m :: * -> *) a.
(MonadIO m, IsVariant a) =>
MemberName -> [Variant] -> SignalConn -> m a
callControl MemberName
meth [Variant]
args (SignalConn ObjectPath
_ Client
c) = forall (m :: * -> *) a.
(MonadIO m, IsVariant a) =>
MemberName -> [Variant] -> SignalConn -> m a
callSC MemberName
meth [Variant]
args
forall a b. (a -> b) -> a -> b
$ ObjectPath -> Client -> SignalConn
SignalConn ObjectPath
"/org/asamk/Signal" Client
c
callControl_ :: MonadIO m => MemberName -> [Variant] -> SignalConn -> m ()
callControl_ :: forall (m :: * -> *).
MonadIO m =>
MemberName -> [Variant] -> SignalConn -> m ()
callControl_ MemberName
meth [Variant]
args (SignalConn ObjectPath
_ Client
c) = forall (m :: * -> *).
MonadIO m =>
MemberName -> [Variant] -> SignalConn -> m ()
callSC_ MemberName
meth [Variant]
args
forall a b. (a -> b) -> a -> b
$ ObjectPath -> Client -> SignalConn
SignalConn ObjectPath
"/org/asamk/Signal" Client
c
callSC :: (MonadIO m, IsVariant a) => MemberName -> [Variant] -> SignalConn -> m a
callSC :: forall (m :: * -> *) a.
(MonadIO m, IsVariant a) =>
MemberName -> [Variant] -> SignalConn -> m a
callSC MemberName
meth [Variant]
args (SignalConn ObjectPath
p Client
c) = do
MethodReturn
r <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Client -> MethodCall -> IO MethodReturn
call_ Client
c
(ObjectPath -> InterfaceName -> MemberName -> MethodCall
methodCall ObjectPath
p InterfaceName
"org.asamk.Signal" MemberName
meth)
{ methodCallDestination :: Maybe BusName
methodCallDestination = forall a. a -> Maybe a
Just BusName
"org.asamk.Signal",
methodCallBody :: [Variant]
methodCallBody = [Variant]
args }
case forall a b. (a -> b) -> [a] -> [b]
map forall a. IsVariant a => Variant -> Maybe a
fromVariant forall a b. (a -> b) -> a -> b
$ MethodReturn -> [Variant]
methodReturnBody MethodReturn
r of
[Just a
x] -> forall (m :: * -> *) a. Monad m => a -> m a
return a
x
[Maybe a]
_ -> forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$ String -> ClientError
clientError forall a b. (a -> b) -> a -> b
$ String
"Unexpected reply: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show MethodReturn
r
callSC_ :: MonadIO m => MemberName -> [Variant] -> SignalConn -> m ()
callSC_ :: forall (m :: * -> *).
MonadIO m =>
MemberName -> [Variant] -> SignalConn -> m ()
callSC_ MemberName
meth [Variant]
args (SignalConn ObjectPath
p Client
c) = do
MethodReturn
_ <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Client -> MethodCall -> IO MethodReturn
call_ Client
c
(ObjectPath -> InterfaceName -> MemberName -> MethodCall
methodCall ObjectPath
p InterfaceName
"org.asamk.Signal" MemberName
meth)
{ methodCallDestination :: Maybe BusName
methodCallDestination = forall a. a -> Maybe a
Just BusName
"org.asamk.Signal",
methodCallBody :: [Variant]
methodCallBody = [Variant]
args }
forall (m :: * -> *) a. Monad m => a -> m a
return ()
getGroupProp :: (MonadIO m, IsValue a) => MemberName -> Group -> SignalConn -> m a
getGroupProp :: forall (m :: * -> *) a.
(MonadIO m, IsValue a) =>
MemberName -> Group -> SignalConn -> m a
getGroupProp MemberName
prop (Group ObjectPath
p) (SignalConn ObjectPath
_ Client
c) = do
Either MethodError a
r <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a.
IsValue a =>
Client -> MethodCall -> IO (Either MethodError a)
getPropertyValue Client
c
(ObjectPath -> InterfaceName -> MemberName -> MethodCall
methodCall ObjectPath
p InterfaceName
"org.asamk.Signal.Group" MemberName
prop)
{ methodCallDestination :: Maybe BusName
methodCallDestination = forall a. a -> Maybe a
Just BusName
"org.asamk.Signal" }
case Either MethodError a
r of
Right a
x -> forall (m :: * -> *) a. Monad m => a -> m a
return a
x
Left MethodError
e -> forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$ String -> ClientError
clientError forall a b. (a -> b) -> a -> b
$ String
"Error getting property: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show MethodError
e
setGroupProp :: (MonadIO m, IsValue a) => MemberName -> a -> Group -> SignalConn -> m ()
setGroupProp :: forall (m :: * -> *) a.
(MonadIO m, IsValue a) =>
MemberName -> a -> Group -> SignalConn -> m ()
setGroupProp MemberName
prop a
x (Group ObjectPath
p) (SignalConn ObjectPath
_ Client
c) = do
Maybe MethodError
r <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a.
IsValue a =>
Client -> MethodCall -> a -> IO (Maybe MethodError)
setPropertyValue Client
c
(ObjectPath -> InterfaceName -> MemberName -> MethodCall
methodCall ObjectPath
p InterfaceName
"org.asamk.Signal.Group" MemberName
prop)
{ methodCallDestination :: Maybe BusName
methodCallDestination = forall a. a -> Maybe a
Just BusName
"org.asamk.Signal" }
forall a b. (a -> b) -> a -> b
$ forall a. IsVariant a => a -> Variant
toVariant a
x
case Maybe MethodError
r of
Maybe MethodError
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just MethodError
e -> forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$ String -> ClientError
clientError forall a b. (a -> b) -> a -> b
$ String
"Error setting property: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show MethodError
e
callGroup_ :: MonadIO m => MemberName -> [Variant] -> Group -> SignalConn -> m ()
callGroup_ :: forall (m :: * -> *).
MonadIO m =>
MemberName -> [Variant] -> Group -> SignalConn -> m ()
callGroup_ MemberName
meth [Variant]
args (Group ObjectPath
p) (SignalConn ObjectPath
_ Client
c) = do
MethodReturn
_ <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Client -> MethodCall -> IO MethodReturn
call_ Client
c
(ObjectPath -> InterfaceName -> MemberName -> MethodCall
methodCall ObjectPath
p InterfaceName
"org.asamk.Signal.Group" MemberName
meth)
{ methodCallDestination :: Maybe BusName
methodCallDestination = forall a. a -> Maybe a
Just BusName
"org.asamk.Signal",
methodCallBody :: [Variant]
methodCallBody = [Variant]
args }
forall (m :: * -> *) a. Monad m => a -> m a
return ()