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 $ Just x
_ -> return Nothing _ -> return Nothing
vpnPresent :: IO (Maybe Bool) vpnPresent :: IO (Either String Bool)
vpnPresent = do vpnPresent = do
res <- tryIOError $ readProcessWithExitCode "nmcli" args "" res <- tryIOError $ readProcessWithExitCode "nmcli" args ""
-- TODO provide some error messages -- TODO provide some error messages
return $ case res of return $ case res of
(Right (ExitSuccess, out, _)) -> Just $ "vpn" `elem` lines out (Right (ExitSuccess, out, _)) -> Right $ "vpn" `elem` lines out
_ -> Nothing _ -> Left "puke"
where where
args = ["-c", "no", "-t", "-f", "TYPE", "c", "show"] args = ["-c", "no", "-t", "-f", "TYPE", "c", "show"]
@ -285,13 +285,13 @@ rightPlugins :: [IO (MaybeExe CmdSpec)]
rightPlugins = rightPlugins =
[ getWireless [ getWireless
, getEthernet , getEthernet
, getVPN , evalFeature getVPN
, getBt , evalFeature getBt
, getAlsa , evalFeature getAlsa
, getBattery , evalFeature getBattery
, getBl , evalFeature getBl
, nocheck ckCmd , nocheck ckCmd
, getSs , evalFeature getSs
, nocheck lockCmd , nocheck lockCmd
, nocheck dateCmd , nocheck dateCmd
] ]
@ -310,35 +310,54 @@ getEthernet = do
where where
dep = dbusDep True devBus devPath devInterface $ Method_ devGetByIP dep = dbusDep True devBus devPath devInterface $ Method_ devGetByIP
getBattery :: IO (MaybeExe CmdSpec) getBattery :: BarFeature
getBattery = go <$> hasBattery getBattery = Feature
where { ftrAction = batteryCmd
-- TODO refactor this pattern , ftrSilent = False
go True = Installed batteryCmd [] , ftrChildren = [Dependency { depRequired = True, depData = IOTest hasBattery }]
go False = Ignore }
getVPN :: IO (MaybeExe CmdSpec) type BarFeature = Feature CmdSpec (IO ())
getVPN = do
v <- vpnPresent
case v of
(Just True) -> runIfInstalled [dep] vpnCmd
_ -> return Ignore
where
dep = dbusDep True vpnBus vpnPath vpnInterface $ Property_ vpnConnType
getBt :: IO (MaybeExe CmdSpec) getVPN :: BarFeature
getBt = runIfInstalled [dep] btCmd 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 where
dep = dbusDep True btBus btPath btInterface $ Property_ btPowered dep = dbusDep True btBus btPath btInterface $ Property_ btPowered
getAlsa :: IO (MaybeExe CmdSpec) getAlsa :: BarFeature
getAlsa = runIfInstalled [exe "alsactl"] alsaCmd getAlsa = Feature
{ ftrAction = alsaCmd
, ftrSilent = False
, ftrChildren = [exe "alsactl"]
}
getBl :: IO (MaybeExe CmdSpec) getBl :: BarFeature
getBl = runIfInstalled [curFileDep, maxFileDep] blCmd getBl = Feature
{ ftrAction = blCmd
, ftrSilent = False
, ftrChildren = [curFileDep, maxFileDep]
}
getSs :: IO (MaybeExe CmdSpec) getSs :: BarFeature
getSs = runIfInstalled [ssDep] ssCmd getSs = Feature
{ ftrAction = ssCmd
, ftrSilent = False
, ftrChildren = [ssDep]
}
getAllCommands :: [MaybeExe CmdSpec] -> IO BarRegions getAllCommands :: [MaybeExe CmdSpec] -> IO BarRegions
getAllCommands right = do getAllCommands right = do

View File

@ -77,11 +77,12 @@ runQuitPrompt = confirmPrompt T.promptTheme "quit?" $ io exitSuccess
isUsingNvidia :: IO Bool isUsingNvidia :: IO Bool
isUsingNvidia = doesDirectoryExist "/sys/module/nvidia" isUsingNvidia = doesDirectoryExist "/sys/module/nvidia"
hasBattery :: IO Bool hasBattery :: IO (Either String Bool)
hasBattery = do hasBattery = do
ps <- fromRight [] <$> tryIOError (listDirectory syspath) ps <- fromRight [] <$> tryIOError (listDirectory syspath)
ts <- mapM readType ps ts <- mapM readType ps
return $ "Battery\n" `elem` ts -- TODO this is obviously stupid
return $ Right $ "Battery\n" `elem` ts
where where
readType p = fromRight [] <$> tryIOError (readFile $ syspath </> p </> "type") readType p = fromRight [] <$> tryIOError (readFile $ syspath </> p </> "type")
syspath = "/sys/class/power_supply" syspath = "/sys/class/power_supply"

View File

@ -43,6 +43,7 @@ import Control.Arrow ((***))
import Control.Monad (filterM, join) import Control.Monad (filterM, join)
import Control.Monad.IO.Class import Control.Monad.IO.Class
import Data.Either (isRight)
import Data.List (find, partition) import Data.List (find, partition)
import Data.Maybe (fromMaybe, isJust, listToMaybe) import Data.Maybe (fromMaybe, isJust, listToMaybe)
@ -71,7 +72,7 @@ data DBusMember = Method_ MemberName
data DependencyData = Executable String data DependencyData = Executable String
| AccessiblePath FilePath Bool Bool | AccessiblePath FilePath Bool Bool
| IOTest (IO Bool) | IOTest (IO (Either String Bool))
| DBusEndpoint | DBusEndpoint
{ ddDbusBus :: BusName { ddDbusBus :: BusName
, ddDbusSystem :: Bool , 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 -- TODO somehow get this to preserve error messages if something isn't found
depInstalled :: DependencyData -> IO Bool depInstalled :: DependencyData -> IO Bool
depInstalled (Executable n) = exeInstalled n depInstalled (Executable n) = exeInstalled n
depInstalled (IOTest t) = t depInstalled (IOTest t) = isRight <$> t
depInstalled (Systemd t n) = unitInstalled t n depInstalled (Systemd t n) = unitInstalled t n
depInstalled (AccessiblePath p r w) = pathAccessible p r w depInstalled (AccessiblePath p r w) = pathAccessible p r w
depInstalled DBusEndpoint { ddDbusBus = b depInstalled DBusEndpoint { ddDbusBus = b