ENH don't hardcode interfaces
This commit is contained in:
parent
43345f8ce0
commit
2ef652ebe1
|
@ -114,8 +114,7 @@ run = do
|
|||
hSetBuffering stdout LineBuffering
|
||||
withDBusX_ $ \db -> do
|
||||
let fs = features $ dbSysClient db
|
||||
-- startDBusInterfaces db fs
|
||||
withDBusInterfaces db $ \_ -> do
|
||||
withDBusInterfaces db (fsDBusExporters fs) $ \_ -> do
|
||||
withXmobar $ \xmobarP -> do
|
||||
withChildDaemons fs $ \ds -> do
|
||||
let ts = ThreadState ds (Just xmobarP)
|
||||
|
@ -158,9 +157,6 @@ runXMonad conf = do
|
|||
dirs <- getCreateDirectories
|
||||
launch conf dirs
|
||||
|
||||
-- startDBusInterfaces :: DBusState -> [Maybe SesClient -> SometimesIO] -> FIO ()
|
||||
-- startDBusInterfaces db = mapM_ (\f -> executeSometimes $ f $ dbSesClient db)
|
||||
|
||||
getCreateDirectories :: IO Directories
|
||||
getCreateDirectories = do
|
||||
ds <- getDirectories
|
||||
|
@ -176,7 +172,7 @@ getCreateDirectories = do
|
|||
|
||||
data FeatureSet = FeatureSet
|
||||
{ fsKeys :: X () -> DBusState -> [KeyGroup FeatureX]
|
||||
, fsDBusExporters :: [Maybe SesClient -> Sometimes (IO (), IO ())]
|
||||
, fsDBusExporters :: [Maybe SesClient -> Sometimes (FIO (), FIO ())]
|
||||
, fsPowerMon :: SometimesIO
|
||||
, fsRemovableMon :: Maybe SysClient -> SometimesIO
|
||||
, fsDaemons :: [Sometimes (FIO (Process () () ()))]
|
||||
|
|
|
@ -100,11 +100,15 @@ disconnectDBusX db = do
|
|||
forM_ (dbSesClient db) releaseXMonadName
|
||||
disconnectDBus db
|
||||
|
||||
withDBusInterfaces :: DBusState -> ([FIO ()] -> FIO a) -> FIO a
|
||||
withDBusInterfaces db = bracket up sequence
|
||||
withDBusInterfaces
|
||||
:: DBusState
|
||||
-> [Maybe SesClient -> Sometimes (FIO (), FIO ())]
|
||||
-> ([FIO ()] -> FIO a)
|
||||
-> FIO a
|
||||
withDBusInterfaces db interfaces = bracket up sequence
|
||||
where
|
||||
up = do
|
||||
pairs <- catMaybes <$> mapM (\f -> evalSometimes $ f $ dbSesClient db) dbusExporters
|
||||
pairs <- catMaybes <$> mapM (\f -> evalSometimes $ f $ dbSesClient db) interfaces
|
||||
mapM_ fst pairs
|
||||
return $ snd <$> pairs
|
||||
|
||||
|
|
Loading…
Reference in New Issue