ENH use dbus bracket with xmonad dep print
This commit is contained in:
parent
05f1165cc1
commit
fcb454bc29
|
@ -203,13 +203,6 @@ startXmobar = do
|
|||
startChildDaemons :: FeatureSet -> FIO [Process () () ()]
|
||||
startChildDaemons fs = catMaybes <$> mapM executeSometimes (fsDaemons fs)
|
||||
|
||||
-- withDBusX :: (DBusState -> FIO a) -> FIO a
|
||||
-- withDBusX = bracket (io connectDBusX) cleanup
|
||||
-- where
|
||||
-- cleanup db = do
|
||||
-- logInfo "unregistering xmonad from DBus"
|
||||
-- io $ disconnectDBus db
|
||||
|
||||
withChildDaemons :: FeatureSet -> ([Process () () ()] -> FIO a) -> FIO a
|
||||
withChildDaemons fs = bracket (startChildDaemons fs) cleanup
|
||||
where
|
||||
|
@ -225,17 +218,14 @@ withXmobar = bracket startXmobar cleanup
|
|||
io $ killNoWait p
|
||||
|
||||
printDeps :: FIO ()
|
||||
printDeps = do
|
||||
db <- io connectDBus
|
||||
printDeps = withDBus_ $ \db -> do
|
||||
(i, f, d) <- allFeatures db
|
||||
io $
|
||||
mapM_ (putStrLn . T.unpack) $
|
||||
mapM_ (liftIO . putStrLn . T.unpack) $
|
||||
fmap showFulfillment $
|
||||
sort $
|
||||
nub $
|
||||
concat $
|
||||
fmap dumpFeature f ++ fmap dumpSometimes i ++ fmap dumpSometimes d
|
||||
io $ disconnectDBus db
|
||||
|
||||
allFeatures :: DBusState -> FIO ([SometimesIO], [FeatureX], [Sometimes DynWorkspace])
|
||||
allFeatures db = do
|
||||
|
|
|
@ -1,3 +1,4 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
@ -38,13 +39,26 @@ data DBusState = DBusState
|
|||
, dbSysClient :: Maybe SysClient
|
||||
}
|
||||
|
||||
withDBusX_ :: MonadUnliftIO m => (DBusState -> m a) -> m ()
|
||||
withDBusX_
|
||||
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
|
||||
=> (DBusState -> m a)
|
||||
-> m ()
|
||||
withDBusX_ = void . withDBusX
|
||||
|
||||
withDBusX :: MonadUnliftIO m => (DBusState -> m a) -> m (Maybe a)
|
||||
withDBusX
|
||||
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
|
||||
=> (DBusState -> m a)
|
||||
-> m (Maybe a)
|
||||
withDBusX f = withDBus $ \db -> do
|
||||
forM (dbSesClient db) $ \ses -> do
|
||||
bracket_ (requestXMonadName ses) (releaseXMonadName ses) $ f db
|
||||
bracket_ (up ses) (down ses) $ f db
|
||||
where
|
||||
up cl = do
|
||||
logInfo "registering xmonad to DBus"
|
||||
requestXMonadName cl
|
||||
down cl = do
|
||||
logInfo "unregistering xmonad from DBus"
|
||||
releaseXMonadName cl
|
||||
|
||||
withDBus_ :: MonadUnliftIO m => (DBusState -> m a) -> m ()
|
||||
withDBus_ = void . withDBus
|
||||
|
|
Loading…
Reference in New Issue