ENH print warnings/errors immediately for dependencies
This commit is contained in:
parent
010b612b93
commit
b4380695d0
|
@ -55,9 +55,7 @@ main :: IO ()
|
|||
main = do
|
||||
sysClient <- getDBusClient True
|
||||
sesClient <- getDBusClient False
|
||||
rs <- rightPlugins sysClient sesClient
|
||||
warnMissing rs
|
||||
cs <- getAllCommands rs
|
||||
cs <- getAllCommands =<< rightPlugins sysClient sesClient
|
||||
d <- getXMonadDir
|
||||
-- this is needed to see any printed messages
|
||||
hFlush stdout
|
||||
|
@ -364,11 +362,8 @@ getAllCommands right = do
|
|||
return $ BarRegions
|
||||
{ brLeft = left
|
||||
, brCenter = []
|
||||
, brRight = mapMaybe eval right
|
||||
, brRight = catMaybes right
|
||||
}
|
||||
where
|
||||
eval (Right x) = Just x
|
||||
eval _ = Nothing
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | various formatting things
|
||||
|
|
|
@ -90,7 +90,6 @@ main = do
|
|||
lockRes <- evalFeature runScreenLock
|
||||
let lock = whenSatisfied lockRes
|
||||
ext <- evalExternal $ externalBindings ts lock
|
||||
warnMissing $ externalToMissing ext
|
||||
-- IDK why this is necessary; nothing prior to this line will print if missing
|
||||
hFlush stdout
|
||||
launch
|
||||
|
@ -497,15 +496,10 @@ filterExternal = fmap go
|
|||
where
|
||||
go k@KeyGroup { kgBindings = bs } = k { kgBindings = mapMaybe flagKeyBinding bs }
|
||||
|
||||
externalToMissing :: [KeyGroup (MaybeAction a)] -> [MaybeAction a]
|
||||
externalToMissing = concatMap go
|
||||
where
|
||||
go KeyGroup { kgBindings = bs } = fmap kbMaybeAction bs
|
||||
|
||||
flagKeyBinding :: KeyBinding MaybeX -> Maybe (KeyBinding (X ()))
|
||||
flagKeyBinding k@KeyBinding{ kbDesc = d, kbMaybeAction = a } = case a of
|
||||
(Right x) -> Just $ k{ kbMaybeAction = x }
|
||||
(Left _) -> Just $ k{ kbDesc = "[!!!]" ++ d, kbMaybeAction = skip }
|
||||
(Just x) -> Just $ k{ kbMaybeAction = x }
|
||||
Nothing -> Just $ k{ kbDesc = "[!!!]" ++ d, kbMaybeAction = skip }
|
||||
|
||||
externalBindings :: ThreadState -> X () -> [KeyGroup FeatureX]
|
||||
externalBindings ts lock =
|
||||
|
|
|
@ -28,7 +28,6 @@ module XMonad.Internal.Dependency
|
|||
, featureExeArgs
|
||||
, featureExe
|
||||
, featureEndpoint
|
||||
, warnMissing
|
||||
, whenSatisfied
|
||||
, ifSatisfied
|
||||
, executeFeature
|
||||
|
@ -41,7 +40,7 @@ module XMonad.Internal.Dependency
|
|||
import Control.Monad.IO.Class
|
||||
import Control.Monad.Identity
|
||||
|
||||
import Data.Bifunctor (bimap, first)
|
||||
import Data.Bifunctor (bimap)
|
||||
import Data.List (find)
|
||||
import Data.Maybe (catMaybes, fromMaybe, listToMaybe)
|
||||
|
||||
|
@ -139,11 +138,11 @@ featureEndpoint busname path iface mem client = Feature
|
|||
-- either the action of the feature or 0 or more error messages that signify
|
||||
-- what dependencies are missing and why.
|
||||
|
||||
type MaybeAction a = Either [String] a
|
||||
type MaybeAction a = Maybe a
|
||||
|
||||
type MaybeX = MaybeAction (X ())
|
||||
|
||||
evalTree :: DepTree a -> IO (MaybeAction a)
|
||||
evalTree :: DepTree a -> IO (Either [String] a)
|
||||
|
||||
evalTree (GenTree action ds) = do
|
||||
es <- catMaybes <$> mapM evalDependency ds
|
||||
|
@ -172,7 +171,7 @@ evalAction (Single a) = return $ Right a
|
|||
evalAction (Double a b) = fmap a <$> b
|
||||
|
||||
evalFeature :: Feature a -> IO (MaybeAction a)
|
||||
evalFeature (ConstFeature x) = return $ Right x
|
||||
evalFeature (ConstFeature x) = return $ Just x
|
||||
evalFeature Feature
|
||||
{ ftrAction = a
|
||||
, ftrName = n
|
||||
|
@ -180,16 +179,17 @@ evalFeature Feature
|
|||
} = do
|
||||
procName <- getProgName
|
||||
res <- evalTree a
|
||||
return $ first (fmtWarnings procName) res
|
||||
either (\es -> printWarnings procName es >> return Nothing) (return . Just) res
|
||||
where
|
||||
fmtWarnings procName es = case w of
|
||||
Silent -> []
|
||||
Default -> fmap (fmtMsg procName "WARNING" . ((n ++ " disabled; ") ++)) es
|
||||
printWarnings procName es = case w of
|
||||
Silent -> return ()
|
||||
Default -> mapM_ putStrLn $ fmap (fmtMsg procName "WARNING" . ((n ++ " disabled; ") ++)) es
|
||||
|
||||
-- TODO this should be 'executeFeatureWith'
|
||||
applyFeature :: MonadIO m => (m a -> m a) -> a -> Feature (IO a) -> m a
|
||||
applyFeature iof def ftr = do
|
||||
a <- io $ evalFeature ftr
|
||||
either (\es -> io $ warnMissing' es >> return def) (iof . io) a
|
||||
maybe (return def) (iof . io) a
|
||||
|
||||
applyFeature_ :: MonadIO m => (m () -> m ()) -> Feature (IO ()) -> m ()
|
||||
applyFeature_ iof = applyFeature iof ()
|
||||
|
@ -204,8 +204,8 @@ whenSatisfied :: Monad m => MaybeAction (m ()) -> m ()
|
|||
whenSatisfied = flip ifSatisfied skip
|
||||
|
||||
ifSatisfied :: MaybeAction a -> a -> a
|
||||
ifSatisfied (Right x) _ = x
|
||||
ifSatisfied _ alt = alt
|
||||
ifSatisfied (Just x) _ = x
|
||||
ifSatisfied _ alt = alt
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Dependencies
|
||||
|
@ -353,11 +353,11 @@ dbusDepSatisfied client (Endpoint busname objpath iface mem) = do
|
|||
--------------------------------------------------------------------------------
|
||||
-- | Logging functions
|
||||
|
||||
warnMissing :: [MaybeAction a] -> IO ()
|
||||
warnMissing xs = warnMissing' $ concat $ [ m | (Left m) <- xs ]
|
||||
-- warnMissing :: [MaybeAction a] -> IO ()
|
||||
-- warnMissing xs = warnMissing' $ concat $ [ m | (Left m) <- xs ]
|
||||
|
||||
warnMissing' :: [String] -> IO ()
|
||||
warnMissing' = mapM_ putStrLn
|
||||
-- warnMissing' :: [String] -> IO ()
|
||||
-- warnMissing' = mapM_ putStrLn
|
||||
|
||||
fmtMsg :: String -> String -> String -> String
|
||||
fmtMsg procName level msg = unwords [bracket procName, bracket level, msg]
|
||||
|
|
Loading…
Reference in New Issue