ADD awkwardly unify path dependencies into dependency module

This commit is contained in:
Nathan Dwarshuis 2021-11-07 18:41:25 -05:00
parent 76c0eb3386
commit 952e10b1a5
7 changed files with 234 additions and 135 deletions

View File

@ -81,8 +81,9 @@ main = do
, childPIDs = [p] , childPIDs = [p]
, childHandles = [h] , childHandles = [h]
} }
(ekbs, missing) <- fmap filterExternal $ evalExternal $ externalBindings bc sc ts ext <- evalExternal $ externalBindings bc sc ts
mapM_ warnMissing missing let ekbs = filterExternal ext
warnMissing $ externalToMissing ext
-- IDK why this is necessary; nothing prior to this line will print if missing -- IDK why this is necessary; nothing prior to this line will print if missing
hFlush stdout hFlush stdout
launch launch
@ -479,18 +480,32 @@ evalExternal = mapM go
evalKeyBinding :: Monad m => KeyBinding (m a) -> m (KeyBinding a) evalKeyBinding :: Monad m => KeyBinding (m a) -> m (KeyBinding a)
evalKeyBinding k@KeyBinding { kbAction = a } = (\b -> k { kbAction = b }) <$> a evalKeyBinding k@KeyBinding { kbAction = a } = (\b -> k { kbAction = b }) <$> a
filterExternal :: [KeyGroup MaybeX] -> ([KeyGroup (X ())], [Dependency]) filterExternal :: [KeyGroup MaybeX] -> [KeyGroup (X ())]
filterExternal kgs = let kgs' = fmap go kgs in (fst <$> kgs', concatMap snd kgs') filterExternal = fmap go
where where
go k@KeyGroup { kgBindings = bs } = let bs' = go' <$> bs in go k@KeyGroup { kgBindings = bs } = k { kgBindings = mapMaybe flagKeyBinding bs }
(k { kgBindings = mapMaybe fst bs' }, concatMap snd bs') -- go k@KeyGroup { kgBindings = bs } =
go' k@KeyBinding{ kbDesc = d, kbAction = a } = case a of -- ( k { kgBindings = mapMaybe flagKeyBinding bs }
Installed x ds -> (Just $ k{ kbAction = x }, ds) -- , concatMap go' bs
Missing ds -> (Just $ k{ kbDesc = flagMissing d, kbAction = skip }, ds) -- )
Ignore -> (Nothing, []) -- go' KeyBinding{ kbAction = a } = case a of
flagMissing s = "[!!!]" ++ s -- Installed _ opt -> opt
-- -- TODO this will mash together the optional and required deps
-- Missing req opt -> req ++ opt
-- Ignore -> []
externalBindings :: Maybe BrightnessControls externalToMissing :: [KeyGroup (MaybeExe a)] -> [MaybeExe a]
externalToMissing = concatMap go
where
go KeyGroup { kgBindings = bs } = fmap kbAction bs
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
externalBindings :: BrightnessControls
-> MaybeExe SSControls -> MaybeExe SSControls
-> ThreadState -> ThreadState
-> [KeyGroup (IO MaybeX)] -> [KeyGroup (IO MaybeX)]
@ -539,10 +554,10 @@ externalBindings bc sc ts =
] ]
, KeyGroup "System" , KeyGroup "System"
[ KeyBinding "M-." "backlight up" $ runMaybe bc bctlInc [ KeyBinding "M-." "backlight up" $ return $ io <$> bctlInc bc
, KeyBinding "M-," "backlight down" $ runMaybe bc bctlDec , KeyBinding "M-," "backlight down" $ return $ io <$> bctlDec bc
, KeyBinding "M-M1-," "backlight min" $ runMaybe bc bctlMin , KeyBinding "M-M1-," "backlight min" $ return $ io <$> bctlMin bc
, KeyBinding "M-M1-." "backlight max" $ runMaybe bc bctlMax , KeyBinding "M-M1-." "backlight max" $ return $ io <$> bctlMax bc
, KeyBinding "M-<End>" "power menu" $ noCheck runPowerPrompt , KeyBinding "M-<End>" "power menu" $ noCheck runPowerPrompt
, KeyBinding "M-<Home>" "quit xmonad" $ noCheck runQuitPrompt , KeyBinding "M-<Home>" "quit xmonad" $ noCheck runQuitPrompt
, KeyBinding "M-<Delete>" "lock screen" runScreenLock , KeyBinding "M-<Delete>" "lock screen" runScreenLock
@ -558,8 +573,8 @@ externalBindings bc sc ts =
, KeyBinding "M-<F12>" "switch gpu" runOptimusPrompt , KeyBinding "M-<F12>" "switch gpu" runOptimusPrompt
] ]
] ]
where -- where
-- TODO this is hacky, I shouldn't really need this data structure for -- TODO this is hacky, I shouldn't really need this data structure for
-- something that doesn't depend on executables -- something that doesn't depend on executables
runMaybe c f = return $ maybe Ignore (\x -> Installed (io $ f x) []) c -- runMaybe c f = return $ maybe Ignore (\x -> Installed (io $ f x) []) c

