summaryrefslogtreecommitdiffhomepage
path: root/src/IPC/DBus.hs
diff options
context:
space:
mode:
authorPavan Rikhi <pavan.rikhi@gmail.com>2018-03-17 22:48:24 -0400
committerjao <jao@gnu.org>2018-11-21 21:41:35 +0000
commit4d1402a1a7d87767267d48a77998e4fb13395b31 (patch)
tree17fd6160dc1fa9c8a0676a94bcf8d19b551c655c /src/IPC/DBus.hs
parent9e2a5c7daddf683d4be7c318aefed3da3ea7a89a (diff)
downloadxmobar-4d1402a1a7d87767267d48a77998e4fb13395b31.tar.gz
xmobar-4d1402a1a7d87767267d48a77998e4fb13395b31.tar.bz2
Split Modules into Library & Executable Structure
Move the Main module to a new `app` directory. All other modules have been nested under the `Xmobar` name. Lots of module headers & imports were updated.
Diffstat (limited to 'src/IPC/DBus.hs')
-rw-r--r--src/IPC/DBus.hs73
1 files changed, 0 insertions, 73 deletions
diff --git a/src/IPC/DBus.hs b/src/IPC/DBus.hs
deleted file mode 100644
index f6fdcb7..0000000
--- a/src/IPC/DBus.hs
+++ /dev/null
@@ -1,73 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module : DBus
--- Copyright : (c) Jochen Keil
--- License : BSD-style (see LICENSE)
---
--- Maintainer : Jochen Keil <jochen dot keil at gmail dot com>
--- Stability : unstable
--- Portability : unportable
---
--- DBus IPC module for Xmobar
---
------------------------------------------------------------------------------
-
-module IPC.DBus (runIPC) where
-
-import DBus
-import DBus.Client hiding (interfaceName)
-import qualified DBus.Client as DC
-import Data.Maybe (isNothing)
-import Control.Concurrent.STM
-import Control.Exception (handle)
-import System.IO (stderr, hPutStrLn)
-import Control.Monad.IO.Class (liftIO)
-
-import Signal
-
-busName :: BusName
-busName = busName_ "org.Xmobar.Control"
-
-objectPath :: ObjectPath
-objectPath = objectPath_ "/org/Xmobar/Control"
-
-interfaceName :: InterfaceName
-interfaceName = interfaceName_ "org.Xmobar.Control"
-
-runIPC :: TMVar SignalType -> IO ()
-runIPC mvst = handle printException exportConnection
- where
- printException :: ClientError -> IO ()
- printException = hPutStrLn stderr . clientErrorMessage
- exportConnection = do
- client <- connectSession
- requestName client busName [ nameDoNotQueue ]
- export client objectPath defaultInterface
- { DC.interfaceName = interfaceName
- , DC.interfaceMethods = [ sendSignalMethod mvst ]
- }
-
-sendSignalMethod :: TMVar SignalType -> Method
-sendSignalMethod mvst = makeMethod sendSignalName
- (signature_ [variantType $ toVariant (undefined :: SignalType)])
- (signature_ [])
- sendSignalMethodCall
- where
- sendSignalName :: MemberName
- sendSignalName = memberName_ "SendSignal"
-
- sendSignalMethodCall :: MethodCall -> DBusR Reply
- sendSignalMethodCall mc = liftIO $
- if methodCallMember mc == sendSignalName
- then do
- let signals :: [Maybe SignalType]
- signals = map fromVariant (methodCallBody mc)
- mapM_ sendSignal signals
- if any isNothing signals
- then return ( ReplyError errorInvalidParameters [] )
- else return ( ReplyReturn [] )
- else
- return ( ReplyError errorUnknownMethod [] )
-
- sendSignal :: Maybe SignalType -> IO ()
- sendSignal = maybe (return ()) (atomically . putTMVar mvst)