d-bus-0.1.0: tests/Runtest.hs

{-# LANGUAGE OverloadedStrings #-}
module Main where

import qualified Control.Exception as Ex
import           DBus
import           DBus.Types
import           DBus.Object
import           Data.Text (Text)
import qualified Data.Text as Text
import           Data.Word


testFunction1 txt num b =
    if b then Right $ (fromIntegral $ Text.length txt) * num
         else Left txt

testAction1 :: Text -> Word32 -> Bool -> IO Word32
testAction1 txt num doError = do
    case testFunction1 txt num doError of
        Right num -> return num
        Left e -> Ex.throwIO $ errorFailed txt

testMethod = Method (repMethod testAction1)
                    "testMethod1"
                    ("text" :-> "number" :-> "error?" :-> Result)
                    ("another number" :> ResultDone)

testInterface = Interface "dbus.test" [testMethod] [] [] []

testObject = Object { objectObjectPath = objectPath "dbus/test"
                    , objectInterfaces = [testInterface]
                    , objectSubObjects = []
                    }

root = Object { objectObjectPath = objectPath "/"
              , objectInterfaces = []
              , objectSubObjects = [testObject]
              }

server = do
    con <- connectBus Session
           (\con header bdy -> do
                 print header
                 objectRoot (addIntrospectable root)
                            con header bdy
           ) ignore
    requestName "dbus.test" def con
    return con




client = connectBus Session ignore ignore


main = do
    srvCon <- server
    cl <- client
    res <- callMethod
        "dbus.test" (objectPath "/dbus/test") "dbus.test" "testMethod1"
        ("test" :: Text, 13 :: Word32, True)
        [] cl
    print (res :: (Either MethodError Word32))
    checkAlive srvCon
    return ()