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 :: FeatureSet -> FIO [Process () () ()]
|
||||||
startChildDaemons fs = catMaybes <$> mapM executeSometimes (fsDaemons fs)
|
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 :: FeatureSet -> ([Process () () ()] -> FIO a) -> FIO a
|
||||||
withChildDaemons fs = bracket (startChildDaemons fs) cleanup
|
withChildDaemons fs = bracket (startChildDaemons fs) cleanup
|
||||||
where
|
where
|
||||||
|
@ -225,17 +218,14 @@ withXmobar = bracket startXmobar cleanup
|
||||||
io $ killNoWait p
|
io $ killNoWait p
|
||||||
|
|
||||||
printDeps :: FIO ()
|
printDeps :: FIO ()
|
||||||
printDeps = do
|
printDeps = withDBus_ $ \db -> do
|
||||||
db <- io connectDBus
|
|
||||||
(i, f, d) <- allFeatures db
|
(i, f, d) <- allFeatures db
|
||||||
io $
|
mapM_ (liftIO . putStrLn . T.unpack) $
|
||||||
mapM_ (putStrLn . T.unpack) $
|
|
||||||
fmap showFulfillment $
|
fmap showFulfillment $
|
||||||
sort $
|
sort $
|
||||||
nub $
|
nub $
|
||||||
concat $
|
concat $
|
||||||
fmap dumpFeature f ++ fmap dumpSometimes i ++ fmap dumpSometimes d
|
fmap dumpFeature f ++ fmap dumpSometimes i ++ fmap dumpSometimes d
|
||||||
io $ disconnectDBus db
|
|
||||||
|
|
||||||
allFeatures :: DBusState -> FIO ([SometimesIO], [FeatureX], [Sometimes DynWorkspace])
|
allFeatures :: DBusState -> FIO ([SometimesIO], [FeatureX], [Sometimes DynWorkspace])
|
||||||
allFeatures db = do
|
allFeatures db = do
|
||||||
|
|
|
@ -1,3 +1,4 @@
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
|
@ -38,13 +39,26 @@ data DBusState = DBusState
|
||||||
, dbSysClient :: Maybe SysClient
|
, 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_ = 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
|
withDBusX f = withDBus $ \db -> do
|
||||||
forM (dbSesClient db) $ \ses -> 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_ :: MonadUnliftIO m => (DBusState -> m a) -> m ()
|
||||||
withDBus_ = void . withDBus
|
withDBus_ = void . withDBus
|
||||||
|
|
Loading…
Reference in New Issue