ENH use dbus bracket with xmonad dep print

This commit is contained in:
Nathan Dwarshuis 2022-12-31 22:55:32 -05:00
parent 05f1165cc1
commit fcb454bc29
2 changed files with 24 additions and 20 deletions

View File

@ -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

View File

@ -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