ENH print warnings/errors immediately for dependencies

This commit is contained in:
Nathan Dwarshuis 2021-11-22 23:26:59 -05:00
parent 010b612b93
commit b4380695d0
3 changed files with 20 additions and 31 deletions

View File

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

View File

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

View File

@ -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,7 +204,7 @@ whenSatisfied :: Monad m => MaybeAction (m ()) -> m ()
whenSatisfied = flip ifSatisfied skip
ifSatisfied :: MaybeAction a -> a -> a
ifSatisfied (Right x) _ = x
ifSatisfied (Just x) _ = x
ifSatisfied _ alt = alt
--------------------------------------------------------------------------------
@ -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]