dbus-client-0.4: Examples/exporting.hs

-- Copyright (C) 2009-2010 John Millikin <jmillikin@gmail.com>
-- 
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- any later version.
-- 
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.
-- 
-- You should have received a copy of the GNU General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.

{-# LANGUAGE OverloadedStrings #-}
module Main (main) where
import Control.Monad.IO.Class (liftIO)
import DBus.Client
import DBus.Constants
import qualified Data.Map as Map

a :: String -> Object
a x = object
	[ ("test.iface_1", interface
	  [ ("Foo", onFoo "a" x)
	  , ("Bar", onBar "a" x)
	  ])
	]

b :: String -> Object
b x = object
	[ ("test.iface_1", interface
	  [ ("Foo", onFoo "b" x)
	  , ("Bar", onBar "b" x)
	  ])
	]

onFoo :: String -> String -> Member
onFoo x y = method "" "s" $ \call -> do
	liftIO $ putStrLn $ "Foo " ++ x ++ " " ++ y
	replyReturn call [toVariant $ "Foo " ++ x ++ " " ++ y]

onBar :: String -> String -> Member
onBar x y = method "" "s" $ \call -> do
	liftIO $ putStrLn $ "Bar " ++ x ++ " " ++ y
	replyError call errorFailed [toVariant $ "Bar " ++ x ++ " " ++ y]

main :: IO ()
main = do
	-- Connect to the bus
	client <- newClient =<< getSessionBus
	runDBus client $ do
		-- Request a unique name on the bus. If the name is already
		-- in use, continue without it.
		requestName "org.test.exporting" []
			(\e -> liftIO $ putStrLn "Error requesting unique name")
			(\response -> return ())
		
		-- Export two example objects
		export "/a" (a "hello")
		export "/b" (b "world")
		
		-- Wait forever for method calls
		mainLoop