View File

@ -9,7 +9,7 @@ module XMonad.Internal.DBus.Brightness.Common
, matchSignal , matchSignal
) where ) where
import Control.Monad (void) import Control.Monad (void, when)
import Data.Int (Int32) import Data.Int (Int32)
@ -17,6 +17,7 @@ import DBus
import DBus.Client import DBus.Client
import XMonad.Internal.DBus.Common import XMonad.Internal.DBus.Common
import XMonad.Internal.Dependency
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | External API -- | External API
@ -38,24 +39,26 @@ data BrightnessConfig a b = BrightnessConfig
} }
data BrightnessControls = BrightnessControls data BrightnessControls = BrightnessControls
{ bctlMax :: IO () { bctlMax :: MaybeExe (IO ())
, bctlMin :: IO () , bctlMin :: MaybeExe (IO ())
, bctlInc :: IO () , bctlInc :: MaybeExe (IO ())
, bctlDec :: IO () , bctlDec :: MaybeExe (IO ())
} }
exportBrightnessControls :: RealFrac b => BrightnessConfig a b -> Client exportBrightnessControls :: RealFrac b => [Dependency] -> BrightnessConfig a b
-> IO BrightnessControls -> Client -> IO BrightnessControls
exportBrightnessControls bc client = do exportBrightnessControls deps bc client = do
(req, opt) <- checkInstalled deps
when (null req) $
exportBrightnessControls' bc client exportBrightnessControls' bc client
return $ BrightnessControls return $ BrightnessControls
{ bctlMax = callBacklight' memMax { bctlMax = callBacklight' req opt memMax
, bctlMin = callBacklight' memMin , bctlMin = callBacklight' req opt memMin
, bctlInc = callBacklight' memInc , bctlInc = callBacklight' req opt memInc
, bctlDec = callBacklight' memDec , bctlDec = callBacklight' req opt memDec
} }
where where
callBacklight' = callBacklight bc callBacklight' r o = createInstalled r o . callBacklight bc
callGetBrightness :: Num c => BrightnessConfig a b -> IO (Maybe c) callGetBrightness :: Num c => BrightnessConfig a b -> IO (Maybe c)
callGetBrightness BrightnessConfig { bcPath = p, bcInterface = i } = do callGetBrightness BrightnessConfig { bcPath = p, bcInterface = i } = do

View File

