REF overload internal dbus functions
This commit is contained in:
parent
cfde8865c1
commit
dda7a96d4c
|
@ -11,6 +11,8 @@ module Main (main) where
|
||||||
-- * Theme integration with xmonad (shared module imported below)
|
-- * Theme integration with xmonad (shared module imported below)
|
||||||
-- * A custom Locks plugin from my own forked repo
|
-- * A custom Locks plugin from my own forked repo
|
||||||
|
|
||||||
|
import Data.Internal.DBus
|
||||||
|
import Data.Internal.Dependency
|
||||||
import Data.List
|
import Data.List
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
|
|
||||||
|
@ -38,7 +40,6 @@ import XMonad.Internal.DBus.Brightness.ClevoKeyboard
|
||||||
import XMonad.Internal.DBus.Brightness.IntelBacklight
|
import XMonad.Internal.DBus.Brightness.IntelBacklight
|
||||||
import XMonad.Internal.DBus.Control
|
import XMonad.Internal.DBus.Control
|
||||||
import XMonad.Internal.DBus.Screensaver (ssSignalDep)
|
import XMonad.Internal.DBus.Screensaver (ssSignalDep)
|
||||||
import XMonad.Internal.Dependency
|
|
||||||
import XMonad.Internal.Process
|
import XMonad.Internal.Process
|
||||||
( proc'
|
( proc'
|
||||||
, readCreateProcessWithExitCode'
|
, readCreateProcessWithExitCode'
|
||||||
|
|
|
@ -10,6 +10,8 @@ import Control.Concurrent
|
||||||
import Control.Concurrent.Lifted (fork)
|
import Control.Concurrent.Lifted (fork)
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
|
|
||||||
|
import Data.Internal.DBus
|
||||||
|
import Data.Internal.Dependency
|
||||||
import Data.List
|
import Data.List
|
||||||
( intercalate
|
( intercalate
|
||||||
, isPrefixOf
|
, isPrefixOf
|
||||||
|
@ -53,7 +55,6 @@ import XMonad.Internal.DBus.Brightness.IntelBacklight
|
||||||
import XMonad.Internal.DBus.Control
|
import XMonad.Internal.DBus.Control
|
||||||
import XMonad.Internal.DBus.Removable
|
import XMonad.Internal.DBus.Removable
|
||||||
import XMonad.Internal.DBus.Screensaver
|
import XMonad.Internal.DBus.Screensaver
|
||||||
import XMonad.Internal.Dependency
|
|
||||||
import XMonad.Internal.Process
|
import XMonad.Internal.Process
|
||||||
import XMonad.Internal.Shell
|
import XMonad.Internal.Shell
|
||||||
import qualified XMonad.Internal.Theme as T
|
import qualified XMonad.Internal.Theme as T
|
||||||
|
|
|
@ -1,12 +1,11 @@
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Common internal DBus functions
|
-- | Common internal DBus functions
|
||||||
|
|
||||||
module DBus.Internal
|
module Data.Internal.DBus
|
||||||
( addMatchCallback
|
( SafeClient(..)
|
||||||
-- , getDBusClient
|
, SysClient(..)
|
||||||
-- , fromDBusClient
|
, SesClient(..)
|
||||||
-- , withDBusClient
|
, addMatchCallback
|
||||||
-- , withDBusClient_
|
|
||||||
, matchProperty
|
, matchProperty
|
||||||
, matchPropertyFull
|
, matchPropertyFull
|
||||||
, matchPropertyChanged
|
, matchPropertyChanged
|
||||||
|
@ -28,26 +27,70 @@ module DBus.Internal
|
||||||
, bodyToMaybe
|
, bodyToMaybe
|
||||||
) where
|
) where
|
||||||
|
|
||||||
-- import Control.Exception
|
import Control.Exception
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
|
|
||||||
import Data.Bifunctor
|
import Data.Bifunctor
|
||||||
import qualified Data.Map.Strict as M
|
import qualified Data.Map.Strict as M
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
|
|
||||||
import DBus
|
import DBus
|
||||||
import DBus.Client
|
import DBus.Client
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- | Type-safe client
|
||||||
|
|
||||||
|
class SafeClient c where
|
||||||
|
toClient :: c -> Client
|
||||||
|
|
||||||
|
getDBusClient :: IO (Maybe c)
|
||||||
|
|
||||||
|
withDBusClient :: (c -> IO a) -> IO (Maybe a)
|
||||||
|
withDBusClient f = do
|
||||||
|
client <- getDBusClient
|
||||||
|
forM client $ \c -> do
|
||||||
|
r <- f c
|
||||||
|
disconnect (toClient c)
|
||||||
|
return r
|
||||||
|
|
||||||
|
withDBusClient_ :: (c -> IO ()) -> IO ()
|
||||||
|
withDBusClient_ = void . withDBusClient
|
||||||
|
|
||||||
|
fromDBusClient :: (c -> a) -> IO (Maybe a)
|
||||||
|
fromDBusClient f = withDBusClient (return . f)
|
||||||
|
|
||||||
|
newtype SysClient = SysClient Client
|
||||||
|
|
||||||
|
instance SafeClient SysClient where
|
||||||
|
toClient (SysClient cl) = cl
|
||||||
|
|
||||||
|
getDBusClient = fmap SysClient <$> getDBusClient' True
|
||||||
|
|
||||||
|
newtype SesClient = SesClient Client
|
||||||
|
|
||||||
|
instance SafeClient SesClient where
|
||||||
|
toClient (SesClient cl) = cl
|
||||||
|
|
||||||
|
getDBusClient = fmap SesClient <$> getDBusClient' False
|
||||||
|
|
||||||
|
getDBusClient' :: Bool -> IO (Maybe Client)
|
||||||
|
getDBusClient' sys = do
|
||||||
|
res <- try $ if sys then connectSystem else connectSession
|
||||||
|
case res of
|
||||||
|
Left e -> putStrLn (clientErrorMessage e) >> return Nothing
|
||||||
|
Right c -> return $ Just c
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Methods
|
-- | Methods
|
||||||
|
|
||||||
type MethodBody = Either String [Variant]
|
type MethodBody = Either String [Variant]
|
||||||
|
|
||||||
callMethod' :: Client -> MethodCall -> IO MethodBody
|
callMethod' :: SafeClient c => c -> MethodCall -> IO MethodBody
|
||||||
callMethod' cl = fmap (bimap methodErrorMessage methodReturnBody) . call cl
|
callMethod' cl = fmap (bimap methodErrorMessage methodReturnBody)
|
||||||
|
. call (toClient cl)
|
||||||
|
|
||||||
callMethod :: Client -> BusName -> ObjectPath -> InterfaceName -> MemberName
|
callMethod :: SafeClient c => c -> BusName -> ObjectPath -> InterfaceName
|
||||||
-> IO MethodBody
|
-> MemberName -> IO MethodBody
|
||||||
callMethod client bus path iface = callMethod' client . methodCallBus bus path iface
|
callMethod client bus path iface = callMethod' client . methodCallBus bus path iface
|
||||||
|
|
||||||
methodCallBus :: BusName -> ObjectPath -> InterfaceName -> MemberName -> MethodCall
|
methodCallBus :: BusName -> ObjectPath -> InterfaceName -> MemberName -> MethodCall
|
||||||
|
@ -60,8 +103,8 @@ methodCallBus b p i m = (methodCall p i m)
|
||||||
dbusInterface :: InterfaceName
|
dbusInterface :: InterfaceName
|
||||||
dbusInterface = interfaceName_ "org.freedesktop.DBus"
|
dbusInterface = interfaceName_ "org.freedesktop.DBus"
|
||||||
|
|
||||||
callGetNameOwner :: Client -> BusName -> IO (Maybe BusName)
|
callGetNameOwner :: SafeClient c => c -> BusName -> IO (Maybe BusName)
|
||||||
callGetNameOwner client name = bodyToMaybe <$> callMethod' client mc
|
callGetNameOwner cl name = bodyToMaybe <$> callMethod' cl mc
|
||||||
where
|
where
|
||||||
mc = (methodCallBus dbusName dbusPath dbusInterface mem)
|
mc = (methodCallBus dbusName dbusPath dbusInterface mem)
|
||||||
{ methodCallBody = [toVariant name] }
|
{ methodCallBody = [toVariant name] }
|
||||||
|
@ -81,8 +124,9 @@ bodyToMaybe = either (const Nothing) fromSingletonVariant
|
||||||
|
|
||||||
type SignalCallback = [Variant] -> IO ()
|
type SignalCallback = [Variant] -> IO ()
|
||||||
|
|
||||||
addMatchCallback :: MatchRule -> SignalCallback -> Client -> IO SignalHandler
|
addMatchCallback :: SafeClient c => MatchRule -> SignalCallback -> c
|
||||||
addMatchCallback rule cb client = addMatch client rule $ cb . signalBody
|
-> IO SignalHandler
|
||||||
|
addMatchCallback rule cb cl = addMatch (toClient cl) rule $ cb . signalBody
|
||||||
|
|
||||||
matchSignal :: Maybe BusName -> Maybe ObjectPath -> Maybe InterfaceName
|
matchSignal :: Maybe BusName -> Maybe ObjectPath -> Maybe InterfaceName
|
||||||
-> Maybe MemberName -> MatchRule
|
-> Maybe MemberName -> MatchRule
|
||||||
|
@ -93,8 +137,8 @@ matchSignal b p i m = matchAny
|
||||||
, matchMember = m
|
, matchMember = m
|
||||||
}
|
}
|
||||||
|
|
||||||
matchSignalFull :: Client -> BusName -> Maybe ObjectPath -> Maybe InterfaceName
|
matchSignalFull :: SafeClient c => c -> BusName -> Maybe ObjectPath
|
||||||
-> Maybe MemberName -> IO (Maybe MatchRule)
|
-> Maybe InterfaceName -> Maybe MemberName -> IO (Maybe MatchRule)
|
||||||
matchSignalFull client b p i m =
|
matchSignalFull client b p i m =
|
||||||
fmap (\o -> matchSignal (Just o) p i m) <$> callGetNameOwner client b
|
fmap (\o -> matchSignal (Just o) p i m) <$> callGetNameOwner client b
|
||||||
|
|
||||||
|
@ -107,18 +151,19 @@ propertyInterface = interfaceName_ "org.freedesktop.DBus.Properties"
|
||||||
propertySignal :: MemberName
|
propertySignal :: MemberName
|
||||||
propertySignal = memberName_ "PropertiesChanged"
|
propertySignal = memberName_ "PropertiesChanged"
|
||||||
|
|
||||||
callPropertyGet :: BusName -> ObjectPath -> InterfaceName -> MemberName -> Client
|
callPropertyGet :: SafeClient c => BusName -> ObjectPath -> InterfaceName
|
||||||
-> IO [Variant]
|
-> MemberName -> c -> IO [Variant]
|
||||||
callPropertyGet bus path iface property client = fmap (either (const []) (:[]))
|
callPropertyGet bus path iface property cl = fmap (either (const []) (:[]))
|
||||||
$ getProperty client $ methodCallBus bus path iface property
|
$ getProperty (toClient cl) $ methodCallBus bus path iface property
|
||||||
|
|
||||||
matchProperty :: Maybe BusName -> Maybe ObjectPath -> MatchRule
|
matchProperty :: Maybe BusName -> Maybe ObjectPath -> MatchRule
|
||||||
matchProperty b p =
|
matchProperty b p =
|
||||||
matchSignal b p (Just propertyInterface) (Just propertySignal)
|
matchSignal b p (Just propertyInterface) (Just propertySignal)
|
||||||
|
|
||||||
matchPropertyFull :: Client -> BusName -> Maybe ObjectPath -> IO (Maybe MatchRule)
|
matchPropertyFull :: SafeClient c => c -> BusName -> Maybe ObjectPath
|
||||||
matchPropertyFull client b p =
|
-> IO (Maybe MatchRule)
|
||||||
matchSignalFull client b p (Just propertyInterface) (Just propertySignal)
|
matchPropertyFull cl b p =
|
||||||
|
matchSignalFull cl b p (Just propertyInterface) (Just propertySignal)
|
||||||
|
|
||||||
data SignalMatch a = Match a | NoMatch | Failure deriving (Eq, Show)
|
data SignalMatch a = Match a | NoMatch | Failure deriving (Eq, Show)
|
||||||
|
|
||||||
|
@ -141,30 +186,6 @@ matchPropertyChanged iface property [i, body, _] =
|
||||||
toMap v = fromVariant v :: Maybe (M.Map String Variant)
|
toMap v = fromVariant v :: Maybe (M.Map String Variant)
|
||||||
matchPropertyChanged _ _ _ = Failure
|
matchPropertyChanged _ _ _ = Failure
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
|
||||||
-- | Client requests
|
|
||||||
|
|
||||||
-- getDBusClient :: Bool -> IO (Maybe Client)
|
|
||||||
-- getDBusClient sys = do
|
|
||||||
-- res <- try $ if sys then connectSystem else connectSession
|
|
||||||
-- case res of
|
|
||||||
-- Left e -> putStrLn (clientErrorMessage e) >> return Nothing
|
|
||||||
-- Right c -> return $ Just c
|
|
||||||
|
|
||||||
-- withDBusClient :: Bool -> (c -> IO a) -> IO (Maybe a)
|
|
||||||
-- withDBusClient sys f = do
|
|
||||||
-- client <- getDBusClient sys
|
|
||||||
-- forM client $ \c -> do
|
|
||||||
-- r <- f c
|
|
||||||
-- disconnect c
|
|
||||||
-- return r
|
|
||||||
|
|
||||||
-- withDBusClient_ :: Bool -> (Client -> IO ()) -> IO ()
|
|
||||||
-- withDBusClient_ sys = void . withDBusClient sys
|
|
||||||
|
|
||||||
-- fromDBusClient :: Bool -> (Client -> a) -> IO (Maybe a)
|
|
||||||
-- fromDBusClient sys f = withDBusClient sys (return . f)
|
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Object Manager
|
-- | Object Manager
|
||||||
|
|
||||||
|
@ -182,23 +203,24 @@ omInterfacesAdded = memberName_ "InterfacesAdded"
|
||||||
omInterfacesRemoved :: MemberName
|
omInterfacesRemoved :: MemberName
|
||||||
omInterfacesRemoved = memberName_ "InterfacesRemoved"
|
omInterfacesRemoved = memberName_ "InterfacesRemoved"
|
||||||
|
|
||||||
callGetManagedObjects :: Client -> BusName -> ObjectPath -> IO ObjectTree
|
callGetManagedObjects :: SafeClient c => c -> BusName -> ObjectPath
|
||||||
callGetManagedObjects client bus path =
|
-> IO ObjectTree
|
||||||
|
callGetManagedObjects cl bus path =
|
||||||
either (const M.empty) (fromMaybe M.empty . fromSingletonVariant)
|
either (const M.empty) (fromMaybe M.empty . fromSingletonVariant)
|
||||||
<$> callMethod client bus path omInterface getManagedObjects
|
<$> callMethod cl bus path omInterface getManagedObjects
|
||||||
|
|
||||||
addInterfaceChangedListener :: BusName -> MemberName -> ObjectPath
|
addInterfaceChangedListener :: SafeClient c => BusName -> MemberName
|
||||||
-> SignalCallback -> Client -> IO (Maybe SignalHandler)
|
-> ObjectPath -> SignalCallback -> c -> IO (Maybe SignalHandler)
|
||||||
addInterfaceChangedListener bus prop path sc client = do
|
addInterfaceChangedListener bus prop path sc cl = do
|
||||||
rule <- matchSignalFull client bus (Just path) (Just omInterface) (Just prop)
|
rule <- matchSignalFull cl bus (Just path) (Just omInterface) (Just prop)
|
||||||
forM rule $ \r -> addMatchCallback r sc client
|
forM rule $ \r -> addMatchCallback r sc cl
|
||||||
|
|
||||||
addInterfaceAddedListener :: BusName -> ObjectPath -> SignalCallback -> Client
|
addInterfaceAddedListener :: SafeClient c => BusName -> ObjectPath
|
||||||
-> IO (Maybe SignalHandler)
|
-> SignalCallback -> c -> IO (Maybe SignalHandler)
|
||||||
addInterfaceAddedListener bus =
|
addInterfaceAddedListener bus =
|
||||||
addInterfaceChangedListener bus omInterfacesAdded
|
addInterfaceChangedListener bus omInterfacesAdded
|
||||||
|
|
||||||
addInterfaceRemovedListener :: BusName -> ObjectPath -> SignalCallback -> Client
|
addInterfaceRemovedListener :: SafeClient c => BusName -> ObjectPath
|
||||||
-> IO (Maybe SignalHandler)
|
-> SignalCallback -> c -> IO (Maybe SignalHandler)
|
||||||
addInterfaceRemovedListener bus =
|
addInterfaceRemovedListener bus =
|
||||||
addInterfaceChangedListener bus omInterfacesRemoved
|
addInterfaceChangedListener bus omInterfacesRemoved
|
|
@ -8,7 +8,7 @@
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Functions for handling dependencies
|
-- | Functions for handling dependencies
|
||||||
|
|
||||||
module XMonad.Internal.Dependency
|
module Data.Internal.Dependency
|
||||||
-- feature types
|
-- feature types
|
||||||
( Feature
|
( Feature
|
||||||
, Always(..)
|
, Always(..)
|
||||||
|
@ -41,8 +41,6 @@ module XMonad.Internal.Dependency
|
||||||
, DBusTree
|
, DBusTree
|
||||||
, DBusTree_
|
, DBusTree_
|
||||||
, SafeClient(..)
|
, SafeClient(..)
|
||||||
, SysClient(..)
|
|
||||||
, SesClient(..)
|
|
||||||
, IODependency(..)
|
, IODependency(..)
|
||||||
, IODependency_(..)
|
, IODependency_(..)
|
||||||
, SystemDependency(..)
|
, SystemDependency(..)
|
||||||
|
@ -112,7 +110,6 @@ module XMonad.Internal.Dependency
|
||||||
, shellTest
|
, shellTest
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Exception hiding (bracket)
|
|
||||||
import Control.Monad.IO.Class
|
import Control.Monad.IO.Class
|
||||||
import Control.Monad.Identity
|
import Control.Monad.Identity
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
|
@ -124,6 +121,7 @@ import Data.Bifunctor
|
||||||
import Data.Either
|
import Data.Either
|
||||||
import qualified Data.HashMap.Strict as H
|
import qualified Data.HashMap.Strict as H
|
||||||
import Data.Hashable
|
import Data.Hashable
|
||||||
|
import Data.Internal.DBus
|
||||||
import Data.List
|
import Data.List
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.Yaml
|
import Data.Yaml
|
||||||
|
@ -132,8 +130,6 @@ import GHC.Generics (Generic)
|
||||||
import GHC.IO.Exception (ioe_description)
|
import GHC.IO.Exception (ioe_description)
|
||||||
|
|
||||||
import DBus hiding (typeOf)
|
import DBus hiding (typeOf)
|
||||||
import DBus.Client
|
|
||||||
import DBus.Internal
|
|
||||||
import qualified DBus.Introspection as I
|
import qualified DBus.Introspection as I
|
||||||
|
|
||||||
import System.Directory
|
import System.Directory
|
||||||
|
@ -300,47 +296,6 @@ data Root a = forall p. IORoot (p -> a) (IOTree p)
|
||||||
| forall c p. SafeClient c => DBusRoot (p -> c -> a) (DBusTree c p) (Maybe c)
|
| forall c p. SafeClient c => DBusRoot (p -> c -> a) (DBusTree c p) (Maybe c)
|
||||||
| forall c. SafeClient c => DBusRoot_ (c -> a) (DBusTree_ c) (Maybe c)
|
| forall c. SafeClient c => DBusRoot_ (c -> a) (DBusTree_ c) (Maybe c)
|
||||||
|
|
||||||
class SafeClient c where
|
|
||||||
toClient :: c -> Client
|
|
||||||
|
|
||||||
getDBusClient :: IO (Maybe c)
|
|
||||||
|
|
||||||
withDBusClient :: (c -> IO a) -> IO (Maybe a)
|
|
||||||
withDBusClient f = do
|
|
||||||
client <- getDBusClient
|
|
||||||
forM client $ \c -> do
|
|
||||||
r <- f c
|
|
||||||
disconnect (toClient c)
|
|
||||||
return r
|
|
||||||
|
|
||||||
withDBusClient_ :: (c -> IO ()) -> IO ()
|
|
||||||
withDBusClient_ = void . withDBusClient
|
|
||||||
|
|
||||||
fromDBusClient :: (c -> a) -> IO (Maybe a)
|
|
||||||
fromDBusClient f = withDBusClient (return . f)
|
|
||||||
|
|
||||||
newtype SysClient = SysClient Client
|
|
||||||
|
|
||||||
instance SafeClient SysClient where
|
|
||||||
toClient (SysClient cl) = cl
|
|
||||||
|
|
||||||
getDBusClient = fmap SysClient <$> getDBusClient' True
|
|
||||||
|
|
||||||
newtype SesClient = SesClient Client
|
|
||||||
|
|
||||||
instance SafeClient SesClient where
|
|
||||||
toClient (SesClient cl) = cl
|
|
||||||
|
|
||||||
getDBusClient = fmap SesClient <$> getDBusClient' False
|
|
||||||
|
|
||||||
getDBusClient' :: Bool -> IO (Maybe Client)
|
|
||||||
getDBusClient' sys = do
|
|
||||||
res <- try $ if sys then connectSystem else connectSession
|
|
||||||
case res of
|
|
||||||
Left e -> putStrLn (clientErrorMessage e) >> return Nothing
|
|
||||||
Right c -> return $ Just c
|
|
||||||
|
|
||||||
|
|
||||||
-- | The dependency tree with rule to merge results when needed
|
-- | The dependency tree with rule to merge results when needed
|
||||||
data Tree d d_ p =
|
data Tree d d_ p =
|
||||||
forall x y. And12 (x -> y -> p) (Tree d d_ x) (Tree d d_ y)
|
forall x y. And12 (x -> y -> p) (Tree d d_ x) (Tree d d_ y)
|
||||||
|
@ -937,7 +892,7 @@ testDBusDependency_ = testDBusDependency'_
|
||||||
|
|
||||||
testDBusDependency'_ :: SafeClient c => c -> DBusDependency_ c -> FIO Result_
|
testDBusDependency'_ :: SafeClient c => c -> DBusDependency_ c -> FIO Result_
|
||||||
testDBusDependency'_ cl (Bus _ bus) = io $ do
|
testDBusDependency'_ cl (Bus _ bus) = io $ do
|
||||||
ret <- callMethod (toClient cl) queryBus queryPath queryIface queryMem
|
ret <- callMethod cl queryBus queryPath queryIface queryMem
|
||||||
return $ case ret of
|
return $ case ret of
|
||||||
Left e -> Left [Msg Error e]
|
Left e -> Left [Msg Error e]
|
||||||
Right b -> let ns = bodyGetNames b in
|
Right b -> let ns = bodyGetNames b in
|
||||||
|
@ -955,7 +910,7 @@ testDBusDependency'_ cl (Bus _ bus) = io $ do
|
||||||
bodyGetNames _ = []
|
bodyGetNames _ = []
|
||||||
|
|
||||||
testDBusDependency'_ cl (Endpoint _ busname objpath iface mem) = io $ do
|
testDBusDependency'_ cl (Endpoint _ busname objpath iface mem) = io $ do
|
||||||
ret <- callMethod (toClient cl) busname objpath introspectInterface introspectMethod
|
ret <- callMethod cl busname objpath introspectInterface introspectMethod
|
||||||
return $ case ret of
|
return $ case ret of
|
||||||
Left e -> Left [Msg Error e]
|
Left e -> Left [Msg Error e]
|
||||||
Right body -> procBody body
|
Right body -> procBody body
|
||||||
|
@ -1055,7 +1010,7 @@ sometimesEndpoint fn name ful busname path iface mem cl =
|
||||||
sometimesDBus cl fn name deps cmd
|
sometimesDBus cl fn name deps cmd
|
||||||
where
|
where
|
||||||
deps = Only_ $ Endpoint ful busname path iface $ Method_ mem
|
deps = Only_ $ Endpoint ful busname path iface $ Method_ mem
|
||||||
cmd c = io $ void $ callMethod (toClient c) busname path iface mem
|
cmd c = io $ void $ callMethod c busname path iface mem
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Dependency Tree Constructors
|
-- | Dependency Tree Constructors
|
||||||
|
@ -1395,23 +1350,3 @@ bracket s = "[" ++ s ++ "]"
|
||||||
|
|
||||||
curly :: String -> String
|
curly :: String -> String
|
||||||
curly s = "{" ++ s ++ "}"
|
curly s = "{" ++ s ++ "}"
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
|
||||||
-- | Other random formatting
|
|
||||||
|
|
||||||
-- failedMsgsIO :: Bool -> String -> [SubfeatureFail] -> FIO [Msg]
|
|
||||||
-- failedMsgsIO err fn = io . failedMsgs err fn
|
|
||||||
|
|
||||||
-- failedMsgs :: Bool -> String -> [SubfeatureFail] -> IO [Msg]
|
|
||||||
-- failedMsgs err fn = fmap concat . mapM (failedMsg err fn)
|
|
||||||
|
|
||||||
-- failedMsg :: Bool -> String -> SubfeatureFail -> IO [Msg]
|
|
||||||
-- failedMsg err fn Subfeature { sfData = d, sfName = n } = do
|
|
||||||
-- mapM (fmtMsg err fn n) $ case d of (PostMissing e) -> [e]; (PostFail es) -> es
|
|
||||||
|
|
||||||
-- fmtMsg :: Bool -> String -> String -> Msg -> IO Msg
|
|
||||||
-- fmtMsg err fn n msg = do
|
|
||||||
-- let e = if err then "ERROR" else "WARNING"
|
|
||||||
-- p <- getProgName
|
|
||||||
-- return $ unwords [bracket p, bracket e, bracket fn, bracket n, msg]
|
|
||||||
|
|
|
@ -17,6 +17,9 @@ module XMonad.Internal.Command.DMenu
|
||||||
|
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
|
|
||||||
|
import Data.Internal.DBus
|
||||||
|
import Data.Internal.Dependency
|
||||||
|
|
||||||
import DBus
|
import DBus
|
||||||
|
|
||||||
import Graphics.X11.Types
|
import Graphics.X11.Types
|
||||||
|
@ -30,7 +33,6 @@ import System.IO
|
||||||
import XMonad.Core hiding (spawn)
|
import XMonad.Core hiding (spawn)
|
||||||
import XMonad.Internal.Command.Desktop
|
import XMonad.Internal.Command.Desktop
|
||||||
import XMonad.Internal.DBus.Common
|
import XMonad.Internal.DBus.Common
|
||||||
import XMonad.Internal.Dependency
|
|
||||||
import XMonad.Internal.Notify
|
import XMonad.Internal.Notify
|
||||||
import XMonad.Internal.Process
|
import XMonad.Internal.Process
|
||||||
import XMonad.Internal.Shell
|
import XMonad.Internal.Shell
|
||||||
|
|
|
@ -42,6 +42,9 @@ module XMonad.Internal.Command.Desktop
|
||||||
import Control.Monad (void)
|
import Control.Monad (void)
|
||||||
import Control.Monad.IO.Class
|
import Control.Monad.IO.Class
|
||||||
|
|
||||||
|
import Data.Internal.DBus
|
||||||
|
import Data.Internal.Dependency
|
||||||
|
|
||||||
import DBus
|
import DBus
|
||||||
|
|
||||||
import System.Directory
|
import System.Directory
|
||||||
|
@ -53,7 +56,6 @@ import XMonad (asks)
|
||||||
import XMonad.Actions.Volume
|
import XMonad.Actions.Volume
|
||||||
import XMonad.Core hiding (spawn)
|
import XMonad.Core hiding (spawn)
|
||||||
import XMonad.Internal.DBus.Common
|
import XMonad.Internal.DBus.Common
|
||||||
import XMonad.Internal.Dependency
|
|
||||||
import XMonad.Internal.Notify
|
import XMonad.Internal.Notify
|
||||||
import XMonad.Internal.Process
|
import XMonad.Internal.Process
|
||||||
import XMonad.Internal.Shell
|
import XMonad.Internal.Shell
|
||||||
|
|
|
@ -27,6 +27,8 @@ module XMonad.Internal.Command.Power
|
||||||
|
|
||||||
import Control.Arrow (first)
|
import Control.Arrow (first)
|
||||||
|
|
||||||
|
import Data.Internal.Dependency
|
||||||
|
|
||||||
import Data.Either
|
import Data.Either
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
|
|
||||||
|
@ -39,7 +41,6 @@ import System.IO.Error
|
||||||
import System.Process (ProcessHandle)
|
import System.Process (ProcessHandle)
|
||||||
|
|
||||||
import XMonad.Core
|
import XMonad.Core
|
||||||
import XMonad.Internal.Dependency
|
|
||||||
import XMonad.Internal.Process (spawnPipeArgs)
|
import XMonad.Internal.Process (spawnPipeArgs)
|
||||||
import XMonad.Internal.Shell
|
import XMonad.Internal.Shell
|
||||||
import qualified XMonad.Internal.Theme as T
|
import qualified XMonad.Internal.Theme as T
|
||||||
|
|
|
@ -15,6 +15,7 @@ import Control.Monad
|
||||||
import Data.ByteString hiding (readFile)
|
import Data.ByteString hiding (readFile)
|
||||||
import Data.ByteString.Char8 as C hiding (readFile)
|
import Data.ByteString.Char8 as C hiding (readFile)
|
||||||
import Data.Connection
|
import Data.Connection
|
||||||
|
import Data.Internal.Dependency
|
||||||
|
|
||||||
import Text.Read (readMaybe)
|
import Text.Read (readMaybe)
|
||||||
|
|
||||||
|
@ -24,7 +25,6 @@ import System.IO.Streams.UnixSocket
|
||||||
import XMonad.Core
|
import XMonad.Core
|
||||||
import XMonad.Internal.Command.Power
|
import XMonad.Internal.Command.Power
|
||||||
import XMonad.Internal.Concurrent.ClientMessage
|
import XMonad.Internal.Concurrent.ClientMessage
|
||||||
import XMonad.Internal.Dependency
|
|
||||||
import XMonad.Internal.Shell
|
import XMonad.Internal.Shell
|
||||||
import XMonad.Internal.Theme (FontBuilder)
|
import XMonad.Internal.Theme (FontBuilder)
|
||||||
|
|
||||||
|
|
|
@ -8,11 +8,12 @@ module XMonad.Internal.Concurrent.VirtualBox
|
||||||
|
|
||||||
import Control.Exception
|
import Control.Exception
|
||||||
|
|
||||||
|
import Data.Internal.Dependency
|
||||||
|
|
||||||
import Text.XML.Light
|
import Text.XML.Light
|
||||||
|
|
||||||
import System.Directory
|
import System.Directory
|
||||||
|
|
||||||
import XMonad.Internal.Dependency
|
|
||||||
import XMonad.Internal.Shell
|
import XMonad.Internal.Shell
|
||||||
|
|
||||||
vmExists :: String -> IO (Maybe Msg)
|
vmExists :: String -> IO (Maybe Msg)
|
||||||
|
|
|
@ -13,13 +13,14 @@ module XMonad.Internal.DBus.Brightness.ClevoKeyboard
|
||||||
import Control.Monad (when)
|
import Control.Monad (when)
|
||||||
|
|
||||||
import Data.Int (Int32)
|
import Data.Int (Int32)
|
||||||
|
import Data.Internal.DBus
|
||||||
|
import Data.Internal.Dependency
|
||||||
|
|
||||||
import DBus
|
import DBus
|
||||||
|
|
||||||
import System.FilePath.Posix
|
import System.FilePath.Posix
|
||||||
|
|
||||||
import XMonad.Internal.DBus.Brightness.Common
|
import XMonad.Internal.DBus.Brightness.Common
|
||||||
import XMonad.Internal.Dependency
|
|
||||||
import XMonad.Internal.IO
|
import XMonad.Internal.IO
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
|
@ -123,7 +124,7 @@ clevoKeyboardControls :: Maybe SesClient -> BrightnessControls
|
||||||
clevoKeyboardControls = brightnessControls xpfClevoBacklight clevoKeyboardConfig
|
clevoKeyboardControls = brightnessControls xpfClevoBacklight clevoKeyboardConfig
|
||||||
|
|
||||||
callGetBrightnessCK :: SesClient -> IO (Maybe Brightness)
|
callGetBrightnessCK :: SesClient -> IO (Maybe Brightness)
|
||||||
callGetBrightnessCK = callGetBrightness clevoKeyboardConfig . toClient
|
callGetBrightnessCK = callGetBrightness clevoKeyboardConfig
|
||||||
|
|
||||||
matchSignalCK :: (Maybe Brightness -> IO ()) -> SesClient -> IO ()
|
matchSignalCK :: (Maybe Brightness -> IO ()) -> SesClient -> IO ()
|
||||||
matchSignalCK cb = matchSignal clevoKeyboardConfig cb . toClient
|
matchSignalCK = matchSignal clevoKeyboardConfig
|
||||||
|
|
|
@ -14,15 +14,15 @@ module XMonad.Internal.DBus.Brightness.Common
|
||||||
import Control.Monad (void)
|
import Control.Monad (void)
|
||||||
|
|
||||||
import Data.Int (Int32)
|
import Data.Int (Int32)
|
||||||
|
import Data.Internal.DBus
|
||||||
|
import Data.Internal.Dependency
|
||||||
|
|
||||||
import DBus
|
import DBus
|
||||||
import DBus.Client
|
import DBus.Client
|
||||||
import DBus.Internal
|
|
||||||
import qualified DBus.Introspection as I
|
import qualified DBus.Introspection as I
|
||||||
|
|
||||||
import XMonad.Core (io)
|
import XMonad.Core (io)
|
||||||
import XMonad.Internal.DBus.Common
|
import XMonad.Internal.DBus.Common
|
||||||
import XMonad.Internal.Dependency
|
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | External API
|
-- | External API
|
||||||
|
@ -64,7 +64,8 @@ brightnessControls q bc cl =
|
||||||
where
|
where
|
||||||
cb = callBacklight q cl bc
|
cb = callBacklight q cl bc
|
||||||
|
|
||||||
callGetBrightness :: Num c => BrightnessConfig a b -> Client -> IO (Maybe c)
|
callGetBrightness :: (SafeClient c, Num n) => BrightnessConfig a b -> c
|
||||||
|
-> IO (Maybe n)
|
||||||
callGetBrightness BrightnessConfig { bcPath = p, bcInterface = i } client =
|
callGetBrightness BrightnessConfig { bcPath = p, bcInterface = i } client =
|
||||||
either (const Nothing) bodyGetBrightness
|
either (const Nothing) bodyGetBrightness
|
||||||
<$> callMethod client xmonadBusName p i memGet
|
<$> callMethod client xmonadBusName p i memGet
|
||||||
|
@ -73,7 +74,8 @@ signalDep :: BrightnessConfig a b -> DBusDependency_ SesClient
|
||||||
signalDep BrightnessConfig { bcPath = p, bcInterface = i } =
|
signalDep BrightnessConfig { bcPath = p, bcInterface = i } =
|
||||||
Endpoint [] xmonadBusName p i $ Signal_ memCur
|
Endpoint [] xmonadBusName p i $ Signal_ memCur
|
||||||
|
|
||||||
matchSignal :: Num c => BrightnessConfig a b -> (Maybe c -> IO ()) -> Client -> IO ()
|
matchSignal :: (SafeClient c, Num n) => BrightnessConfig a b
|
||||||
|
-> (Maybe n-> IO ()) -> c -> IO ()
|
||||||
matchSignal BrightnessConfig { bcPath = p, bcInterface = i } cb =
|
matchSignal BrightnessConfig { bcPath = p, bcInterface = i } cb =
|
||||||
void . addMatchCallback brMatcher (cb . bodyGetBrightness)
|
void . addMatchCallback brMatcher (cb . bodyGetBrightness)
|
||||||
where
|
where
|
||||||
|
@ -139,7 +141,7 @@ callBacklight q cl BrightnessConfig { bcPath = p
|
||||||
Sometimes (unwords [n, controlName]) q [Subfeature root "method call"]
|
Sometimes (unwords [n, controlName]) q [Subfeature root "method call"]
|
||||||
where
|
where
|
||||||
root = DBusRoot_ cmd (Only_ $ Endpoint [] xmonadBusName p i $ Method_ m) cl
|
root = DBusRoot_ cmd (Only_ $ Endpoint [] xmonadBusName p i $ Method_ m) cl
|
||||||
cmd c = io $ void $ callMethod (toClient c) xmonadBusName p i m
|
cmd c = io $ void $ callMethod c xmonadBusName p i m
|
||||||
|
|
||||||
bodyGetBrightness :: Num a => [Variant] -> Maybe a
|
bodyGetBrightness :: Num a => [Variant] -> Maybe a
|
||||||
bodyGetBrightness [b] = fromIntegral <$> (fromVariant b :: Maybe Int32)
|
bodyGetBrightness [b] = fromIntegral <$> (fromVariant b :: Maybe Int32)
|
||||||
|
|
|
@ -11,13 +11,14 @@ module XMonad.Internal.DBus.Brightness.IntelBacklight
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Data.Int (Int32)
|
import Data.Int (Int32)
|
||||||
|
import Data.Internal.DBus
|
||||||
|
import Data.Internal.Dependency
|
||||||
|
|
||||||
import DBus
|
import DBus
|
||||||
|
|
||||||
import System.FilePath.Posix
|
import System.FilePath.Posix
|
||||||
|
|
||||||
import XMonad.Internal.DBus.Brightness.Common
|
import XMonad.Internal.DBus.Brightness.Common
|
||||||
import XMonad.Internal.Dependency
|
|
||||||
import XMonad.Internal.IO
|
import XMonad.Internal.IO
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
|
@ -105,7 +106,7 @@ intelBacklightControls :: Maybe SesClient -> BrightnessControls
|
||||||
intelBacklightControls = brightnessControls xpfIntelBacklight intelBacklightConfig
|
intelBacklightControls = brightnessControls xpfIntelBacklight intelBacklightConfig
|
||||||
|
|
||||||
callGetBrightnessIB :: SesClient -> IO (Maybe Brightness)
|
callGetBrightnessIB :: SesClient -> IO (Maybe Brightness)
|
||||||
callGetBrightnessIB = callGetBrightness intelBacklightConfig . toClient
|
callGetBrightnessIB = callGetBrightness intelBacklightConfig
|
||||||
|
|
||||||
matchSignalIB :: (Maybe Brightness -> IO ()) -> SesClient -> IO ()
|
matchSignalIB :: (Maybe Brightness -> IO ()) -> SesClient -> IO ()
|
||||||
matchSignalIB cb = matchSignal intelBacklightConfig cb . toClient
|
matchSignalIB = matchSignal intelBacklightConfig
|
||||||
|
|
|
@ -19,6 +19,9 @@ module XMonad.Internal.DBus.Control
|
||||||
|
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
|
|
||||||
|
import Data.Internal.DBus
|
||||||
|
import Data.Internal.Dependency
|
||||||
|
|
||||||
import DBus
|
import DBus
|
||||||
import DBus.Client
|
import DBus.Client
|
||||||
|
|
||||||
|
@ -26,7 +29,6 @@ import XMonad.Internal.DBus.Brightness.ClevoKeyboard
|
||||||
import XMonad.Internal.DBus.Brightness.IntelBacklight
|
import XMonad.Internal.DBus.Brightness.IntelBacklight
|
||||||
import XMonad.Internal.DBus.Common
|
import XMonad.Internal.DBus.Common
|
||||||
import XMonad.Internal.DBus.Screensaver
|
import XMonad.Internal.DBus.Screensaver
|
||||||
import XMonad.Internal.Dependency
|
|
||||||
|
|
||||||
-- | Current connections to the DBus (session and system buses)
|
-- | Current connections to the DBus (session and system buses)
|
||||||
data DBusState = DBusState
|
data DBusState = DBusState
|
||||||
|
|
|
@ -8,14 +8,15 @@ module XMonad.Internal.DBus.Removable (runRemovableMon) where
|
||||||
|
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
|
|
||||||
import Data.Map.Lazy (Map, member)
|
import Data.Internal.DBus
|
||||||
|
import Data.Internal.Dependency
|
||||||
|
import Data.Map.Strict (Map, member)
|
||||||
|
|
||||||
import DBus
|
import DBus
|
||||||
import DBus.Client
|
import DBus.Client
|
||||||
|
|
||||||
import XMonad.Core (io)
|
import XMonad.Core (io)
|
||||||
import XMonad.Internal.Command.Desktop
|
import XMonad.Internal.Command.Desktop
|
||||||
import XMonad.Internal.Dependency
|
|
||||||
|
|
||||||
bus :: BusName
|
bus :: BusName
|
||||||
bus = busName_ "org.freedesktop.UDisks2"
|
bus = busName_ "org.freedesktop.UDisks2"
|
||||||
|
|
|
@ -11,16 +11,17 @@ module XMonad.Internal.DBus.Screensaver
|
||||||
|
|
||||||
import Control.Monad (void)
|
import Control.Monad (void)
|
||||||
|
|
||||||
|
import Data.Internal.DBus
|
||||||
|
import Data.Internal.Dependency
|
||||||
|
|
||||||
import DBus
|
import DBus
|
||||||
import DBus.Client
|
import DBus.Client
|
||||||
import DBus.Internal
|
|
||||||
import qualified DBus.Introspection as I
|
import qualified DBus.Introspection as I
|
||||||
|
|
||||||
import Graphics.X11.XScreenSaver
|
import Graphics.X11.XScreenSaver
|
||||||
import Graphics.X11.Xlib.Display
|
import Graphics.X11.Xlib.Display
|
||||||
|
|
||||||
import XMonad.Internal.DBus.Common
|
import XMonad.Internal.DBus.Common
|
||||||
import XMonad.Internal.Dependency
|
|
||||||
import XMonad.Internal.Process
|
import XMonad.Internal.Process
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
|
@ -124,14 +125,14 @@ callToggle :: Maybe SesClient -> SometimesIO
|
||||||
callToggle = sometimesEndpoint "screensaver toggle" "dbus switch" []
|
callToggle = sometimesEndpoint "screensaver toggle" "dbus switch" []
|
||||||
xmonadBusName ssPath interface memToggle
|
xmonadBusName ssPath interface memToggle
|
||||||
|
|
||||||
callQuery :: Client -> IO (Maybe SSState)
|
callQuery :: SesClient -> IO (Maybe SSState)
|
||||||
callQuery client = do
|
callQuery ses = do
|
||||||
reply <- callMethod client xmonadBusName ssPath interface memQuery
|
reply <- callMethod ses xmonadBusName ssPath interface memQuery
|
||||||
return $ either (const Nothing) bodyGetCurrentState reply
|
return $ either (const Nothing) bodyGetCurrentState reply
|
||||||
|
|
||||||
matchSignal :: (Maybe SSState -> IO ()) -> SesClient -> IO ()
|
matchSignal :: (Maybe SSState -> IO ()) -> SesClient -> IO ()
|
||||||
matchSignal cb ses = void $ addMatchCallback ruleCurrentState
|
matchSignal cb ses = void $ addMatchCallback ruleCurrentState
|
||||||
(cb . bodyGetCurrentState) $ toClient ses
|
(cb . bodyGetCurrentState) ses
|
||||||
|
|
||||||
ssSignalDep :: DBusDependency_ SesClient
|
ssSignalDep :: DBusDependency_ SesClient
|
||||||
ssSignalDep = Endpoint [] xmonadBusName ssPath interface $ Signal_ memState
|
ssSignalDep = Endpoint [] xmonadBusName ssPath interface $ Signal_ memState
|
||||||
|
|
|
@ -6,7 +6,8 @@
|
||||||
|
|
||||||
module Xmobar.Plugins.BacklightCommon (startBacklight) where
|
module Xmobar.Plugins.BacklightCommon (startBacklight) where
|
||||||
|
|
||||||
import XMonad.Internal.Dependency
|
import Data.Internal.DBus
|
||||||
|
|
||||||
import Xmobar.Plugins.Common
|
import Xmobar.Plugins.Common
|
||||||
|
|
||||||
startBacklight :: RealFrac a => ((Maybe a -> IO ()) -> SesClient -> IO ())
|
startBacklight :: RealFrac a => ((Maybe a -> IO ()) -> SesClient -> IO ())
|
||||||
|
|
|
@ -39,6 +39,8 @@ module Xmobar.Plugins.Bluetooth
|
||||||
import Control.Concurrent.MVar
|
import Control.Concurrent.MVar
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
|
|
||||||
|
import Data.Internal.DBus
|
||||||
|
import Data.Internal.Dependency
|
||||||
import Data.List
|
import Data.List
|
||||||
import Data.List.Split
|
import Data.List.Split
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
|
@ -46,10 +48,8 @@ import Data.Maybe
|
||||||
|
|
||||||
import DBus
|
import DBus
|
||||||
import DBus.Client
|
import DBus.Client
|
||||||
import DBus.Internal
|
|
||||||
|
|
||||||
import XMonad.Internal.DBus.Common
|
import XMonad.Internal.DBus.Common
|
||||||
import XMonad.Internal.Dependency
|
|
||||||
import Xmobar
|
import Xmobar
|
||||||
import Xmobar.Plugins.Common
|
import Xmobar.Plugins.Common
|
||||||
|
|
||||||
|
@ -158,13 +158,13 @@ splitPath :: ObjectPath -> [String]
|
||||||
splitPath = splitOn "/" . dropWhile (=='/') . formatObjectPath
|
splitPath = splitOn "/" . dropWhile (=='/') . formatObjectPath
|
||||||
|
|
||||||
getBtObjectTree :: SysClient -> IO ObjectTree
|
getBtObjectTree :: SysClient -> IO ObjectTree
|
||||||
getBtObjectTree sys = callGetManagedObjects (toClient sys) btBus btOMPath
|
getBtObjectTree sys = callGetManagedObjects sys btBus btOMPath
|
||||||
|
|
||||||
btOMPath :: ObjectPath
|
btOMPath :: ObjectPath
|
||||||
btOMPath = objectPath_ "/"
|
btOMPath = objectPath_ "/"
|
||||||
|
|
||||||
addBtOMListener :: SignalCallback -> SysClient -> IO ()
|
addBtOMListener :: SignalCallback -> SysClient -> IO ()
|
||||||
addBtOMListener sc = void . addInterfaceAddedListener btBus btOMPath sc . toClient
|
addBtOMListener sc = void . addInterfaceAddedListener btBus btOMPath sc
|
||||||
|
|
||||||
addDeviceAddedListener :: MutableBtState -> IO () -> ObjectPath -> SysClient -> IO ()
|
addDeviceAddedListener :: MutableBtState -> IO () -> ObjectPath -> SysClient -> IO ()
|
||||||
addDeviceAddedListener state display adapter client =
|
addDeviceAddedListener state display adapter client =
|
||||||
|
@ -195,19 +195,19 @@ initAdapter state adapter client = do
|
||||||
putPowered state $ fromSingletonVariant reply
|
putPowered state $ fromSingletonVariant reply
|
||||||
|
|
||||||
matchBTProperty :: SysClient -> ObjectPath -> IO (Maybe MatchRule)
|
matchBTProperty :: SysClient -> ObjectPath -> IO (Maybe MatchRule)
|
||||||
matchBTProperty client p = matchPropertyFull (toClient client) btBus (Just p)
|
matchBTProperty sys p = matchPropertyFull sys btBus (Just p)
|
||||||
|
|
||||||
addAdaptorListener :: MutableBtState -> IO () -> ObjectPath -> SysClient
|
addAdaptorListener :: MutableBtState -> IO () -> ObjectPath -> SysClient
|
||||||
-> IO (Maybe SignalHandler)
|
-> IO (Maybe SignalHandler)
|
||||||
addAdaptorListener state display adaptor sys = do
|
addAdaptorListener state display adaptor sys = do
|
||||||
rule <- matchBTProperty sys adaptor
|
rule <- matchBTProperty sys adaptor
|
||||||
forM rule $ \r -> addMatchCallback r (procMatch . matchPowered) (toClient sys)
|
forM rule $ \r -> addMatchCallback r (procMatch . matchPowered) sys
|
||||||
where
|
where
|
||||||
procMatch = withSignalMatch $ \b -> putPowered state b >> display
|
procMatch = withSignalMatch $ \b -> putPowered state b >> display
|
||||||
|
|
||||||
callGetPowered :: ObjectPath -> SysClient -> IO [Variant]
|
callGetPowered :: ObjectPath -> SysClient -> IO [Variant]
|
||||||
callGetPowered adapter sys =
|
callGetPowered adapter = callPropertyGet btBus adapter adapterInterface
|
||||||
callPropertyGet btBus adapter adapterInterface (memberName_ adaptorPowered) $ toClient sys
|
$ memberName_ adaptorPowered
|
||||||
|
|
||||||
matchPowered :: [Variant] -> SignalMatch Bool
|
matchPowered :: [Variant] -> SignalMatch Bool
|
||||||
matchPowered = matchPropertyChanged adapterInterface adaptorPowered
|
matchPowered = matchPropertyChanged adapterInterface adaptorPowered
|
||||||
|
@ -234,8 +234,8 @@ addAndInitDevice state display device client = do
|
||||||
forM_ sh $ \s -> initDevice state s device client
|
forM_ sh $ \s -> initDevice state s device client
|
||||||
|
|
||||||
initDevice :: MutableBtState -> SignalHandler -> ObjectPath -> SysClient -> IO ()
|
initDevice :: MutableBtState -> SignalHandler -> ObjectPath -> SysClient -> IO ()
|
||||||
initDevice state sh device client = do
|
initDevice state sh device sys = do
|
||||||
reply <- callGetConnected device (toClient client)
|
reply <- callGetConnected device sys
|
||||||
void $ insertDevice state device $
|
void $ insertDevice state device $
|
||||||
BTDevice { btDevConnected = fromVariant =<< listToMaybe reply
|
BTDevice { btDevConnected = fromVariant =<< listToMaybe reply
|
||||||
, btDevSigHandler = sh
|
, btDevSigHandler = sh
|
||||||
|
@ -243,16 +243,16 @@ initDevice state sh device client = do
|
||||||
|
|
||||||
addDeviceListener :: MutableBtState -> IO () -> ObjectPath -> SysClient
|
addDeviceListener :: MutableBtState -> IO () -> ObjectPath -> SysClient
|
||||||
-> IO (Maybe SignalHandler)
|
-> IO (Maybe SignalHandler)
|
||||||
addDeviceListener state display device client = do
|
addDeviceListener state display device sys = do
|
||||||
rule <- matchBTProperty client device
|
rule <- matchBTProperty sys device
|
||||||
forM rule $ \r -> addMatchCallback r (procMatch . matchConnected) (toClient client)
|
forM rule $ \r -> addMatchCallback r (procMatch . matchConnected) sys
|
||||||
where
|
where
|
||||||
procMatch = withSignalMatch $ \c -> updateDevice state device c >> display
|
procMatch = withSignalMatch $ \c -> updateDevice state device c >> display
|
||||||
|
|
||||||
matchConnected :: [Variant] -> SignalMatch Bool
|
matchConnected :: [Variant] -> SignalMatch Bool
|
||||||
matchConnected = matchPropertyChanged devInterface devConnected
|
matchConnected = matchPropertyChanged devInterface devConnected
|
||||||
|
|
||||||
callGetConnected :: ObjectPath -> Client -> IO [Variant]
|
callGetConnected :: ObjectPath -> SysClient -> IO [Variant]
|
||||||
callGetConnected p = callPropertyGet btBus p devInterface $ memberName_ devConnected
|
callGetConnected p = callPropertyGet btBus p devInterface $ memberName_ devConnected
|
||||||
|
|
||||||
insertDevice :: MutableBtState -> ObjectPath -> BTDevice -> IO Bool
|
insertDevice :: MutableBtState -> ObjectPath -> BTDevice -> IO Bool
|
||||||
|
|
|
@ -1,4 +1,3 @@
|
||||||
|
|
||||||
module Xmobar.Plugins.Common
|
module Xmobar.Plugins.Common
|
||||||
( colorText
|
( colorText
|
||||||
, startListener
|
, startListener
|
||||||
|
@ -16,12 +15,12 @@ module Xmobar.Plugins.Common
|
||||||
|
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
|
|
||||||
|
import Data.Internal.DBus
|
||||||
|
|
||||||
import DBus
|
import DBus
|
||||||
import DBus.Client
|
import DBus.Client
|
||||||
import DBus.Internal
|
|
||||||
|
|
||||||
import XMonad.Hooks.DynamicLog (xmobarColor)
|
import XMonad.Hooks.DynamicLog (xmobarColor)
|
||||||
import XMonad.Internal.Dependency
|
|
||||||
|
|
||||||
type Callback = String -> IO ()
|
type Callback = String -> IO ()
|
||||||
|
|
||||||
|
@ -31,9 +30,9 @@ data Colors = Colors
|
||||||
}
|
}
|
||||||
deriving (Eq, Show, Read)
|
deriving (Eq, Show, Read)
|
||||||
|
|
||||||
startListener :: IsVariant a => MatchRule -> (Client -> IO [Variant])
|
startListener :: (SafeClient c, IsVariant a) => MatchRule -> (c -> IO [Variant])
|
||||||
-> ([Variant] -> SignalMatch a) -> (a -> IO String) -> Callback
|
-> ([Variant] -> SignalMatch a) -> (a -> IO String) -> Callback
|
||||||
-> Client -> IO ()
|
-> c -> IO ()
|
||||||
startListener rule getProp fromSignal toColor cb client = do
|
startListener rule getProp fromSignal toColor cb client = do
|
||||||
reply <- getProp client
|
reply <- getProp client
|
||||||
displayMaybe cb toColor $ fromSingletonVariant reply
|
displayMaybe cb toColor $ fromSingletonVariant reply
|
||||||
|
|
|
@ -11,15 +11,14 @@ module Xmobar.Plugins.Device
|
||||||
|
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
|
|
||||||
|
import Data.Internal.DBus
|
||||||
|
import Data.Internal.Dependency
|
||||||
import Data.Word
|
import Data.Word
|
||||||
|
|
||||||
import DBus
|
import DBus
|
||||||
import DBus.Client
|
|
||||||
import DBus.Internal
|
|
||||||
|
|
||||||
import XMonad.Internal.Command.Desktop
|
import XMonad.Internal.Command.Desktop
|
||||||
import XMonad.Internal.DBus.Common
|
import XMonad.Internal.DBus.Common
|
||||||
import XMonad.Internal.Dependency
|
|
||||||
import Xmobar
|
import Xmobar
|
||||||
import Xmobar.Plugins.Common
|
import Xmobar.Plugins.Common
|
||||||
|
|
||||||
|
@ -45,13 +44,13 @@ devDep = Endpoint networkManagerPkgs networkManagerBus nmPath nmInterface
|
||||||
$ Method_ getByIP
|
$ Method_ getByIP
|
||||||
|
|
||||||
getDevice :: SysClient -> String -> IO (Maybe ObjectPath)
|
getDevice :: SysClient -> String -> IO (Maybe ObjectPath)
|
||||||
getDevice cl iface = bodyToMaybe <$> callMethod' (toClient cl) mc
|
getDevice sys iface = bodyToMaybe <$> callMethod' sys mc
|
||||||
where
|
where
|
||||||
mc = (methodCallBus networkManagerBus nmPath nmInterface getByIP)
|
mc = (methodCallBus networkManagerBus nmPath nmInterface getByIP)
|
||||||
{ methodCallBody = [toVariant iface]
|
{ methodCallBody = [toVariant iface]
|
||||||
}
|
}
|
||||||
|
|
||||||
getDeviceConnected :: ObjectPath -> Client -> IO [Variant]
|
getDeviceConnected :: ObjectPath -> SysClient -> IO [Variant]
|
||||||
getDeviceConnected path = callPropertyGet networkManagerBus path nmDeviceInterface
|
getDeviceConnected path = callPropertyGet networkManagerBus path nmDeviceInterface
|
||||||
$ memberName_ devSignal
|
$ memberName_ devSignal
|
||||||
|
|
||||||
|
@ -61,13 +60,13 @@ matchStatus = matchPropertyChanged nmDeviceInterface devSignal
|
||||||
instance Exec Device where
|
instance Exec Device where
|
||||||
alias (Device (iface, _, _)) = iface
|
alias (Device (iface, _, _)) = iface
|
||||||
start (Device (iface, text, colors)) cb = do
|
start (Device (iface, text, colors)) cb = do
|
||||||
withDBusClientConnection cb $ \client -> do
|
withDBusClientConnection cb $ \sys -> do
|
||||||
path <- getDevice client iface
|
path <- getDevice sys iface
|
||||||
displayMaybe' cb (listener client) path
|
displayMaybe' cb (listener sys) path
|
||||||
where
|
where
|
||||||
listener client path = do
|
listener sys path = do
|
||||||
rule <- matchPropertyFull (toClient client) networkManagerBus (Just path)
|
rule <- matchPropertyFull sys networkManagerBus (Just path)
|
||||||
-- TODO warn the user here rather than silently drop the listener
|
-- TODO warn the user here rather than silently drop the listener
|
||||||
forM_ rule $ \r ->
|
forM_ rule $ \r ->
|
||||||
startListener r (getDeviceConnected path) matchStatus chooseColor' cb (toClient client)
|
startListener r (getDeviceConnected path) matchStatus chooseColor' cb sys
|
||||||
chooseColor' = return . (\s -> colorText colors s text) . (> 1)
|
chooseColor' = return . (\s -> colorText colors s text) . (> 1)
|
||||||
|
|
|
@ -12,7 +12,6 @@ module Xmobar.Plugins.Screensaver
|
||||||
import Xmobar
|
import Xmobar
|
||||||
|
|
||||||
import XMonad.Internal.DBus.Screensaver
|
import XMonad.Internal.DBus.Screensaver
|
||||||
import XMonad.Internal.Dependency
|
|
||||||
import Xmobar.Plugins.Common
|
import Xmobar.Plugins.Common
|
||||||
|
|
||||||
newtype Screensaver = Screensaver (String, Colors) deriving (Read, Show)
|
newtype Screensaver = Screensaver (String, Colors) deriving (Read, Show)
|
||||||
|
@ -23,9 +22,9 @@ ssAlias = "screensaver"
|
||||||
instance Exec Screensaver where
|
instance Exec Screensaver where
|
||||||
alias (Screensaver _) = ssAlias
|
alias (Screensaver _) = ssAlias
|
||||||
start (Screensaver (text, colors)) cb = do
|
start (Screensaver (text, colors)) cb = do
|
||||||
withDBusClientConnection cb $ \c -> do
|
withDBusClientConnection cb $ \sys -> do
|
||||||
matchSignal display c
|
matchSignal display sys
|
||||||
display =<< callQuery (toClient c)
|
display =<< callQuery sys
|
||||||
where
|
where
|
||||||
display = displayMaybe cb $ return . (\s -> colorText colors s text)
|
display = displayMaybe cb $ return . (\s -> colorText colors s text)
|
||||||
|
|
||||||
|
|
|
@ -14,16 +14,16 @@ module Xmobar.Plugins.VPN
|
||||||
import Control.Concurrent.MVar
|
import Control.Concurrent.MVar
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
|
|
||||||
|
import Data.Internal.DBus
|
||||||
|
import Data.Internal.Dependency
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import qualified Data.Set as S
|
import qualified Data.Set as S
|
||||||
|
|
||||||
import DBus
|
import DBus
|
||||||
import DBus.Internal
|
|
||||||
|
|
||||||
import XMonad.Internal.Command.Desktop
|
import XMonad.Internal.Command.Desktop
|
||||||
import XMonad.Internal.DBus.Common
|
import XMonad.Internal.DBus.Common
|
||||||
import XMonad.Internal.Dependency
|
|
||||||
import Xmobar
|
import Xmobar
|
||||||
import Xmobar.Plugins.Common
|
import Xmobar.Plugins.Common
|
||||||
|
|
||||||
|
@ -70,16 +70,16 @@ updateState f state op = modifyMVar_ state $ return . f op
|
||||||
--
|
--
|
||||||
|
|
||||||
getVPNObjectTree :: SysClient -> IO ObjectTree
|
getVPNObjectTree :: SysClient -> IO ObjectTree
|
||||||
getVPNObjectTree client = callGetManagedObjects (toClient client) vpnBus vpnPath
|
getVPNObjectTree sys = callGetManagedObjects sys vpnBus vpnPath
|
||||||
|
|
||||||
findTunnels :: ObjectTree -> VPNState
|
findTunnels :: ObjectTree -> VPNState
|
||||||
findTunnels = S.fromList . M.keys . M.filter (elem vpnDeviceTun . M.keys)
|
findTunnels = S.fromList . M.keys . M.filter (elem vpnDeviceTun . M.keys)
|
||||||
|
|
||||||
vpnAddedListener :: SignalCallback -> SysClient -> IO ()
|
vpnAddedListener :: SignalCallback -> SysClient -> IO ()
|
||||||
vpnAddedListener cb = void . addInterfaceAddedListener vpnBus vpnPath cb . toClient
|
vpnAddedListener cb = void . addInterfaceAddedListener vpnBus vpnPath cb
|
||||||
|
|
||||||
vpnRemovedListener :: SignalCallback -> SysClient -> IO ()
|
vpnRemovedListener :: SignalCallback -> SysClient -> IO ()
|
||||||
vpnRemovedListener cb = void . addInterfaceRemovedListener vpnBus vpnPath cb . toClient
|
vpnRemovedListener cb = void . addInterfaceRemovedListener vpnBus vpnPath cb
|
||||||
|
|
||||||
addedCallback :: MutableVPNState -> IO () -> SignalCallback
|
addedCallback :: MutableVPNState -> IO () -> SignalCallback
|
||||||
addedCallback state display [device, added] = update >> display
|
addedCallback state display [device, added] = update >> display
|
||||||
|
|
|
@ -12,7 +12,6 @@ library
|
||||||
, XMonad.Internal.Theme
|
, XMonad.Internal.Theme
|
||||||
, XMonad.Internal.Notify
|
, XMonad.Internal.Notify
|
||||||
, XMonad.Internal.Shell
|
, XMonad.Internal.Shell
|
||||||
, XMonad.Internal.Dependency
|
|
||||||
, XMonad.Internal.IO
|
, XMonad.Internal.IO
|
||||||
, XMonad.Internal.Command.Desktop
|
, XMonad.Internal.Command.Desktop
|
||||||
, XMonad.Internal.Command.DMenu
|
, XMonad.Internal.Command.DMenu
|
||||||
|
@ -33,7 +32,8 @@ library
|
||||||
, Xmobar.Plugins.IntelBacklight
|
, Xmobar.Plugins.IntelBacklight
|
||||||
, Xmobar.Plugins.Screensaver
|
, Xmobar.Plugins.Screensaver
|
||||||
, Xmobar.Plugins.VPN
|
, Xmobar.Plugins.VPN
|
||||||
, DBus.Internal
|
, Data.Internal.Dependency
|
||||||
|
, Data.Internal.DBus
|
||||||
build-depends: X11 >= 1.9.1
|
build-depends: X11 >= 1.9.1
|
||||||
, base
|
, base
|
||||||
, bytestring >= 0.10.8.2
|
, bytestring >= 0.10.8.2
|
||||||
|
|
Loading…
Reference in New Issue