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