Compare commits
2 Commits
a997cac7a3
...
8c20a4668d
Author | SHA1 | Date |
---|---|---|
Nathan Dwarshuis | 8c20a4668d | |
Nathan Dwarshuis | 3b8c6b0f4f |
|
@ -46,14 +46,12 @@ main = getArgs >>= parse
|
|||
parse :: [String] -> IO ()
|
||||
parse [] = run
|
||||
parse ["--deps"] = withCache printDeps
|
||||
parse ["--test"] = void $ withCache . evalConfig =<< connectDBus
|
||||
parse ["--test"] = withCache $ withDBus_ evalConfig
|
||||
parse _ = usage
|
||||
|
||||
run :: IO ()
|
||||
run = withCache $ do
|
||||
db <- connectDBus
|
||||
run = withCache $ withDBus_ $ \db -> do
|
||||
c <- evalConfig db
|
||||
disconnectDBus db
|
||||
liftIO $ do
|
||||
-- this is needed to see any printed messages
|
||||
hFlush stdout
|
||||
|
@ -68,11 +66,13 @@ evalConfig db = do
|
|||
return $ config bf ifs ios cs d
|
||||
|
||||
printDeps :: FIO ()
|
||||
printDeps = do
|
||||
db <- io connectDBus
|
||||
let ps = sort $ nub $ fmap showFulfillment $ concatMap dumpFeature $ allFeatures db
|
||||
io $ mapM_ (putStrLn . T.unpack) ps
|
||||
io $ disconnectDBus db
|
||||
printDeps = withDBus_ $ \db ->
|
||||
mapM_ (liftIO . putStrLn . T.unpack) $
|
||||
sort $
|
||||
nub $
|
||||
fmap showFulfillment $
|
||||
concatMap dumpFeature $
|
||||
allFeatures db
|
||||
|
||||
usage :: IO ()
|
||||
usage =
|
||||
|
|
|
@ -6,6 +6,8 @@
|
|||
module XMonad.Internal.DBus.Control
|
||||
( Client
|
||||
, DBusState (..)
|
||||
, withDBus
|
||||
, withDBus_
|
||||
, connectDBus
|
||||
, connectDBusX
|
||||
, disconnectDBus
|
||||
|
@ -34,6 +36,12 @@ data DBusState = DBusState
|
|||
, dbSysClient :: Maybe SysClient
|
||||
}
|
||||
|
||||
withDBus_ :: MonadUnliftIO m => (DBusState -> m a) -> m ()
|
||||
withDBus_ = void . withDBus
|
||||
|
||||
withDBus :: MonadUnliftIO m => (DBusState -> m a) -> m a
|
||||
withDBus = bracket connectDBus disconnectDBus
|
||||
|
||||
-- | Connect to the DBus
|
||||
connectDBus :: MonadUnliftIO m => m DBusState
|
||||
connectDBus = do
|
||||
|
|
Loading…
Reference in New Issue