ENH use Feature in xmobar

This commit is contained in:
Nathan Dwarshuis 2021-11-11 23:25:11 -05:00
parent 77ab59b72c
commit 052937867b
3 changed files with 56 additions and 35 deletions

View File

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

View File

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

View File

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