diff options
| author | Pavan Rikhi <pavan.rikhi@gmail.com> | 2018-03-17 22:48:24 -0400 | 
|---|---|---|
| committer | jao <jao@gnu.org> | 2018-11-21 21:41:35 +0000 | 
| commit | 4d1402a1a7d87767267d48a77998e4fb13395b31 (patch) | |
| tree | 17fd6160dc1fa9c8a0676a94bcf8d19b551c655c /src/IPC | |
| parent | 9e2a5c7daddf683d4be7c318aefed3da3ea7a89a (diff) | |
| download | xmobar-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')
| -rw-r--r-- | src/IPC/DBus.hs | 73 | 
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) | 
