From 052937867b7a93d5997ab38bc188596ceaeee8d9 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Thu, 11 Nov 2021 23:25:11 -0500
Subject: [PATCH] ENH use Feature in xmobar

---
 bin/xmobar.hs                        | 81 +++++++++++++++++-----------
 lib/XMonad/Internal/Command/Power.hs |  5 +-
 lib/XMonad/Internal/Dependency.hs    |  5 +-
 3 files changed, 56 insertions(+), 35 deletions(-)

diff --git a/bin/xmobar.hs b/bin/xmobar.hs
index 82d3ece..d3793c9 100644
--- a/bin/xmobar.hs
+++ b/bin/xmobar.hs
@@ -271,13 +271,13 @@ readInterface f = do
       return $ Just x
     _     -> return Nothing
 
-vpnPresent :: IO (Maybe Bool)
+vpnPresent :: IO (Either String Bool)
 vpnPresent = do
   res <- tryIOError $ readProcessWithExitCode "nmcli" args ""
   -- TODO provide some error messages
   return $ case res of
-    (Right (ExitSuccess, out, _)) -> Just $ "vpn" `elem` lines out
-    _                             -> Nothing
+    (Right (ExitSuccess, out, _)) -> Right $ "vpn" `elem` lines out
+    _                             -> Left "puke"
   where
     args = ["-c", "no", "-t", "-f", "TYPE", "c", "show"]
 
@@ -285,13 +285,13 @@ rightPlugins :: [IO (MaybeExe CmdSpec)]
 rightPlugins =
   [ getWireless
   , getEthernet
-  , getVPN
-  , getBt
-  , getAlsa
-  , getBattery
-  , getBl
+  , evalFeature getVPN
+  , evalFeature getBt
+  , evalFeature getAlsa
+  , evalFeature getBattery
+  , evalFeature getBl
   , nocheck ckCmd
-  , getSs
+  , evalFeature getSs
   , nocheck lockCmd
   , nocheck dateCmd
   ]
@@ -310,35 +310,54 @@ getEthernet = do
   where
     dep = dbusDep True devBus devPath devInterface $ Method_ devGetByIP
 
-getBattery :: IO (MaybeExe CmdSpec)
-getBattery = go <$> hasBattery
-  where
-    -- TODO refactor this pattern
-    go True  = Installed batteryCmd []
-    go False = Ignore
+getBattery :: BarFeature
+getBattery = Feature
+  { ftrAction = batteryCmd
+  , ftrSilent = False
+  , ftrChildren = [Dependency { depRequired = True, depData = IOTest hasBattery }]
+  }
 
-getVPN :: IO (MaybeExe CmdSpec)
-getVPN = do
-  v <- vpnPresent
-  case v of
-    (Just True) -> runIfInstalled [dep] vpnCmd
-    _           -> return Ignore
-  where
-    dep = dbusDep True vpnBus vpnPath vpnInterface $ Property_ vpnConnType
+type BarFeature = Feature CmdSpec (IO ())
 
-getBt :: IO (MaybeExe CmdSpec)
-getBt = runIfInstalled [dep] btCmd
+getVPN :: BarFeature
+getVPN = Feature
+  { ftrAction = vpnCmd
+  , ftrSilent = False
+  , ftrChildren = [d, v]
+  }
+  where
+    d = dbusDep True vpnBus vpnPath vpnInterface $ Property_ vpnConnType
+    v = Dependency { depRequired = True, depData = IOTest vpnPresent }
+
+getBt :: BarFeature
+getBt = Feature
+  { ftrAction = btCmd
+  , ftrSilent = False
+  , ftrChildren = [dep]
+  }
   where
     dep = dbusDep True btBus btPath btInterface $ Property_ btPowered
 
-getAlsa :: IO (MaybeExe CmdSpec)
-getAlsa = runIfInstalled [exe "alsactl"] alsaCmd
+getAlsa :: BarFeature
+getAlsa = Feature
+  { ftrAction = alsaCmd
+  , ftrSilent = False
+  , ftrChildren = [exe "alsactl"]
+  }
 
-getBl :: IO (MaybeExe CmdSpec)
-getBl = runIfInstalled [curFileDep, maxFileDep] blCmd
+getBl :: BarFeature
+getBl = Feature
+  { ftrAction = blCmd
+  , ftrSilent = False
+  , ftrChildren = [curFileDep, maxFileDep]
+  }
 
-getSs :: IO (MaybeExe CmdSpec)
-getSs = runIfInstalled [ssDep] ssCmd
+getSs :: BarFeature
+getSs = Feature
+  { ftrAction = ssCmd
+  , ftrSilent = False
+  , ftrChildren = [ssDep]
+  }
 
 getAllCommands :: [MaybeExe CmdSpec] -> IO BarRegions
 getAllCommands right = do
diff --git a/lib/XMonad/Internal/Command/Power.hs b/lib/XMonad/Internal/Command/Power.hs
index 9b8235a..ba5f63a 100644
--- a/lib/XMonad/Internal/Command/Power.hs
+++ b/lib/XMonad/Internal/Command/Power.hs
@@ -77,11 +77,12 @@ runQuitPrompt = confirmPrompt T.promptTheme "quit?" $ io exitSuccess
 isUsingNvidia :: IO Bool
 isUsingNvidia = doesDirectoryExist "/sys/module/nvidia"
 
-hasBattery :: IO Bool
+hasBattery :: IO (Either String Bool)
 hasBattery = do
   ps <- fromRight [] <$> tryIOError (listDirectory syspath)
   ts <- mapM readType ps
-  return $ "Battery\n" `elem` ts
+  -- TODO this is obviously stupid
+  return $ Right $ "Battery\n" `elem` ts
   where
     readType p = fromRight [] <$> tryIOError (readFile $ syspath </> p </> "type")
     syspath = "/sys/class/power_supply"
diff --git a/lib/XMonad/Internal/Dependency.hs b/lib/XMonad/Internal/Dependency.hs
index d449a8f..1babb77 100644
--- a/lib/XMonad/Internal/Dependency.hs
+++ b/lib/XMonad/Internal/Dependency.hs
@@ -43,6 +43,7 @@ import           Control.Arrow           ((***))
 import           Control.Monad           (filterM, join)
 import           Control.Monad.IO.Class
 
+import           Data.Either             (isRight)
 import           Data.List               (find, partition)
 import           Data.Maybe              (fromMaybe, isJust, listToMaybe)
 
@@ -71,7 +72,7 @@ data DBusMember = Method_ MemberName
 
 data DependencyData = Executable String
   | AccessiblePath FilePath Bool Bool
-  | IOTest (IO Bool)
+  | IOTest (IO (Either String Bool))
   | DBusEndpoint
     { ddDbusBus       :: BusName
     , ddDbusSystem    :: Bool
@@ -227,7 +228,7 @@ dbusInstalled bus usesystem objpath iface mem = do
 -- TODO somehow get this to preserve error messages if something isn't found
 depInstalled :: DependencyData -> IO Bool
 depInstalled (Executable n)         = exeInstalled n
-depInstalled (IOTest t)             = t
+depInstalled (IOTest t)             = isRight <$> t
 depInstalled (Systemd t n)          = unitInstalled t n
 depInstalled (AccessiblePath p r w) = pathAccessible p r w
 depInstalled DBusEndpoint { ddDbusBus = b