ENH use either for dependency results
This commit is contained in:
parent
0caefb336f
commit
5a97a09623
|
|
@ -234,7 +234,7 @@ dateCmd = CmdSpec
|
|||
|
||||
dbusDep :: Bool -> BusName -> ObjectPath -> InterfaceName -> DBusMember -> Dependency a
|
||||
dbusDep usesys bus obj iface mem =
|
||||
Dependency { depRequired = True, depData = d }
|
||||
Dependency d
|
||||
where
|
||||
d = DBusEndpoint
|
||||
{ ddDbusBus = bus
|
||||
|
|
@ -271,13 +271,13 @@ readInterface f = do
|
|||
return $ Just x
|
||||
_ -> return Nothing
|
||||
|
||||
vpnPresent :: IO (Either String Bool)
|
||||
vpnPresent :: IO (Maybe String)
|
||||
vpnPresent = do
|
||||
res <- tryIOError $ readProcessWithExitCode "nmcli" args ""
|
||||
-- TODO provide some error messages
|
||||
return $ case res of
|
||||
(Right (ExitSuccess, out, _)) -> Right $ "vpn" `elem` lines out
|
||||
_ -> Left "puke"
|
||||
(Right (ExitSuccess, out, _)) -> if "vpn" `elem` lines out then Nothing else Just "vpn not found"
|
||||
_ -> Just "puke"
|
||||
where
|
||||
args = ["-c", "no", "-t", "-f", "TYPE", "c", "show"]
|
||||
|
||||
|
|
@ -296,17 +296,17 @@ rightPlugins =
|
|||
, nocheck dateCmd
|
||||
]
|
||||
where
|
||||
nocheck = return . flip Installed []
|
||||
nocheck = return . Right
|
||||
|
||||
getWireless :: IO (MaybeExe CmdSpec)
|
||||
getWireless = do
|
||||
i <- readInterface isWireless
|
||||
return $ maybe Ignore (flip Installed [] . wirelessCmd) i
|
||||
return $ maybe (Left []) (Right . wirelessCmd) i
|
||||
|
||||
getEthernet :: IO (MaybeExe CmdSpec)
|
||||
getEthernet = do
|
||||
i <- readInterface isEthernet
|
||||
maybe (return Ignore) (runIfInstalled [dep] . ethernetCmd) i
|
||||
maybe (return $ Left []) (runIfInstalled [dep] . ethernetCmd) i
|
||||
where
|
||||
dep = dbusDep True devBus devPath devInterface $ Method_ devGetByIP
|
||||
|
||||
|
|
@ -315,7 +315,7 @@ getBattery = Feature
|
|||
{ ftrAction = batteryCmd
|
||||
, ftrSilent = False
|
||||
, ftrDefault = Nothing
|
||||
, ftrChildren = [Dependency { depRequired = True, depData = IOTest hasBattery }]
|
||||
, ftrChildren = [Dependency $ IOTest hasBattery]
|
||||
}
|
||||
|
||||
type BarFeature = Feature CmdSpec (IO ())
|
||||
|
|
@ -329,7 +329,7 @@ getVPN = Feature
|
|||
}
|
||||
where
|
||||
d = dbusDep True vpnBus vpnPath vpnInterface $ Property_ vpnConnType
|
||||
v = Dependency { depRequired = True, depData = IOTest vpnPresent }
|
||||
v = Dependency $ IOTest vpnPresent
|
||||
|
||||
getBt :: BarFeature
|
||||
getBt = Feature
|
||||
|
|
@ -379,8 +379,8 @@ getAllCommands right = do
|
|||
, brRight = mapMaybe eval right
|
||||
}
|
||||
where
|
||||
eval (Installed x _) = Just x
|
||||
eval _ = Nothing
|
||||
eval (Right x) = Just x
|
||||
eval _ = Nothing
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | various formatting things
|
||||
|
|
|
|||
|
|
@ -500,9 +500,9 @@ externalToMissing = concatMap go
|
|||
|
||||
flagKeyBinding :: KeyBinding MaybeX -> Maybe (KeyBinding (X ()))
|
||||
flagKeyBinding k@KeyBinding{ kbDesc = d, kbAction = a } = case a of
|
||||
Installed x _ -> Just $ k{ kbAction = x }
|
||||
Missing _ _ -> Just $ k{ kbDesc = "[!!!]" ++ d, kbAction = skip }
|
||||
Ignore -> Nothing
|
||||
(Right x) -> Just $ k{ kbAction = x }
|
||||
(Left _) -> Just $ k{ kbDesc = "[!!!]" ++ d, kbAction = skip }
|
||||
-- _ -> Nothing
|
||||
|
||||
externalBindings :: BrightnessControls -> SSControls -> ThreadState
|
||||
-> [KeyGroup (IO MaybeX)]
|
||||
|
|
|
|||
|
|
@ -77,12 +77,12 @@ runQuitPrompt = confirmPrompt T.promptTheme "quit?" $ io exitSuccess
|
|||
isUsingNvidia :: IO Bool
|
||||
isUsingNvidia = doesDirectoryExist "/sys/module/nvidia"
|
||||
|
||||
hasBattery :: IO (Either String Bool)
|
||||
hasBattery :: IO (Maybe String)
|
||||
hasBattery = do
|
||||
ps <- fromRight [] <$> tryIOError (listDirectory syspath)
|
||||
ts <- mapM readType ps
|
||||
-- TODO this is obviously stupid
|
||||
return $ Right $ "Battery\n" `elem` ts
|
||||
return $ if "Battery\n" `elem` ts then Nothing else Just "battery not found"
|
||||
where
|
||||
readType p = fromRight [] <$> tryIOError (readFile $ syspath </> p </> "type")
|
||||
syspath = "/sys/class/power_supply"
|
||||
|
|
|
|||
|
|
@ -33,7 +33,7 @@ memRemoved :: MemberName
|
|||
memRemoved = memberName_ "InterfacesRemoved"
|
||||
|
||||
dbusDep :: MemberName -> Dependency (IO a)
|
||||
dbusDep m = Dependency { depRequired = True, depData = d }
|
||||
dbusDep m = Dependency d
|
||||
where
|
||||
d = DBusEndpoint
|
||||
{ ddDbusBus = bus
|
||||
|
|
|
|||
|
|
@ -46,6 +46,6 @@ initControls client exporter controls = do
|
|||
let x = exporter client
|
||||
e <- evalFeature x
|
||||
case e of
|
||||
(Installed c _) -> c
|
||||
_ -> return ()
|
||||
(Right c) -> c
|
||||
_ -> return ()
|
||||
controls x
|
||||
|
|
|
|||
|
|
@ -21,7 +21,7 @@ import XMonad.Internal.DBus.Brightness.Common
|
|||
import XMonad.Internal.DBus.Brightness.IntelBacklight
|
||||
import XMonad.Internal.DBus.Common
|
||||
import XMonad.Internal.DBus.Screensaver
|
||||
import XMonad.Internal.Dependency
|
||||
-- import XMonad.Internal.Dependency
|
||||
|
||||
introspectInterface :: InterfaceName
|
||||
introspectInterface = interfaceName_ "org.freedesktop.DBus.Introspectable"
|
||||
|
|
@ -38,14 +38,14 @@ data DBusXMonad = DBusXMonad
|
|||
|
||||
blankControls :: BrightnessControls
|
||||
blankControls = BrightnessControls
|
||||
{ bctlMax = Ignore
|
||||
, bctlMin = Ignore
|
||||
, bctlInc = Ignore
|
||||
, bctlDec = Ignore
|
||||
{ bctlMax = Left []
|
||||
, bctlMin = Left []
|
||||
, bctlInc = Left []
|
||||
, bctlDec = Left []
|
||||
}
|
||||
|
||||
blankSSToggle :: SSControls
|
||||
blankSSToggle = SSControls { ssToggle = Ignore }
|
||||
blankSSToggle = SSControls { ssToggle = Left [] }
|
||||
|
||||
startXMonadService :: IO DBusXMonad
|
||||
startXMonadService = do
|
||||
|
|
|
|||
|
|
@ -1,10 +1,8 @@
|
|||
{-# LANGUAGE DeriveTraversable #-}
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Functions for handling dependencies
|
||||
|
||||
module XMonad.Internal.Dependency
|
||||
( MaybeExe(..)
|
||||
( MaybeExe
|
||||
, UnitType(..)
|
||||
, Dependency(..)
|
||||
, DependencyData(..)
|
||||
|
|
@ -18,7 +16,7 @@ module XMonad.Internal.Dependency
|
|||
, pathR
|
||||
, pathW
|
||||
, pathRW
|
||||
, checkInstalled
|
||||
-- , checkInstalled
|
||||
, runIfInstalled
|
||||
, depInstalled
|
||||
, warnMissing
|
||||
|
|
@ -39,13 +37,10 @@ module XMonad.Internal.Dependency
|
|||
, spawnSound
|
||||
) where
|
||||
|
||||
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)
|
||||
import Data.List (find)
|
||||
import Data.Maybe (listToMaybe, maybeToList)
|
||||
|
||||
import DBus
|
||||
import DBus.Client
|
||||
|
|
@ -72,7 +67,7 @@ data DBusMember = Method_ MemberName
|
|||
|
||||
data DependencyData = Executable String
|
||||
| AccessiblePath FilePath Bool Bool
|
||||
| IOTest (IO (Either String Bool))
|
||||
| IOTest (IO (Maybe String))
|
||||
| DBusEndpoint
|
||||
{ ddDbusBus :: BusName
|
||||
, ddDbusSystem :: Bool
|
||||
|
|
@ -83,11 +78,7 @@ data DependencyData = Executable String
|
|||
| Systemd UnitType String
|
||||
|
||||
data Dependency a = SubFeature (Feature a a)
|
||||
| Dependency
|
||||
-- TODO when would this ever be false?
|
||||
{ depRequired :: Bool
|
||||
, depData :: DependencyData
|
||||
}
|
||||
| Dependency DependencyData
|
||||
|
||||
data Feature a b = Feature
|
||||
{ ftrAction :: a
|
||||
|
|
@ -96,39 +87,51 @@ data Feature a b = Feature
|
|||
, ftrChildren :: [Dependency b]
|
||||
} | ConstFeature a
|
||||
|
||||
-- data Chain a = Chain
|
||||
-- { chainAction :: a
|
||||
-- , chainChildren :: [Feature a a]
|
||||
-- , chainCompose :: a -> a -> a
|
||||
-- }
|
||||
|
||||
evalFeature :: Feature a b -> IO (MaybeExe a)
|
||||
evalFeature (ConstFeature x) = return $ Installed x []
|
||||
evalFeature (ConstFeature x) = return $ Right x
|
||||
evalFeature Feature { ftrAction = a, ftrSilent = s, ftrChildren = c } = do
|
||||
c' <- concat <$> mapM go c
|
||||
return $ case foldl groupResult ([], []) c' of
|
||||
([], opt) -> Installed a opt
|
||||
(req, opt) -> if s then Ignore else Missing req opt
|
||||
es <- mapM go c
|
||||
return $ case concat es of
|
||||
[] -> Right a
|
||||
es' -> Left (if s then [] else es')
|
||||
-- return $ case foldl groupResult ([], []) c' of
|
||||
-- ([], opt) -> Installed a opt
|
||||
-- (req, opt) -> if s then Ignore else Missing req opt
|
||||
where
|
||||
go (SubFeature Feature { ftrChildren = cs }) = concat <$> mapM go cs
|
||||
go (SubFeature (ConstFeature _)) = return []
|
||||
go Dependency { depRequired = r, depData = d } = do
|
||||
i <- depInstalled d
|
||||
return [(r, d) | not i ]
|
||||
groupResult (x, y) (True, z) = (z:x, y)
|
||||
groupResult (x, y) (False, z) = (x, z:y)
|
||||
go (Dependency d) = do
|
||||
e <- depInstalled d
|
||||
return $ maybeToList e
|
||||
-- groupResult (x, y) (True, z) = (z:x, y)
|
||||
-- groupResult (x, y) (False, z) = (x, z:y)
|
||||
|
||||
-- evalChain :: Chain a -> IO (MaybeExe a)
|
||||
-- evalChain Chain { chainAction = a, chainChildren = cs , chainCompose = f } =
|
||||
-- flip Installed [] <$> foldM go a cs
|
||||
-- where
|
||||
-- go acc child = do
|
||||
-- c <- evalFeature child
|
||||
-- -- TODO need a way to get error messages out of this for anything
|
||||
-- -- that's missing
|
||||
-- return $ case c of
|
||||
-- (Installed x _) -> f x acc
|
||||
-- _ -> acc
|
||||
|
||||
exe :: String -> Dependency a
|
||||
exe n = Dependency
|
||||
{ depRequired = True
|
||||
, depData = Executable n
|
||||
}
|
||||
exe = Dependency . Executable
|
||||
|
||||
unit :: UnitType -> String -> Dependency a
|
||||
unit t n = Dependency
|
||||
{ depRequired = True
|
||||
, depData = Systemd t n
|
||||
}
|
||||
unit t = Dependency . Systemd t
|
||||
|
||||
path :: Bool -> Bool -> String -> Dependency a
|
||||
path r w n = Dependency
|
||||
{ depRequired = True
|
||||
, depData = AccessiblePath n r w
|
||||
}
|
||||
path r w n = Dependency $ AccessiblePath n r w
|
||||
|
||||
pathR :: String -> Dependency a
|
||||
pathR = path True False
|
||||
|
|
@ -147,32 +150,39 @@ userUnit = unit UserUnit
|
|||
|
||||
-- TODO this is poorly named. This actually represents an action that has
|
||||
-- one or more dependencies (where "action" is not necessarily executing an exe)
|
||||
data MaybeExe a = Installed a [DependencyData]
|
||||
| Missing [DependencyData] [DependencyData]
|
||||
| Ignore
|
||||
deriving (Foldable, Traversable)
|
||||
-- data MaybeExe a = Installed a [DependencyData]
|
||||
-- | Missing [DependencyData] [DependencyData]
|
||||
-- | Ignore
|
||||
-- deriving (Foldable, Traversable)
|
||||
-- data MaybeExe a = MaybeExe (Maybe a) [String]
|
||||
type MaybeExe a = Either [String] a
|
||||
-- deriving (Foldable, Traversable)
|
||||
|
||||
instance Functor MaybeExe where
|
||||
fmap f (Installed x ds) = Installed (f x) ds
|
||||
fmap _ (Missing req opt) = Missing req opt
|
||||
fmap _ Ignore = Ignore
|
||||
-- instance Functor MaybeExe where
|
||||
-- fmap f (MaybeExe x m) = MaybeExe (f <$> x) m
|
||||
|
||||
type MaybeX = MaybeExe (X ())
|
||||
|
||||
exeInstalled :: String -> IO Bool
|
||||
exeInstalled x = isJust <$> findExecutable x
|
||||
exeInstalled :: String -> IO (Maybe String)
|
||||
exeInstalled x = do
|
||||
r <- findExecutable x
|
||||
return $ case r of
|
||||
(Just _) -> Nothing
|
||||
_ -> Just $ "executable '" ++ x ++ "' not found"
|
||||
|
||||
unitInstalled :: UnitType -> String -> IO Bool
|
||||
unitInstalled :: UnitType -> String -> IO (Maybe String)
|
||||
unitInstalled u x = do
|
||||
(rc, _, _) <- readCreateProcessWithExitCode' (shell cmd) ""
|
||||
return $ case rc of
|
||||
ExitSuccess -> True
|
||||
_ -> False
|
||||
ExitSuccess -> Nothing
|
||||
_ -> Just $ "systemd " ++ unitType u ++ " unit '" ++ x ++ "' not found"
|
||||
where
|
||||
cmd = fmtCmd "systemctl" $ ["--user" | u == UserUnit] ++ ["status", x]
|
||||
unitType SystemUnit = "system"
|
||||
unitType UserUnit = "user"
|
||||
|
||||
-- pathAccessible :: FilePath -> Bool -> Bool -> IO (Maybe String)
|
||||
pathAccessible :: FilePath -> Bool -> Bool -> IO Bool
|
||||
pathAccessible :: FilePath -> Bool -> Bool -> IO (Maybe String)
|
||||
pathAccessible p testread testwrite = do
|
||||
res <- getPermissionsSafe p
|
||||
let msg = permMsg res
|
||||
|
|
@ -181,20 +191,20 @@ pathAccessible p testread testwrite = do
|
|||
where
|
||||
testPerm False _ _ = Nothing
|
||||
testPerm True f r = Just $ f r
|
||||
-- permMsg NotFoundError = Just "file not found"
|
||||
-- permMsg PermError = Just "could not get permissions"
|
||||
permMsg NotFoundError = False
|
||||
permMsg PermError = False
|
||||
permMsg NotFoundError = Just "file not found"
|
||||
permMsg PermError = Just "could not get permissions"
|
||||
-- permMsg NotFoundError = False
|
||||
-- permMsg PermError = False
|
||||
permMsg (PermResult r) =
|
||||
case (testPerm testread readable r, testPerm testwrite writable r) of
|
||||
-- (Just False, Just False) -> Just "file not readable or writable"
|
||||
-- (Just False, _) -> Just "file not readable"
|
||||
-- (_, Just False) -> Just "file not writable"
|
||||
-- _ -> Nothing
|
||||
(Just True, Just True) -> True
|
||||
(Just True, Nothing) -> True
|
||||
(Nothing, Just True) -> True
|
||||
_ -> False
|
||||
(Just False, Just False) -> Just "file not readable or writable"
|
||||
(Just False, _) -> Just "file not readable"
|
||||
(_, Just False) -> Just "file not writable"
|
||||
_ -> Nothing
|
||||
-- (Just True, Just True) -> True
|
||||
-- (Just True, Nothing) -> True
|
||||
-- (Nothing, Just True) -> True
|
||||
-- _ -> False
|
||||
-- (Just False, Just False) -> Just "file not readable or writable"
|
||||
-- (Just False, _) -> Just "file not readable"
|
||||
-- (_, Just False) -> Just "file not writable"
|
||||
|
|
@ -207,7 +217,7 @@ introspectMethod :: MemberName
|
|||
introspectMethod = memberName_ "Introspect"
|
||||
|
||||
dbusInstalled :: BusName -> Bool -> ObjectPath -> InterfaceName -> DBusMember
|
||||
-> IO Bool
|
||||
-> IO (Maybe String)
|
||||
dbusInstalled bus usesystem objpath iface mem = do
|
||||
client <- if usesystem then connectSystem else connectSession
|
||||
reply <- call_ client (methodCall objpath introspectInterface introspectMethod)
|
||||
|
|
@ -215,7 +225,10 @@ dbusInstalled bus usesystem objpath iface mem = do
|
|||
let res = findMem =<< I.parseXML objpath =<< fromVariant
|
||||
=<< listToMaybe (methodReturnBody reply)
|
||||
disconnect client
|
||||
return $ fromMaybe False res
|
||||
return $ case res of
|
||||
Just _ -> Nothing
|
||||
_ -> Just "some random dbus interface not found"
|
||||
-- return $ fromMaybe False res
|
||||
where
|
||||
findMem obj = fmap (matchMem mem)
|
||||
$ find (\i -> I.interfaceName i == iface)
|
||||
|
|
@ -224,10 +237,9 @@ dbusInstalled bus usesystem objpath iface mem = do
|
|||
matchMem (Signal_ n) = elem n . fmap I.signalName . I.interfaceSignals
|
||||
matchMem (Property_ n) = elem n . fmap I.propertyName . I.interfaceProperties
|
||||
|
||||
-- TODO somehow get this to preserve error messages if something isn't found
|
||||
depInstalled :: DependencyData -> IO Bool
|
||||
depInstalled :: DependencyData -> IO (Maybe String)
|
||||
depInstalled (Executable n) = exeInstalled n
|
||||
depInstalled (IOTest t) = isRight <$> t
|
||||
depInstalled (IOTest t) = t
|
||||
depInstalled (Systemd t n) = unitInstalled t n
|
||||
depInstalled (AccessiblePath p r w) = pathAccessible p r w
|
||||
depInstalled DBusEndpoint { ddDbusBus = b
|
||||
|
|
@ -237,13 +249,13 @@ depInstalled DBusEndpoint { ddDbusBus = b
|
|||
, ddDbusMember = m
|
||||
} = dbusInstalled b s o i m
|
||||
|
||||
checkInstalled :: [Dependency a] -> IO ([DependencyData], [DependencyData])
|
||||
checkInstalled = fmap go . filterMissing
|
||||
where
|
||||
go = join (***) (fmap depData) . partition depRequired
|
||||
-- checkInstalled :: [Dependency a] -> IO ([DependencyData], [DependencyData])
|
||||
-- checkInstalled = fmap go . filterMissing
|
||||
-- where
|
||||
-- go = join (***) (fmap depData) . partition depRequired
|
||||
|
||||
filterMissing :: [Dependency a] -> IO [Dependency a]
|
||||
filterMissing = filterM (fmap not . depInstalled . depData)
|
||||
-- filterMissing :: [Dependency a] -> IO [Dependency a]
|
||||
-- filterMissing = filterM (fmap not . depInstalled . depData)
|
||||
|
||||
runIfInstalled :: [Dependency a] -> b -> IO (MaybeExe b)
|
||||
runIfInstalled ds x = evalFeature $
|
||||
|
|
@ -264,11 +276,11 @@ whenInstalled :: Monad m => MaybeExe (m ()) -> m ()
|
|||
whenInstalled = flip ifInstalled skip
|
||||
|
||||
ifInstalled :: MaybeExe a -> a -> a
|
||||
ifInstalled (Installed x _) _ = x
|
||||
ifInstalled _ alt = alt
|
||||
ifInstalled (Right x) _ = x
|
||||
ifInstalled _ alt = alt
|
||||
|
||||
noCheck :: Monad m => a () -> m (MaybeExe (a ()))
|
||||
noCheck = return . flip Installed []
|
||||
noCheck = return . Right
|
||||
|
||||
-- not sure what to do with these
|
||||
|
||||
|
|
@ -285,35 +297,39 @@ playSound file = do
|
|||
-- paplay seems to have less latency than aplay
|
||||
spawnCmd "paplay" [p]
|
||||
|
||||
partitionMissing :: [MaybeExe a] -> ([DependencyData], [DependencyData])
|
||||
partitionMissing = foldl (\(a, b) -> ((a++) *** (b++)) . go) ([], [])
|
||||
where
|
||||
go (Installed _ opt) = ([], opt)
|
||||
go (Missing req opt) = (req, opt)
|
||||
go Ignore = ([], [])
|
||||
-- partitionMissing :: [MaybeExe a] -> ([DependencyData], [DependencyData])
|
||||
-- partitionMissing = foldl (\(a, b) -> ((a++) *** (b++)) . go) ([], [])
|
||||
-- where
|
||||
-- go (Installed _ opt) = ([], opt)
|
||||
-- go (Missing req opt) = (req, opt)
|
||||
-- go Ignore = ([], [])
|
||||
|
||||
fmtMissing :: DependencyData -> String
|
||||
-- TODO this error message is lame
|
||||
fmtMissing (IOTest _) = "some random test failed"
|
||||
fmtMissing DBusEndpoint {} = "some random dbus path is missing"
|
||||
fmtMissing (AccessiblePath p True False) = "path '" ++ p ++ "' not readable"
|
||||
fmtMissing (AccessiblePath p False True) = "path '" ++ p ++ "' not writable"
|
||||
fmtMissing (AccessiblePath p True True) = "path '" ++ p ++ "' not readable/writable"
|
||||
fmtMissing (AccessiblePath p _ _) = "path '" ++ p ++ "' not ...something"
|
||||
fmtMissing (Executable n) = "executable '" ++ n ++ "' not found"
|
||||
fmtMissing (Systemd st n) = "systemd " ++ unitType st ++ " unit '"
|
||||
++ n ++ "' not found"
|
||||
where
|
||||
unitType SystemUnit = "system"
|
||||
unitType UserUnit = "user"
|
||||
-- fmtMissing :: DependencyData -> String
|
||||
-- -- TODO this error message is lame
|
||||
-- fmtMissing (IOTest _) = "some random test failed"
|
||||
-- fmtMissing DBusEndpoint {} = "some random dbus path is missing"
|
||||
-- fmtMissing (AccessiblePath p True False) = "path '" ++ p ++ "' not readable"
|
||||
-- fmtMissing (AccessiblePath p False True) = "path '" ++ p ++ "' not writable"
|
||||
-- fmtMissing (AccessiblePath p True True) = "path '" ++ p ++ "' not readable/writable"
|
||||
-- fmtMissing (AccessiblePath p _ _) = "path '" ++ p ++ "' not ...something"
|
||||
-- fmtMissing (Executable n) = "executable '" ++ n ++ "' not found"
|
||||
-- fmtMissing (Systemd st n) = "systemd " ++ unitType st ++ " unit '"
|
||||
-- ++ n ++ "' not found"
|
||||
-- where
|
||||
-- unitType SystemUnit = "system"
|
||||
-- unitType UserUnit = "user"
|
||||
|
||||
fmtMsgs :: [DependencyData] -> [DependencyData] -> [String]
|
||||
fmtMsgs req opt = ("[WARNING] "++)
|
||||
<$> (("[REQUIRED DEP] "++) . fmtMissing <$> req)
|
||||
++ (("[OPTIONAL DEP] "++) . fmtMissing <$> opt)
|
||||
-- fmtMsgs :: [DependencyData] -> [DependencyData] -> [String]
|
||||
-- fmtMsgs req opt = ("[WARNING] "++)
|
||||
-- <$> (("[REQUIRED DEP] "++) . fmtMissing <$> req)
|
||||
-- ++ (("[OPTIONAL DEP] "++) . fmtMissing <$> opt)
|
||||
|
||||
-- warnMsg ::
|
||||
-- warnMsg xs = mapM_ putStrLn
|
||||
-- $ [ "[WARNING] " ++ m | (MaybeExe _ (Just m)) <- xs ]
|
||||
|
||||
warnMissing :: [MaybeExe a] -> IO ()
|
||||
warnMissing = mapM_ putStrLn . uncurry fmtMsgs . partitionMissing
|
||||
warnMissing xs = mapM_ putStrLn $ fmap ("[WARNING] "++) $ concat $ [ m | (Left m) <- xs ]
|
||||
|
||||
-- fmtType (AccessiblePath _ _ _) = undefined
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue