This commit is contained in:
+14
-9
@@ -71,12 +71,15 @@ cliParser =
|
||||
)
|
||||
<*> optional
|
||||
( option
|
||||
(maybeReader (\s -> case T.toLower (T.pack s) of
|
||||
"debug" -> Just Debug
|
||||
"info" -> Just Info
|
||||
"warn" -> Just Warn
|
||||
"error" -> Just Error
|
||||
_ -> Nothing))
|
||||
( maybeReader
|
||||
( \s -> case T.toLower (T.pack s) of
|
||||
"debug" -> Just Debug
|
||||
"info" -> Just Info
|
||||
"warn" -> Just Warn
|
||||
"error" -> Just Error
|
||||
_ -> Nothing
|
||||
)
|
||||
)
|
||||
( long "log-level"
|
||||
<> metavar "LEVEL"
|
||||
<> help "Minimum log level: debug, info, warn, or error (default: info)"
|
||||
@@ -123,7 +126,10 @@ main = do
|
||||
pure (opts, Just cfgPath)
|
||||
else
|
||||
pure
|
||||
( applyOverrides mDebounceOverride (cliLogLevel cli) (cliLogFile cli)
|
||||
( applyOverrides
|
||||
mDebounceOverride
|
||||
(cliLogLevel cli)
|
||||
(cliLogFile cli)
|
||||
defaultOptions
|
||||
{ optRepos =
|
||||
[ defaultRepoConfig
|
||||
@@ -162,7 +168,6 @@ main = do
|
||||
mapM_ (\r -> hPutStrLn stderr (" - " <> rcPath r)) repos
|
||||
runConverge options
|
||||
|
||||
|
||||
-- | Apply CLI overrides (debounce, log level, log file) to Options.
|
||||
applyOverrides :: Maybe Int -> Maybe LogLevel -> Maybe FilePath -> Options -> Options
|
||||
applyOverrides mDebounce mLogLevel mLogFile opts =
|
||||
@@ -170,6 +175,6 @@ applyOverrides mDebounce mLogLevel mLogFile opts =
|
||||
{ optDebounceMs = maybe (optDebounceMs opts) id mDebounce
|
||||
, optLogLevel = fromMaybe (optLogLevel opts) mLogLevel
|
||||
, optLogFile = case mLogFile of
|
||||
Just _ -> mLogFile -- CLI --log-file overrides config
|
||||
Just _ -> mLogFile -- CLI --log-file overrides config
|
||||
Nothing -> optLogFile opts
|
||||
}
|
||||
|
||||
+8
-7
@@ -80,10 +80,10 @@ data LogLevel
|
||||
instance FromJSON LogLevel where
|
||||
parseJSON = withText "LogLevel" $ \t -> case T.toLower t of
|
||||
"debug" -> pure Debug
|
||||
"info" -> pure Info
|
||||
"warn" -> pure Warn
|
||||
"info" -> pure Info
|
||||
"warn" -> pure Warn
|
||||
"error" -> pure Error
|
||||
other -> fail $ "Unknown log level: " <> T.unpack other <> ". Expected: debug, info, warn, or error"
|
||||
other -> fail $ "Unknown log level: " <> T.unpack other <> ". Expected: debug, info, warn, or error"
|
||||
|
||||
-- | Top-level options for converge.
|
||||
data Options = Options
|
||||
@@ -198,8 +198,9 @@ configFileExists = defaultConfigPath >>= doesFileExist
|
||||
-- Logging
|
||||
----------------------------------------------------------------------
|
||||
|
||||
-- | Log a timestamped message at a given level. Messages below the
|
||||
-- Logger's configured minimum level are silently dropped.
|
||||
{- | Log a timestamped message at a given level. Messages below the
|
||||
Logger's configured minimum level are silently dropped.
|
||||
-}
|
||||
logMsg :: Logger -> LogLevel -> Text -> IO ()
|
||||
logMsg (Logger lock lvl handle) level msg =
|
||||
when (level >= lvl) $
|
||||
@@ -208,8 +209,8 @@ logMsg (Logger lock lvl handle) level msg =
|
||||
let ts = T.pack $ formatTime defaultTimeLocale "%H:%M:%S" now
|
||||
let levelTag = case level of
|
||||
Debug -> "DEBUG"
|
||||
Info -> "INFO "
|
||||
Warn -> "WARN "
|
||||
Info -> "INFO "
|
||||
Warn -> "WARN "
|
||||
Error -> "ERROR"
|
||||
hPutStrLn handle $ "[" <> T.unpack ts <> "] " <> levelTag <> " " <> T.unpack msg
|
||||
hFlush handle
|
||||
|
||||
+1
-1
@@ -16,7 +16,7 @@ module TestHelper (
|
||||
) where
|
||||
|
||||
import Control.Concurrent.MVar (newMVar)
|
||||
import Converge (Logger (..), LogLevel (..))
|
||||
import Converge (LogLevel (..), Logger (..))
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import System.Directory (createDirectory)
|
||||
|
||||
Reference in New Issue
Block a user