From b4380695d0deeaeaaa4819870f003e47559cc312 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Mon, 22 Nov 2021 23:26:59 -0500
Subject: [PATCH] ENH print warnings/errors immediately for dependencies

---
 bin/xmobar.hs                     |  9 ++-------
 bin/xmonad.hs                     | 10 ++--------
 lib/XMonad/Internal/Dependency.hs | 32 +++++++++++++++----------------
 3 files changed, 20 insertions(+), 31 deletions(-)

diff --git a/bin/xmobar.hs b/bin/xmobar.hs
index 84858b5..700317c 100644
--- a/bin/xmobar.hs
+++ b/bin/xmobar.hs
@@ -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
diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index 0855d80..d484f93 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -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 =
diff --git a/lib/XMonad/Internal/Dependency.hs b/lib/XMonad/Internal/Dependency.hs
index a698fb4..19d2b6e 100644
--- a/lib/XMonad/Internal/Dependency.hs
+++ b/lib/XMonad/Internal/Dependency.hs
@@ -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]