2021-11-21 22:47:43 -05:00
|
|
|
{-# LANGUAGE GADTs #-}
|
|
|
|
{-# LANGUAGE RecordWildCards #-}
|
|
|
|
|
2021-11-07 13:35:08 -05:00
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
-- | Functions for handling dependencies
|
|
|
|
|
|
|
|
module XMonad.Internal.Dependency
|
2021-11-21 10:26:28 -05:00
|
|
|
( MaybeAction
|
2021-11-07 13:35:08 -05:00
|
|
|
, MaybeX
|
2021-11-21 23:32:10 -05:00
|
|
|
, Action(..)
|
2021-11-20 01:15:04 -05:00
|
|
|
, FeatureX
|
|
|
|
, FeatureIO
|
2021-11-11 00:11:15 -05:00
|
|
|
, Feature(..)
|
2021-11-21 10:26:28 -05:00
|
|
|
, Warning(..)
|
|
|
|
, Dependency(..)
|
|
|
|
, UnitType(..)
|
|
|
|
, Endpoint(..)
|
|
|
|
, DBusMember(..)
|
2021-11-20 01:15:04 -05:00
|
|
|
, ioFeature
|
2021-11-11 00:11:15 -05:00
|
|
|
, evalFeature
|
2021-11-07 13:35:08 -05:00
|
|
|
, systemUnit
|
|
|
|
, userUnit
|
2021-11-07 18:41:25 -05:00
|
|
|
, pathR
|
|
|
|
, pathW
|
|
|
|
, pathRW
|
2021-11-21 10:26:28 -05:00
|
|
|
, featureDefault
|
|
|
|
, featureExeArgs
|
|
|
|
, featureExe
|
2021-11-21 18:18:09 -05:00
|
|
|
, featureEndpoint
|
2021-11-07 13:35:08 -05:00
|
|
|
, warnMissing
|
2021-11-21 10:26:28 -05:00
|
|
|
, whenSatisfied
|
|
|
|
, ifSatisfied
|
2021-11-20 15:20:22 -05:00
|
|
|
, executeFeature
|
|
|
|
, executeFeature_
|
|
|
|
, applyFeature
|
|
|
|
, applyFeature_
|
2021-11-21 16:58:01 -05:00
|
|
|
, callMethod
|
2021-11-07 13:35:08 -05:00
|
|
|
) where
|
|
|
|
|
2021-11-21 18:18:09 -05:00
|
|
|
import Control.Monad (void)
|
2021-11-07 13:35:08 -05:00
|
|
|
import Control.Monad.IO.Class
|
|
|
|
|
2021-11-21 22:47:43 -05:00
|
|
|
import Data.Bifunctor (bimap, first, second)
|
2021-11-19 00:35:54 -05:00
|
|
|
import Data.List (find)
|
2021-11-20 19:35:24 -05:00
|
|
|
import Data.Maybe (catMaybes, fromMaybe, listToMaybe)
|
2021-11-07 20:16:53 -05:00
|
|
|
|
|
|
|
import DBus
|
|
|
|
import DBus.Client
|
2021-11-08 00:27:39 -05:00
|
|
|
import qualified DBus.Introspection as I
|
2021-11-07 13:35:08 -05:00
|
|
|
|
2021-11-07 18:41:25 -05:00
|
|
|
import System.Directory (findExecutable, readable, writable)
|
2021-11-20 19:35:24 -05:00
|
|
|
import System.Environment
|
2021-11-07 13:35:08 -05:00
|
|
|
import System.Exit
|
|
|
|
|
2021-11-20 15:20:22 -05:00
|
|
|
import XMonad.Core (X, io)
|
2021-11-07 18:41:25 -05:00
|
|
|
import XMonad.Internal.IO
|
2021-11-07 13:35:08 -05:00
|
|
|
import XMonad.Internal.Process
|
|
|
|
import XMonad.Internal.Shell
|
|
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
2021-11-21 10:26:28 -05:00
|
|
|
-- | Features
|
|
|
|
--
|
|
|
|
-- A 'feature' is an 'action' (usually an IO ()) that requires one or more
|
|
|
|
-- 'dependencies'. Features also have a useful name and an error logging
|
|
|
|
-- protocol.
|
|
|
|
--
|
|
|
|
-- NOTE: there is no way to make a feature depend on another feature. This is
|
|
|
|
-- very complicated to implement and would only be applicable to a few instances
|
|
|
|
-- (notable the dbus interfaces). In order to implement a dependency tree, use
|
|
|
|
-- dependencies that target the output/state of another feature; this is more
|
|
|
|
-- robust anyways, at the cost of being a bit slower.
|
2021-11-20 19:35:24 -05:00
|
|
|
|
2021-11-21 23:32:10 -05:00
|
|
|
data Feature a = Feature
|
2021-11-21 23:56:27 -05:00
|
|
|
{ ftrAction :: Action a
|
2021-11-21 10:26:28 -05:00
|
|
|
, ftrName :: String
|
|
|
|
, ftrWarning :: Warning
|
2021-11-20 01:15:04 -05:00
|
|
|
}
|
|
|
|
| ConstFeature a
|
2021-11-21 22:47:43 -05:00
|
|
|
|
2021-11-21 23:32:10 -05:00
|
|
|
data Action a = Parent a [Dependency]
|
|
|
|
| forall b. Chain (b -> a) (IO (Either [String] b))
|
2021-11-21 23:59:38 -05:00
|
|
|
| DBusEndpoint (Client -> a) (Maybe Client) [Endpoint] [Dependency]
|
|
|
|
| DBusBus (Client -> a) BusName (Maybe Client) [Dependency]
|
2021-11-21 22:47:43 -05:00
|
|
|
|
2021-11-21 23:32:10 -05:00
|
|
|
instance Functor Action where
|
2021-11-21 23:55:19 -05:00
|
|
|
fmap f (Parent a ds) = Parent (f a) ds
|
|
|
|
fmap f (Chain a b) = Chain (f . a) b
|
2021-11-21 23:59:38 -05:00
|
|
|
fmap f (DBusEndpoint a c es ds) = DBusEndpoint (f . a) c es ds
|
|
|
|
fmap f (DBusBus a b c eps) = DBusBus (f . a) b c eps
|
2021-11-20 01:15:04 -05:00
|
|
|
|
2021-11-21 10:26:28 -05:00
|
|
|
-- TODO this is silly as is, and could be made more useful by representing
|
|
|
|
-- loglevels
|
|
|
|
data Warning = Silent | Default
|
|
|
|
|
2021-11-20 11:48:05 -05:00
|
|
|
type FeatureX = Feature (X ())
|
2021-11-11 00:11:15 -05:00
|
|
|
|
2021-11-20 11:48:05 -05:00
|
|
|
type FeatureIO = Feature (IO ())
|
2021-11-20 01:15:04 -05:00
|
|
|
|
2021-11-21 22:47:43 -05:00
|
|
|
ioFeature :: MonadIO m => Feature (IO b) -> Feature (m b)
|
|
|
|
ioFeature (ConstFeature a) = ConstFeature $ liftIO a
|
|
|
|
ioFeature Feature {..} =
|
|
|
|
-- HACK just doing a normal record update here will make GHC complain about
|
|
|
|
-- an 'insufficiently polymorphic record update' ...I guess because my
|
|
|
|
-- GADT isn't polymorphic enough (which is obviously BS)
|
2021-11-21 23:56:27 -05:00
|
|
|
Feature {ftrAction = liftIO <$> ftrAction, ..}
|
2021-11-21 10:26:28 -05:00
|
|
|
|
|
|
|
featureDefault :: String -> [Dependency] -> a -> Feature a
|
|
|
|
featureDefault n ds x = Feature
|
2021-11-21 23:56:27 -05:00
|
|
|
{ ftrAction = Parent x ds
|
2021-11-21 10:26:28 -05:00
|
|
|
, ftrName = n
|
|
|
|
, ftrWarning = Default
|
|
|
|
}
|
|
|
|
|
|
|
|
featureExe :: MonadIO m => String -> String -> Feature (m ())
|
|
|
|
featureExe n cmd = featureExeArgs n cmd []
|
|
|
|
|
|
|
|
featureExeArgs :: MonadIO m => String -> String -> [String] -> Feature (m ())
|
|
|
|
featureExeArgs n cmd args =
|
|
|
|
featureDefault n [Executable cmd] $ spawnCmd cmd args
|
|
|
|
|
2021-11-21 18:18:09 -05:00
|
|
|
featureEndpoint :: BusName -> ObjectPath -> InterfaceName -> MemberName
|
2021-11-21 22:47:43 -05:00
|
|
|
-> Maybe Client -> FeatureIO
|
2021-11-21 18:18:09 -05:00
|
|
|
featureEndpoint busname path iface mem client = Feature
|
2021-11-21 23:59:38 -05:00
|
|
|
{ ftrAction = DBusEndpoint cmd client deps []
|
2021-11-21 18:18:09 -05:00
|
|
|
, ftrName = "screensaver toggle"
|
|
|
|
, ftrWarning = Default
|
|
|
|
}
|
|
|
|
where
|
2021-11-21 22:47:43 -05:00
|
|
|
cmd = \c -> void $ callMethod c busname path iface mem
|
2021-11-21 23:55:19 -05:00
|
|
|
deps = [Endpoint busname path iface $ Method_ mem]
|
2021-11-21 18:18:09 -05:00
|
|
|
|
2021-11-21 10:26:28 -05:00
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
-- | Feature evaluation
|
|
|
|
--
|
|
|
|
-- Evaluate a feature by testing if its dependencies are satisfied, and return
|
|
|
|
-- either the action of the feature or 0 or more error messages that signify
|
|
|
|
-- what dependencies are missing and why.
|
|
|
|
|
|
|
|
type MaybeAction a = Either [String] a
|
2021-11-19 00:35:54 -05:00
|
|
|
|
2021-11-21 10:26:28 -05:00
|
|
|
type MaybeX = MaybeAction (X ())
|
|
|
|
|
2021-11-21 23:32:10 -05:00
|
|
|
evalAction :: Action a -> IO (MaybeAction a)
|
|
|
|
|
|
|
|
evalAction (Parent a ds) = do
|
|
|
|
es <- catMaybes <$> mapM evalDependency ds
|
|
|
|
return $ case es of
|
|
|
|
[] -> Right a
|
|
|
|
es' -> Left es'
|
|
|
|
|
|
|
|
evalAction (Chain a b) = second a <$> b
|
|
|
|
|
2021-11-21 23:59:38 -05:00
|
|
|
evalAction (DBusEndpoint _ Nothing _ _) = return $ Left ["client not available"]
|
|
|
|
evalAction (DBusEndpoint action (Just client) es ds) = do
|
2021-11-21 23:55:19 -05:00
|
|
|
eperrors <- mapM (endpointSatisfied client) es
|
2021-11-21 23:32:10 -05:00
|
|
|
dperrors <- mapM evalDependency ds
|
|
|
|
return $ case catMaybes (eperrors ++ dperrors) of
|
|
|
|
[] -> Right $ action client
|
|
|
|
es' -> Left es'
|
|
|
|
|
2021-11-21 23:59:38 -05:00
|
|
|
evalAction (DBusBus _ _ Nothing _) = return $ Left ["client not available"]
|
|
|
|
evalAction (DBusBus action busname (Just client) deps) = do
|
2021-11-21 23:32:10 -05:00
|
|
|
res <- busSatisfied client busname
|
|
|
|
es <- catMaybes . (res:) <$> mapM evalDependency deps
|
|
|
|
return $ case es of
|
|
|
|
[] -> Right $ action client
|
|
|
|
es' -> Left es'
|
|
|
|
|
2021-11-21 10:26:28 -05:00
|
|
|
evalFeature :: Feature a -> IO (MaybeAction a)
|
2021-11-19 00:35:54 -05:00
|
|
|
evalFeature (ConstFeature x) = return $ Right x
|
2021-11-20 19:35:24 -05:00
|
|
|
evalFeature Feature
|
2021-11-21 23:56:27 -05:00
|
|
|
{ ftrAction = a
|
2021-11-20 19:35:24 -05:00
|
|
|
, ftrName = n
|
|
|
|
, ftrWarning = w
|
|
|
|
} = do
|
|
|
|
procName <- getProgName
|
2021-11-21 23:32:10 -05:00
|
|
|
res <- evalAction a
|
2021-11-21 22:47:43 -05:00
|
|
|
return $ first (fmtWarnings procName) res
|
2021-11-11 00:11:15 -05:00
|
|
|
where
|
2021-11-20 19:35:24 -05:00
|
|
|
fmtWarnings procName es = case w of
|
|
|
|
Silent -> []
|
|
|
|
Default -> fmap (fmtMsg procName "WARNING" . ((n ++ " disabled; ") ++)) es
|
2021-11-07 18:41:25 -05:00
|
|
|
|
2021-11-21 10:26:28 -05:00
|
|
|
applyFeature :: MonadIO m => (m a -> m a) -> a -> Feature (IO a) -> m a
|
|
|
|
applyFeature iof def ftr = do
|
|
|
|
a <- io $ evalFeature ftr
|
|
|
|
either (\es -> io $ warnMissing' es >> return def) (iof . io) a
|
|
|
|
|
|
|
|
applyFeature_ :: MonadIO m => (m () -> m ()) -> Feature (IO ()) -> m ()
|
|
|
|
applyFeature_ iof = applyFeature iof ()
|
|
|
|
|
|
|
|
executeFeature :: MonadIO m => a -> Feature (IO a) -> m a
|
|
|
|
executeFeature = applyFeature id
|
|
|
|
|
|
|
|
executeFeature_ :: Feature (IO ()) -> IO ()
|
|
|
|
executeFeature_ = executeFeature ()
|
|
|
|
|
|
|
|
whenSatisfied :: Monad m => MaybeAction (m ()) -> m ()
|
|
|
|
whenSatisfied = flip ifSatisfied skip
|
|
|
|
|
|
|
|
ifSatisfied :: MaybeAction a -> a -> a
|
|
|
|
ifSatisfied (Right x) _ = x
|
|
|
|
ifSatisfied _ alt = alt
|
|
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
-- | Dependencies
|
|
|
|
|
|
|
|
data Dependency = Executable String
|
|
|
|
| AccessiblePath FilePath Bool Bool
|
|
|
|
| IOTest (IO (Maybe String))
|
|
|
|
| Systemd UnitType String
|
|
|
|
|
|
|
|
data UnitType = SystemUnit | UserUnit deriving (Eq, Show)
|
|
|
|
|
|
|
|
data DBusMember = Method_ MemberName
|
|
|
|
| Signal_ MemberName
|
|
|
|
| Property_ String
|
|
|
|
deriving (Eq, Show)
|
|
|
|
|
2021-11-21 23:55:19 -05:00
|
|
|
data Endpoint = Endpoint BusName ObjectPath InterfaceName DBusMember deriving (Eq, Show)
|
2021-11-21 10:26:28 -05:00
|
|
|
|
2021-11-20 11:48:05 -05:00
|
|
|
pathR :: String -> Dependency
|
2021-11-20 12:40:53 -05:00
|
|
|
pathR n = AccessiblePath n True False
|
2021-11-07 18:41:25 -05:00
|
|
|
|
2021-11-20 11:48:05 -05:00
|
|
|
pathW :: String -> Dependency
|
2021-11-20 12:40:53 -05:00
|
|
|
pathW n = AccessiblePath n False True
|
2021-11-07 18:41:25 -05:00
|
|
|
|
2021-11-20 11:48:05 -05:00
|
|
|
pathRW :: String -> Dependency
|
2021-11-20 12:40:53 -05:00
|
|
|
pathRW n = AccessiblePath n True True
|
2021-11-07 18:41:25 -05:00
|
|
|
|
2021-11-20 11:48:05 -05:00
|
|
|
systemUnit :: String -> Dependency
|
|
|
|
systemUnit = Systemd SystemUnit
|
2021-11-07 13:35:08 -05:00
|
|
|
|
2021-11-20 11:48:05 -05:00
|
|
|
userUnit :: String -> Dependency
|
|
|
|
userUnit = Systemd UserUnit
|
2021-11-07 13:35:08 -05:00
|
|
|
|
2021-11-21 10:26:28 -05:00
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
-- | Dependency evaluation
|
|
|
|
--
|
|
|
|
-- Test the existence of dependencies and return either Nothing (which actually
|
|
|
|
-- means success) or Just <error message>.
|
2021-11-20 01:15:04 -05:00
|
|
|
|
2021-11-21 10:26:28 -05:00
|
|
|
evalDependency :: Dependency -> IO (Maybe String)
|
|
|
|
evalDependency (Executable n) = exeSatisfied n
|
|
|
|
evalDependency (IOTest t) = t
|
|
|
|
evalDependency (Systemd t n) = unitSatisfied t n
|
|
|
|
evalDependency (AccessiblePath p r w) = pathSatisfied p r w
|
2021-11-20 01:15:04 -05:00
|
|
|
|
2021-11-21 10:26:28 -05:00
|
|
|
exeSatisfied :: String -> IO (Maybe String)
|
|
|
|
exeSatisfied x = do
|
2021-11-19 00:35:54 -05:00
|
|
|
r <- findExecutable x
|
|
|
|
return $ case r of
|
|
|
|
(Just _) -> Nothing
|
|
|
|
_ -> Just $ "executable '" ++ x ++ "' not found"
|
2021-11-07 13:35:08 -05:00
|
|
|
|
2021-11-21 10:26:28 -05:00
|
|
|
unitSatisfied :: UnitType -> String -> IO (Maybe String)
|
|
|
|
unitSatisfied u x = do
|
2021-11-07 13:35:08 -05:00
|
|
|
(rc, _, _) <- readCreateProcessWithExitCode' (shell cmd) ""
|
|
|
|
return $ case rc of
|
2021-11-19 00:35:54 -05:00
|
|
|
ExitSuccess -> Nothing
|
|
|
|
_ -> Just $ "systemd " ++ unitType u ++ " unit '" ++ x ++ "' not found"
|
2021-11-07 13:35:08 -05:00
|
|
|
where
|
|
|
|
cmd = fmtCmd "systemctl" $ ["--user" | u == UserUnit] ++ ["status", x]
|
2021-11-19 00:35:54 -05:00
|
|
|
unitType SystemUnit = "system"
|
|
|
|
unitType UserUnit = "user"
|
2021-11-07 13:35:08 -05:00
|
|
|
|
2021-11-21 10:26:28 -05:00
|
|
|
pathSatisfied :: FilePath -> Bool -> Bool -> IO (Maybe String)
|
|
|
|
pathSatisfied p testread testwrite = do
|
2021-11-07 18:41:25 -05:00
|
|
|
res <- getPermissionsSafe p
|
|
|
|
let msg = permMsg res
|
|
|
|
return msg
|
|
|
|
where
|
|
|
|
testPerm False _ _ = Nothing
|
|
|
|
testPerm True f r = Just $ f r
|
2021-11-19 00:35:54 -05:00
|
|
|
permMsg NotFoundError = Just "file not found"
|
|
|
|
permMsg PermError = Just "could not get permissions"
|
2021-11-07 18:41:25 -05:00
|
|
|
permMsg (PermResult r) =
|
|
|
|
case (testPerm testread readable r, testPerm testwrite writable r) of
|
2021-11-19 00:35:54 -05:00
|
|
|
(Just False, Just False) -> Just "file not readable or writable"
|
|
|
|
(Just False, _) -> Just "file not readable"
|
|
|
|
(_, Just False) -> Just "file not writable"
|
|
|
|
_ -> Nothing
|
2021-11-07 18:41:25 -05:00
|
|
|
|
2021-11-08 00:27:39 -05:00
|
|
|
introspectInterface :: InterfaceName
|
|
|
|
introspectInterface = interfaceName_ "org.freedesktop.DBus.Introspectable"
|
|
|
|
|
|
|
|
introspectMethod :: MemberName
|
|
|
|
introspectMethod = memberName_ "Introspect"
|
|
|
|
|
2021-11-21 16:58:01 -05:00
|
|
|
-- TODO this belongs somewhere else, IDK where tho for now
|
2021-11-21 17:54:00 -05:00
|
|
|
callMethod :: Client -> BusName -> ObjectPath -> InterfaceName -> MemberName
|
|
|
|
-> IO (Either String [Variant])
|
|
|
|
callMethod client bus path iface mem = do
|
2021-11-20 19:35:24 -05:00
|
|
|
reply <- call client (methodCall path iface mem)
|
2021-11-08 00:27:39 -05:00
|
|
|
{ methodCallDestination = Just bus }
|
2021-11-20 19:35:24 -05:00
|
|
|
return $ bimap methodErrorMessage methodReturnBody reply
|
|
|
|
|
2021-11-21 22:47:43 -05:00
|
|
|
busSatisfied :: Client -> BusName -> IO (Maybe String)
|
|
|
|
busSatisfied client bus = do
|
|
|
|
-- client <- if usesystem then connectSystem else connectSession
|
2021-11-21 17:54:00 -05:00
|
|
|
ret <- callMethod client queryBus queryPath queryIface queryMem
|
2021-11-21 22:47:43 -05:00
|
|
|
-- disconnect client
|
2021-11-20 19:35:24 -05:00
|
|
|
return $ case ret of
|
|
|
|
Left e -> Just e
|
|
|
|
Right b -> let ns = bodyGetNames b in
|
|
|
|
if bus' `elem` ns then Nothing
|
|
|
|
else Just $ unwords ["name", singleQuote bus', "not found on dbus"]
|
2021-11-07 20:16:53 -05:00
|
|
|
where
|
2021-11-20 19:35:24 -05:00
|
|
|
bus' = formatBusName bus
|
|
|
|
queryBus = busName_ "org.freedesktop.DBus"
|
|
|
|
queryIface = interfaceName_ "org.freedesktop.DBus"
|
|
|
|
queryPath = objectPath_ "/"
|
|
|
|
queryMem = memberName_ "ListNames"
|
|
|
|
bodyGetNames [v] = fromMaybe [] $ fromVariant v :: [String]
|
|
|
|
bodyGetNames _ = []
|
|
|
|
|
2021-11-21 23:55:19 -05:00
|
|
|
endpointSatisfied :: Client -> Endpoint -> IO (Maybe String)
|
|
|
|
endpointSatisfied client (Endpoint busname objpath iface mem) = do
|
2021-11-21 22:47:43 -05:00
|
|
|
-- client <- if u then connectSystem else connectSession
|
|
|
|
ret <- callMethod client busname objpath introspectInterface introspectMethod
|
|
|
|
-- disconnect client
|
2021-11-20 19:35:24 -05:00
|
|
|
return $ case ret of
|
|
|
|
Left e -> Just e
|
|
|
|
Right body -> procBody body
|
|
|
|
where
|
|
|
|
procBody body = let res = findMem =<< I.parseXML objpath =<< fromVariant
|
|
|
|
=<< listToMaybe body in
|
|
|
|
case res of
|
|
|
|
Just True -> Nothing
|
|
|
|
_ -> Just $ fmtMsg' mem
|
|
|
|
findMem = fmap (matchMem mem)
|
|
|
|
. find (\i -> I.interfaceName i == iface)
|
|
|
|
. I.objectInterfaces
|
|
|
|
matchMem (Method_ n) = elemMember n I.methodName I.interfaceMethods
|
|
|
|
matchMem (Signal_ n) = elemMember n I.signalName I.interfaceSignals
|
|
|
|
matchMem (Property_ n) = elemMember n I.propertyName I.interfaceProperties
|
|
|
|
elemMember n fname fmember = elem n . fmap fname . fmember
|
|
|
|
fmtMem (Method_ n) = "method " ++ singleQuote (formatMemberName n)
|
|
|
|
fmtMem (Signal_ n) = "signal " ++ singleQuote (formatMemberName n)
|
|
|
|
fmtMem (Property_ n) = "property " ++ singleQuote n
|
|
|
|
fmtMsg' m = unwords
|
|
|
|
[ "could not find"
|
|
|
|
, fmtMem m
|
|
|
|
, "on interface"
|
|
|
|
, singleQuote $ formatInterfaceName iface
|
|
|
|
, "on bus"
|
2021-11-21 22:47:43 -05:00
|
|
|
, formatBusName busname
|
2021-11-20 19:35:24 -05:00
|
|
|
]
|
|
|
|
|
2021-11-21 10:26:28 -05:00
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
-- | Logging functions
|
2021-11-07 13:35:08 -05:00
|
|
|
|
2021-11-21 10:26:28 -05:00
|
|
|
warnMissing :: [MaybeAction a] -> IO ()
|
2021-11-20 19:35:24 -05:00
|
|
|
warnMissing xs = warnMissing' $ concat $ [ m | (Left m) <- xs ]
|
2021-11-20 15:20:22 -05:00
|
|
|
|
|
|
|
warnMissing' :: [String] -> IO ()
|
|
|
|
warnMissing' = mapM_ putStrLn
|
|
|
|
|
2021-11-20 19:35:24 -05:00
|
|
|
fmtMsg :: String -> String -> String -> String
|
|
|
|
fmtMsg procName level msg = unwords [bracket procName, bracket level, msg]
|
|
|
|
where
|
|
|
|
bracket s = "[" ++ s ++ "]"
|