summaryrefslogtreecommitdiffhomepage
path: root/src/lib/Xmobar/System/DBus.hs
diff options
context:
space:
mode:
authorjao <jao@gnu.org>2018-11-25 15:10:29 +0000
committerjao <jao@gnu.org>2018-11-25 15:10:29 +0000
commit77df1ac30fa7af5948f7ff64f5fee9aed64552b3 (patch)
tree647a4eb67ff1c293a5c530538ee88fc0093b577a /src/lib/Xmobar/System/DBus.hs
parente0d6da82de8d0d1cef98896164c6016b84e47068 (diff)
downloadxmobar-77df1ac30fa7af5948f7ff64f5fee9aed64552b3.tar.gz
xmobar-77df1ac30fa7af5948f7ff64f5fee9aed64552b3.tar.bz2
Back to app/src, since it seems they're the default convention for stack
Diffstat (limited to 'src/lib/Xmobar/System/DBus.hs')
-rw-r--r--src/lib/Xmobar/System/DBus.hs73
1 files changed, 0 insertions, 73 deletions
diff --git a/src/lib/Xmobar/System/DBus.hs b/src/lib/Xmobar/System/DBus.hs
deleted file mode 100644
index 103a5a9..0000000
--- a/src/lib/Xmobar/System/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 Xmobar.System.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 Xmobar.System.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)