@ -5,11 +5,11 @@ module XMonad.Internal.DBus.Brightness.IntelBacklight
( callGetBrightnessIB ( callGetBrightnessIB
, matchSignalIB , matchSignalIB
, exportIntelBacklight , exportIntelBacklight
, hasBacklight -- , hasBacklight
, blPath , blPath
) where ) where
import Data.Either -- import Data.Either
import Data.Int (Int32) import Data.Int (Int32)
import DBus import DBus
@ -18,6 +18,7 @@ import DBus.Client
import System.FilePath.Posix import System.FilePath.Posix
import XMonad.Internal.DBus.Brightness.Common import XMonad.Internal.DBus.Brightness.Common
import XMonad.Internal.Dependency
import XMonad.Internal.IO import XMonad.Internal.IO
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -64,29 +65,29 @@ decBrightness = decPercent steps curFile
-- Right True -> backlight accessible and present -- Right True -> backlight accessible and present
-- Right False -> backlight not present -- Right False -> backlight not present
-- Left x -> backlight present but could not access (x explaining why) -- Left x -> backlight present but could not access (x explaining why)
hasBacklight' :: IO (Either String Bool) -- hasBacklight' :: IO (Either String Bool)
hasBacklight' = do -- hasBacklight' = do
mx <- isReadable maxFile -- mx <- isReadable maxFile
cx <- isWritable curFile -- cx <- isWritable curFile
return $ case (mx, cx) of -- return $ case (mx, cx) of
(NotFoundError, NotFoundError) -> Right False -- (NotFoundError, NotFoundError) -> Right False
(PermResult True, PermResult True) -> Right True -- (PermResult True, PermResult True) -> Right True
(PermResult _, PermResult _) -> Left "Insufficient permissions for backlight files" -- (PermResult _, PermResult _) -> Left "Insufficient permissions for backlight files"
_ -> Left "Could not determine permissions for backlight files" -- _ -> Left "Could not determine permissions for backlight files"
msg :: Either String Bool -> IO () -- msg :: Either String Bool -> IO ()
msg (Right True) = return () -- msg (Right True) = return ()
msg (Right False) = putStrLn "No backlight detected. Controls disabled" -- msg (Right False) = putStrLn "No backlight detected. Controls disabled"
msg (Left m) = putStrLn $ "WARNING: " ++ m -- msg (Left m) = putStrLn $ "WARNING: " ++ m
hasBacklightMsg :: IO Bool -- hasBacklightMsg :: IO Bool
hasBacklightMsg = do -- hasBacklightMsg = do
b <- hasBacklight' -- b <- hasBacklight'
msg b -- msg b
return $ fromRight False b -- return $ fromRight False b
hasBacklight :: IO Bool -- hasBacklight :: IO Bool
hasBacklight = fromRight False <$> hasBacklight' -- hasBacklight = fromRight False <$> hasBacklight'
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | DBus interface -- | DBus interface
@ -112,12 +113,14 @@ intelBacklightConfig = BrightnessConfig
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | Exported haskell API -- | Exported haskell API
exportIntelBacklight :: Client -> IO (Maybe BrightnessControls) exportIntelBacklight :: Client -> IO BrightnessControls
exportIntelBacklight client = do exportIntelBacklight = exportBrightnessControls deps intelBacklightConfig
b <- hasBacklightMsg where
if b deps = [pathRW curFile, pathR maxFile]
then Just <$> exportBrightnessControls intelBacklightConfig client -- b <- hasBacklightMsg
else return Nothing -- if b
-- then Just <$> exportBrightnessControls intelBacklightConfig client
-- else return Nothing
callGetBrightnessIB :: IO (Maybe Brightness) callGetBrightnessIB :: IO (Maybe Brightness)
callGetBrightnessIB = callGetBrightness intelBacklightConfig callGetBrightnessIB = callGetBrightness intelBacklightConfig

View File

@ -31,29 +31,37 @@ introspectMethod = memberName_ "Introspect"
data DBusXMonad = DBusXMonad data DBusXMonad = DBusXMonad
{ dxClient :: Client { dxClient :: Client
, dxIntelBacklightCtrl :: Maybe BrightnessControls , dxIntelBacklightCtrl :: BrightnessControls
, dxClevoBacklightCtrl :: Maybe BrightnessControls -- , dxClevoBacklightCtrl :: MaybeExe BrightnessControls
, dxScreensaverCtrl :: MaybeExe SSControls , dxScreensaverCtrl :: MaybeExe SSControls
} }
blankControls :: BrightnessControls
blankControls = BrightnessControls
{ bctlMax = Ignore
, bctlMin = Ignore
, bctlInc = Ignore
, bctlDec = Ignore
}
startXMonadService :: IO DBusXMonad startXMonadService :: IO DBusXMonad
startXMonadService = do startXMonadService = do
client <- connectSession client <- connectSession
requestResult <- requestName client xmonadBus [] requestResult <- requestName client xmonadBus []
-- TODO if the client is not released on shutdown the owner will be -- TODO if the client is not released on shutdown the owner will be
-- different -- different
(i, c, s) <- if requestResult /= NamePrimaryOwner then do (i, s) <- if requestResult /= NamePrimaryOwner then do
putStrLn "Another service owns \"org.xmonad\"" putStrLn "Another service owns \"org.xmonad\""
return (Nothing, Nothing, Ignore) return (blankControls, Ignore)
else do else do
putStrLn "Started xmonad dbus client" putStrLn "Started xmonad dbus client"
bc <- exportIntelBacklight client bc <- exportIntelBacklight client
sc <- exportScreensaver client sc <- exportScreensaver client
return (bc, Nothing, sc) return (bc, sc)
return $ DBusXMonad return $ DBusXMonad
{ dxClient = client { dxClient = client
, dxIntelBacklightCtrl = i , dxIntelBacklightCtrl = i
, dxClevoBacklightCtrl = c -- , dxClevoBacklightCtrl = c
, dxScreensaverCtrl = s , dxScreensaverCtrl = s
} }

