ENH make logger print to stderr when running test commands

This commit is contained in:
Nathan Dwarshuis 2023-01-03 23:44:52 -05:00
parent 1142732dca
commit 24f0f034f0
4 changed files with 18 additions and 22 deletions

View File

@ -65,11 +65,10 @@ parseTest =
(long "test" <> short 't' <> help "test dependencies without running") (long "test" <> short 't' <> help "test dependencies without running")
xio :: XOpts -> IO () xio :: XOpts -> IO ()
xio o = runXIO "xmobar.log" $ xio o = case o of
case o of XDeps -> hRunXIO False stderr printDeps
XDeps -> printDeps XTest -> hRunXIO False stderr $ withDBus_ evalConfig
XTest -> withDBus_ evalConfig XRun -> runXIO "xmobar.log" run
XRun -> run
run :: XIO () run :: XIO ()
run = do run = do

View File

@ -91,11 +91,10 @@ parseTest =
(long "test" <> short 't' <> help "test dependencies without running") (long "test" <> short 't' <> help "test dependencies without running")
xio :: XOpts -> IO () xio :: XOpts -> IO ()
xio o = runXIO "xmonad.log" $ xio o = case o of
case o of XDeps -> hRunXIO False stderr printDeps
XDeps -> printDeps XTest -> undefined
XTest -> undefined XRun -> runXIO "xmonad.log" run
XRun -> run
run :: XIO () run :: XIO ()
run = do run = do

View File

@ -58,6 +58,7 @@ module Data.Internal.XIO
-- testing -- testing
, XIO , XIO
, runXIO , runXIO
, hRunXIO
, evalFeature , evalFeature
, executeSometimes , executeSometimes
, executeAlways , executeAlways
@ -133,8 +134,9 @@ import XMonad.Internal.Theme
-- | Run feature evaluation(s) with the cache -- | Run feature evaluation(s) with the cache
-- Currently there is no easy way to not use this (oh well) -- Currently there is no easy way to not use this (oh well)
runXIO :: FilePath -> XIO a -> IO a runXIO :: FilePath -> XIO a -> IO a
runXIO logfile x = withLogFile logfile $ runXIOInner x runXIO logfile x = withLogFile logfile $ \h -> hRunXIO True h x
-- TODO use dhall to encode config file and log here to control the loglevel
withLogFile :: MonadUnliftIO m => FilePath -> (Handle -> m a) -> m a withLogFile :: MonadUnliftIO m => FilePath -> (Handle -> m a) -> m a
withLogFile logfile f = do withLogFile logfile f = do
p <- (</> logfile) . dataDir <$> liftIO getDirectories p <- (</> logfile) . dataDir <$> liftIO getDirectories
@ -143,16 +145,20 @@ withLogFile logfile f = do
liftIO $ putStrLn "could not open log file, falling back to stderr" liftIO $ putStrLn "could not open log file, falling back to stderr"
f stderr f stderr
runXIOInner :: XIO a -> Handle -> IO a hRunXIO :: Bool -> Handle -> XIO a -> IO a
runXIOInner x h = do hRunXIO verbose h x = do
hSetBuffering h LineBuffering hSetBuffering h LineBuffering
logOpts <- setLogVerboseFormat True . setLogUseTime True <$> logOptionsHandle h False logOpts <- logOptionsHandle_ verbose h
pc <- mkDefaultProcessContext pc <- mkDefaultProcessContext
withLogFunc logOpts $ \f -> do withLogFunc logOpts $ \f -> do
p <- getParams p <- getParams
let s = XEnv f pc p let s = XEnv f pc p
runRIO s x runRIO s x
logOptionsHandle_ :: MonadUnliftIO m => Bool -> Handle -> m LogOptions
logOptionsHandle_ v h =
setLogVerboseFormat v . setLogUseTime v <$> logOptionsHandle h False
-- | Execute an Always immediately -- | Execute an Always immediately
executeAlways :: Always (IO a) -> XIO a executeAlways :: Always (IO a) -> XIO a
executeAlways = io <=< evalAlways executeAlways = io <=< evalAlways

View File

@ -12,7 +12,6 @@ module Xmobar.Plugins.Common
, displayMaybe , displayMaybe
, displayMaybe' , displayMaybe'
, xmobarFGColor , xmobarFGColor
, LogConf (..)
) )
where where
@ -88,10 +87,3 @@ withDBusClientConnection cb logfile f =
withLogFunc logOpts $ \lf -> do withLogFunc logOpts $ \lf -> do
env <- mkSimpleApp lf Nothing env <- mkSimpleApp lf Nothing
runRIO env $ displayMaybe' cb f =<< getDBusClient runRIO env $ displayMaybe' cb f =<< getDBusClient
data LogConf = LogConf
{ lcLevel :: !LogLevel
, lcVerbose :: !Bool
, lcPath :: FilePath
}
deriving (Show, Read)