View File

@ -94,9 +94,9 @@ newtype SSControls = SSControls { ssToggle :: IO () }
exportScreensaver :: Client -> IO (MaybeExe SSControls) exportScreensaver :: Client -> IO (MaybeExe SSControls)
exportScreensaver client = do exportScreensaver client = do
d <- depInstalled dep d <- depInstalled $ depData dep
if d then flip Installed [] <$> exportScreensaver' client if d then flip Installed [] <$> exportScreensaver' client
else return $ Missing [dep] else return $ Missing [depData dep] []
where where
dep = exe "xset" dep = exe "xset"

View File

@ -5,10 +5,16 @@ module XMonad.Internal.Dependency
( MaybeExe(..) ( MaybeExe(..)
, UnitType(..) , UnitType(..)
, Dependency(..) , Dependency(..)
, DependencyData(..)
, MaybeX , MaybeX
, exe , exe
, systemUnit , systemUnit
, userUnit , userUnit
, pathR
, pathW
, pathRW
, checkInstalled
, createInstalled
, runIfInstalled , runIfInstalled
, depInstalled , depInstalled
, warnMissing , warnMissing
@ -29,18 +35,19 @@ module XMonad.Internal.Dependency
, spawnSound , spawnSound
) where ) where
import Control.Monad (filterM) import Control.Arrow ((***))
import Control.Monad (filterM, join)
import Control.Monad.IO.Class import Control.Monad.IO.Class
import Data.List (partition)
import Data.Maybe (isJust) import Data.Maybe (isJust)
-- import System.Directory (findExecutable, readable, writable) import System.Directory (findExecutable, readable, writable)
import System.Directory (findExecutable)
import System.Exit import System.Exit
import System.FilePath import System.FilePath
import XMonad.Core (X, getXMonadDir) import XMonad.Core (X, getXMonadDir)
-- import XMonad.Internal.IO import XMonad.Internal.IO
import XMonad.Internal.Process import XMonad.Internal.Process
import XMonad.Internal.Shell import XMonad.Internal.Shell
@ -49,61 +56,69 @@ import XMonad.Internal.Shell
data UnitType = SystemUnit | UserUnit deriving (Eq, Show) data UnitType = SystemUnit | UserUnit deriving (Eq, Show)
data DependencyType = Executable data DependencyData = Executable String
-- | AccessiblePath FilePath Bool Bool | AccessiblePath FilePath Bool Bool
| Systemd UnitType deriving (Eq, Show) | Systemd UnitType String
deriving (Eq, Show)
data Dependency = Dependency data Dependency = Dependency
{ depRequired :: Bool { depRequired :: Bool
, depName :: String , depData :: DependencyData
, depType :: DependencyType
} }
deriving (Eq, Show) deriving (Eq, Show)
exe :: String -> Dependency exe :: String -> Dependency
exe n = Dependency exe n = Dependency
{ depRequired = True { depRequired = True
, depName = n , depData = Executable n
, depType = Executable
} }
unit :: UnitType -> String -> Dependency unit :: UnitType -> String -> Dependency
unit t n = Dependency unit t n = Dependency
{ depRequired = True { depRequired = True
, depName = n , depData = Systemd t n
, depType = Systemd t
} }
path :: Bool -> Bool -> String -> Dependency
path r w n = Dependency
{ depRequired = True
, depData = AccessiblePath n r w
}
pathR :: String -> Dependency
pathR = path True False
pathW :: String -> Dependency
pathW = path False True
pathRW :: String -> Dependency
pathRW = path True True
systemUnit :: String -> Dependency systemUnit :: String -> Dependency
systemUnit = unit SystemUnit systemUnit = unit SystemUnit
userUnit :: String -> Dependency userUnit :: String -> Dependency
userUnit = unit UserUnit userUnit = unit UserUnit
data MaybeExe a = Installed a [Dependency] | Missing [Dependency] | Ignore -- 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 (Eq, Show)
instance Functor MaybeExe where instance Functor MaybeExe where
fmap f (Installed x ds) = Installed (f x) ds fmap f (Installed x ds) = Installed (f x) ds
fmap _ (Missing x) = Missing x fmap _ (Missing req opt) = Missing req opt
fmap _ Ignore = Ignore fmap _ Ignore = Ignore
type MaybeX = MaybeExe (X ()) type MaybeX = MaybeExe (X ())
warnMissing :: Dependency -> IO ()
warnMissing Dependency {depRequired = r, depName = n, depType = t } =
putStrLn $ "WARNING: " ++ r' ++ " " ++ fmtType t ++ " not found: " ++ n
where
fmtType Executable = "executable"
-- fmtType (AccessiblePath _ _ _) = undefined
fmtType (Systemd UserUnit) = "systemd user unit"
fmtType (Systemd SystemUnit) = "systemd system unit"
r' = if r then "required" else "optional"
exeInstalled :: String -> IO Bool exeInstalled :: String -> IO Bool
exeInstalled x = isJust <$> findExecutable x exeInstalled x = isJust <$> findExecutable x
unitInstalled :: String -> UnitType -> IO Bool unitInstalled :: UnitType -> String -> IO Bool
unitInstalled x u = do unitInstalled u x = do
(rc, _, _) <- readCreateProcessWithExitCode' (shell cmd) "" (rc, _, _) <- readCreateProcessWithExitCode' (shell cmd) ""
return $ case rc of return $ case rc of
ExitSuccess -> True ExitSuccess -> True
@ -112,38 +127,56 @@ unitInstalled x u = do
cmd = fmtCmd "systemctl" $ ["--user" | u == UserUnit] ++ ["status", x] cmd = fmtCmd "systemctl" $ ["--user" | u == UserUnit] ++ ["status", x]
-- pathAccessible :: FilePath -> Bool -> Bool -> IO (Maybe String) -- pathAccessible :: FilePath -> Bool -> Bool -> IO (Maybe String)
-- pathAccessible p testread testwrite = do pathAccessible :: FilePath -> Bool -> Bool -> IO Bool
-- res <- getPermissionsSafe p pathAccessible p testread testwrite = do
-- let msg = permMsg res res <- getPermissionsSafe p
-- return $ fmap (\m -> m ++ ": " ++ p) msg let msg = permMsg res
-- where return msg
-- testPerm False _ _ = Nothing -- return $ fmap (\m -> m ++ ": " ++ p) msg
-- testPerm True f r = Just $ f r where
-- permMsg NotFoundError = Just "file not found" testPerm False _ _ = Nothing
-- permMsg PermError = Just "could not get permissions" testPerm True f r = Just $ f r
-- permMsg (PermResult r) = -- permMsg NotFoundError = Just "file not found"
-- case (testPerm testread readable r, testPerm testwrite writable r) of -- permMsg PermError = Just "could not get permissions"
-- (Just False, Just False) -> Just "file not readable or writable" permMsg NotFoundError = False
-- (Just False, _) -> Just "file not readable" permMsg PermError = False
-- (_, Just False) -> Just "file not writable" permMsg (PermResult r) =
-- _ -> Nothing 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
depInstalled :: Dependency -> IO Bool -- TODO somehow get this to preserve error messages if something isn't found
depInstalled Dependency { depName = n, depType = t } = depInstalled :: DependencyData -> IO Bool
case t of depInstalled (Executable n) = exeInstalled n
Executable -> exeInstalled n depInstalled (Systemd t n) = unitInstalled t n
depInstalled (AccessiblePath p r w) = pathAccessible p r w
-- (AccessiblePath p r w) -> pathAccessible p r w -- (AccessiblePath p r w) -> pathAccessible p r w
Systemd u -> unitInstalled n u
checkInstalled :: [Dependency] -> IO ([DependencyData], [DependencyData])
checkInstalled = fmap go . filterMissing
where
go = join (***) (fmap depData) . partition depRequired
createInstalled :: [DependencyData] -> [DependencyData] -> a -> MaybeExe a
createInstalled req opt x = if null req then Installed x opt else Missing req opt
filterMissing :: [Dependency] -> IO [Dependency] filterMissing :: [Dependency] -> IO [Dependency]
filterMissing = filterM (fmap not . depInstalled) filterMissing = filterM (fmap not . depInstalled . depData)
runIfInstalled :: MonadIO m => [Dependency] -> m () -> IO (MaybeExe (m ())) runIfInstalled :: MonadIO m => [Dependency] -> m a -> IO (MaybeExe (m a))
runIfInstalled ds x = do runIfInstalled ds x = do
missing <- filterMissing ds (req, opt) <- checkInstalled ds
return $ if not $ any depRequired missing return $ createInstalled req opt x
then Installed x $ filter (not . depRequired) missing
else Missing missing
spawnIfInstalled :: MonadIO m => String -> IO (MaybeExe (m ())) spawnIfInstalled :: MonadIO m => String -> IO (MaybeExe (m ()))
spawnIfInstalled n = runIfInstalled [exe n] $ spawn n spawnIfInstalled n = runIfInstalled [exe n] $ spawn n
@ -172,6 +205,42 @@ spawnSound file pre post = runIfInstalled [exe "paplay"]
playSound :: MonadIO m => FilePath -> m () playSound :: MonadIO m => FilePath -> m ()
playSound file = do playSound file = do
path <- (</> soundDir </> file) <$> getXMonadDir p <- (</> soundDir </> file) <$> getXMonadDir
-- paplay seems to have less latency than aplay -- paplay seems to have less latency than aplay
spawnCmd "paplay" [path] 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 = ([], [])
fmtMissing :: DependencyData -> String
-- TODO this error message is lame
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)
warnMissing :: [MaybeExe a] -> IO ()
warnMissing = mapM_ putStrLn . uncurry fmtMsgs . partitionMissing
-- fmtType (AccessiblePath _ _ _) = undefined
-- splitDeps :: [MaybeExe a] -> ([a], [String])
-- splitDeps xs = undefined
-- splitDeps' :: [m (MaybeExe a)] -> ([m a], [String])
-- splitDeps' xs = undefined

View File

@ -17,9 +17,10 @@ module XMonad.Internal.IO
, writePercentMax , writePercentMax
, decPercent , decPercent
, incPercent , incPercent
, isReadable -- , isReadable
, isWritable -- , isWritable
, PermResult(..) , PermResult(..)
, getPermissionsSafe
) where ) where
import Data.Char import Data.Char
@ -99,10 +100,10 @@ decPercent = shiftPercent subtract -- silly (-) operator thingy error
data PermResult a = PermResult a | NotFoundError | PermError data PermResult a = PermResult a | NotFoundError | PermError
deriving (Show, Eq) deriving (Show, Eq)
instance Functor PermResult where -- instance Functor PermResult where
fmap f (PermResult r) = PermResult $ f r -- fmap f (PermResult r) = PermResult $ f r
fmap _ NotFoundError = NotFoundError -- fmap _ NotFoundError = NotFoundError
fmap _ PermError = PermError -- fmap _ PermError = PermError
getPermissionsSafe :: FilePath -> IO (PermResult Permissions) getPermissionsSafe :: FilePath -> IO (PermResult Permissions)
getPermissionsSafe f = do getPermissionsSafe f = do
@ -115,8 +116,8 @@ getPermissionsSafe f = do
-- so the catchall case should never happen -- so the catchall case should never happen
_ -> error "Unknown permission error" _ -> error "Unknown permission error"
isReadable :: FilePath -> IO (PermResult Bool) -- isReadable :: FilePath -> IO (PermResult Bool)
isReadable = fmap (fmap readable) . getPermissionsSafe -- isReadable = fmap (fmap readable) . getPermissionsSafe
isWritable :: FilePath -> IO (PermResult Bool) -- isWritable :: FilePath -> IO (PermResult Bool)
isWritable = fmap (fmap writable) . getPermissionsSafe -- isWritable = fmap (fmap writable) . getPermissionsSafe