Add configurable log levels and log file support

- New LogLevel type: Debug, Info, Warn, Error with Ord instance
- Logger holds configured level and output handle (stderr or file)
- --log-level and --log-file CLI flags
- log_level and log_file YAML config fields
- Log messages assigned appropriate severity levels
- Test logger updated to new Logger structure
- All 17 tests passing

SPEC.md

@@ -12,3 +12,6 @@
 ### a revert is in progess
 ### a cherry-pick is in progess
 ### a bisect is in progess
+
+## Supports configurable log levels (debug, info, warn, error)
+## Supports logging to a file instead of stderr via --log-file or log_file config

app/Main.hs

@@ -3,6 +3,7 @@ module Main (main) where
 import Converge
 import Data.Maybe (fromMaybe)
 import Data.Text (Text)
+import qualified Data.Text as T
 import Options.Applicative
 import System.IO (hPutStrLn, stderr)
 
@@ -17,6 +18,10 @@ data CliArgs = CliArgs
     -- ^ Branch name (used only in single-repo mode).
     , cliDebounce :: !(Maybe Int)
     -- ^ Debounce override for both modes.
+    , cliLogLevel :: !(Maybe LogLevel)
+    -- ^ Log level override.
+    , cliLogFile :: !(Maybe FilePath)
+    -- ^ Log file path.
     }
 
 cliParser :: Parser CliArgs
@@ -62,6 +67,26 @@ cliParser =
                     <> help "Debounce window in milliseconds (overrides config file)"
                 )
             )
+        <*> optional
+            ( option
+                (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)"
+                )
+            )
+        <*> optional
+            ( strOption
+                ( long "log-file"
+                    <> metavar "FILE"
+                    <> help "Write logs to a file instead of stderr"
+                )
+            )
 
 parserInfo :: ParserInfo CliArgs
 parserInfo =
@@ -79,7 +104,7 @@ main = do
     (options, configSource) <- case cliConfig cli of
         Just cfgPath -> do
             cfg <- loadConfig cfgPath
-            let opts = applyDebounce mDebounceOverride (configToOptions cfg)
+            let opts = applyOverrides mDebounceOverride (cliLogLevel cli) (cliLogFile cli) (configToOptions cfg)
             pure (opts, Just cfgPath)
         Nothing -> do
             exists <- configFileExists
@@ -87,20 +112,21 @@ main = do
                 then do
                     cfgPath <- defaultConfigPath
                     cfg <- loadConfig cfgPath
-                    let opts = applyDebounce mDebounceOverride (configToOptions cfg)
+                    let opts = applyOverrides mDebounceOverride (cliLogLevel cli) (cliLogFile cli) (configToOptions cfg)
                     pure (opts, Just cfgPath)
                 else
                     pure
-                        ( defaultOptions
+                        ( applyOverrides mDebounceOverride (cliLogLevel cli) (cliLogFile cli)
-                            { optRepos =
+                            defaultOptions
-                                [ defaultRepoConfig
+                                { optRepos =
-                                    { rcPath = fromMaybe "." (cliRepo cli)
+                                    [ defaultRepoConfig
-                                    , rcRemote = cliRemote cli
+                                        { rcPath = fromMaybe "." (cliRepo cli)
-                                    , rcBranch = cliBranch cli
+                                        , rcRemote = cliRemote cli
-                                    }
+                                        , rcBranch = cliBranch cli
-                                ]
+                                        }
-                            , optDebounceMs = fromMaybe 5000 mDebounceOverride
+                                    ]
-                            }
+                                , optDebounceMs = fromMaybe 5000 mDebounceOverride
+                                }
                         , Nothing
                         )
     case configSource of
@@ -118,6 +144,14 @@ main = do
     mapM_ (\r -> hPutStrLn stderr ("  - " <> rcPath r)) (optRepos options)
     runConverge options
 
-applyDebounce :: Maybe Int -> Options -> Options
+
-applyDebounce (Just ms) opts = opts{optDebounceMs = ms}
+-- | Apply CLI overrides (debounce, log level, log file) to Options.
-applyDebounce Nothing opts = opts
+applyOverrides :: Maybe Int -> Maybe LogLevel -> Maybe FilePath -> Options -> Options
+applyOverrides mDebounce mLogLevel mLogFile opts =
+    opts
+        { optDebounceMs = maybe (optDebounceMs opts) id mDebounce
+        , optLogLevel = fromMaybe (optLogLevel opts) mLogLevel
+        , optLogFile = case mLogFile of
+            Just _ -> mLogFile  -- CLI --log-file overrides config
+            Nothing -> optLogFile opts
+        }

converge.example.yaml

@@ -11,3 +11,6 @@ repos:
     # branch defaults to "main"
 
 # debounce_ms: 5000   # optional, defaults to 5000
+
+# log_level: info      # optional, one of: debug, info, warn, error (default: info)
+# log_file: /var/log/converge.log   # optional, write logs to a file instead of stderr

src/Converge.hs

@@ -2,6 +2,7 @@ module Converge (
     -- * Core types
     Options (..),
     RepoConfig (..),
+    LogLevel (..),
     defaultOptions,
     defaultRepoConfig,
 
@@ -47,12 +48,12 @@ import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Time.Clock (getCurrentTime)
 import Data.Time.Format (defaultTimeLocale, formatTime)
-import Data.Yaml (FromJSON (..), decodeFileThrow, withObject, (.:), (.:?))
+import Data.Yaml (FromJSON (..), decodeFileThrow, withObject, withText, (.:), (.:?))
 import System.Directory (XdgDirectory (XdgConfig), doesDirectoryExist, doesFileExist, getCurrentDirectory, getXdgDirectory)
 import System.Exit (ExitCode (..))
 import System.FSNotify
 import System.FilePath (isAbsolute, splitDirectories, (</>))
-import System.IO (hPutStrLn, stderr)
+import System.IO (BufferMode (..), Handle, IOMode (..), hFlush, hPutStrLn, hSetBuffering, openFile, stderr)
 import System.Process (readProcess, readProcessWithExitCode, spawnProcess)
 
 -- | Configuration for a single repository to watch.
@@ -66,6 +67,22 @@ data RepoConfig = RepoConfig
     }
     deriving (Show, Eq)
 
+-- | Log level controlling verbosity of output.
+data LogLevel
+    = Debug
+    | Info
+    | Warn
+    | Error
+    deriving (Show, Eq, Ord, Bounded, Enum)
+
+instance FromJSON LogLevel where
+    parseJSON = withText "LogLevel" $ \t -> case T.toLower t of
+        "debug" -> pure Debug
+        "info"  -> pure Info
+        "warn"  -> pure Warn
+        "error" -> pure Error
+        other   -> fail $ "Unknown log level: " <> T.unpack other <> ". Expected: debug, info, warn, or error"
+
 -- | Top-level options for converge.
 data Options = Options
     { optRepos :: ![RepoConfig]
@@ -74,6 +91,10 @@ data Options = Options
     -- ^ Debounce window in milliseconds.
     , optNotifyCmd :: !Text
     -- ^ Command used for desktop notifications.
+    , optLogLevel :: !LogLevel
+    -- ^ Minimum log level to emit.
+    , optLogFile :: !(Maybe FilePath)
+    -- ^ Optional log file path (logs to stderr when Nothing).
     }
     deriving (Show, Eq)
 
@@ -93,16 +114,31 @@ defaultOptions =
         { optRepos = [defaultRepoConfig]
         , optDebounceMs = 5000
         , optNotifyCmd = "notify-send"
+        , optLogLevel = Info
+        , optLogFile = Nothing
         }
 
-{- | Logger that serializes output to stderr so concurrent repo watchers
+{- | Logger that serializes output so concurrent repo watchers
-don't interleave their log lines.
+don't interleave their log lines.  Writes to stderr or a file
+depending on configuration.
 -}
-newtype Logger = Logger (MVar ())
+data Logger = Logger
+    { loggerLock :: !(MVar ())
+    , loggerLevel :: !LogLevel
+    , loggerHandle :: !Handle
+    }
 
 -- | Create a new thread-safe logger.
-newLogger :: IO Logger
+newLogger :: LogLevel -> Maybe FilePath -> IO Logger
-newLogger = Logger <$> newMVar ()
+newLogger lvl mFile = do
+    lock <- newMVar ()
+    handle <- case mFile of
+        Nothing -> pure stderr
+        Just path -> do
+            h <- openFile path AppendMode
+            hSetBuffering h LineBuffering
+            pure h
+    pure $ Logger lock lvl handle
 
 ----------------------------------------------------------------------
 -- Config file (YAML)
@@ -112,6 +148,8 @@ newLogger = Logger <$> newMVar ()
 data Config = Config
     { cfgRepos :: ![RepoConfig]
     , cfgDebounceMs :: !(Maybe Int)
+    , cfgLogLevel :: !(Maybe LogLevel)
+    , cfgLogFile :: !(Maybe FilePath)
     }
     deriving (Show, Eq)
 
@@ -120,6 +158,8 @@ instance FromJSON Config where
         Config
             <$> o .: "repos"
             <*> o .:? "debounce_ms"
+            <*> o .:? "log_level"
+            <*> o .:? "log_file"
 
 instance FromJSON RepoConfig where
     parseJSON = withObject "RepoConfig" $ \o ->
@@ -138,6 +178,8 @@ configToOptions cfg =
     defaultOptions
         { optRepos = cfgRepos cfg
         , optDebounceMs = fromMaybe 5000 (cfgDebounceMs cfg)
+        , optLogLevel = fromMaybe Info (cfgLogLevel cfg)
+        , optLogFile = cfgLogFile cfg
         }
 
 -- | The default XDG config file path: @$XDG_CONFIG_HOME/converge/config.yaml@.
@@ -152,16 +194,37 @@ configFileExists = defaultConfigPath >>= doesFileExist
 -- Logging
 ----------------------------------------------------------------------
 
--- | Log a timestamped message to stderr.
+-- | Log a timestamped message at a given level.  Messages below the
-logInfo :: Logger -> Text -> IO ()
+-- Logger's configured minimum level are silently dropped.
-logInfo (Logger lock) msg = withMVar lock $ \() -> do
+logMsg :: Logger -> LogLevel -> Text -> IO ()
-    now <- getCurrentTime
+logMsg (Logger lock lvl handle) level msg =
-    let ts = T.pack $ formatTime defaultTimeLocale "%H:%M:%S" now
+    when (level >= lvl) $
-    hPutStrLn stderr $ "[" <> T.unpack ts <> "] " <> T.unpack msg
+        withMVar lock $ \() -> do
+            now <- getCurrentTime
+            let ts = T.pack $ formatTime defaultTimeLocale "%H:%M:%S" now
+            let levelTag = case level of
+                    Debug -> "DEBUG"
+                    Info  -> "INFO "
+                    Warn  -> "WARN "
+                    Error -> "ERROR"
+            hPutStrLn handle $ "[" <> T.unpack ts <> "] " <> levelTag <> " " <> T.unpack msg
+            hFlush handle
 
--- | Log a message tagged with a repo path.
+-- | Log at Debug level.
+logDebug :: Logger -> Text -> IO ()
+logDebug logger msg = logMsg logger Debug msg
+
+-- | Log at Warn level.
+logWarn :: Logger -> Text -> IO ()
+logWarn logger msg = logMsg logger Warn msg
+
+-- | Log a message tagged with a repo path (at a given level).
+logRepoAt :: Logger -> LogLevel -> RepoConfig -> Text -> IO ()
+logRepoAt logger level repo msg = logMsg logger level ("[" <> T.pack (rcPath repo) <> "] " <> msg)
+
+-- | Log a message tagged with a repo path at Info level.
 logRepo :: Logger -> RepoConfig -> Text -> IO ()
-logRepo logger repo msg = logInfo logger ("[" <> T.pack (rcPath repo) <> "] " <> msg)
+logRepo logger repo msg = logRepoAt logger Info repo msg
 
 ----------------------------------------------------------------------
 -- Running
@@ -170,7 +233,7 @@ logRepo logger repo msg = logInfo logger ("[" <> T.pack (rcPath repo) <> "] " <>
 -- | Watch all configured repositories concurrently.
 runConverge :: Options -> IO ()
 runConverge opts = do
-    logger <- newLogger
+    logger <- newLogger (optLogLevel opts) (optLogFile opts)
     mapConcurrently_ (watchRepo opts logger) (optRepos opts)
 
 {- | Watch a single repository for changes.
@@ -183,7 +246,7 @@ watchRepo :: Options -> Logger -> RepoConfig -> IO ()
 watchRepo opts logger repo = do
     absPath <- resolvePath (rcPath repo)
     let debounceUs = optDebounceMs opts * 1000
-    logRepo logger repo ("watching " <> T.pack absPath <> " (debounce: " <> T.pack (show (optDebounceMs opts)) <> "ms)")
+    logRepo logger repo ("watching " <> T.pack absPath <> " (debounce: " <> T.pack (show (optDebounceMs opts)) <> "ms) [level=" <> T.pack (show (optLogLevel opts)) <> "]")
     pending <- newEmptyMVar
     -- Background sync loop: waits for an event signal, debounces, then syncs
     _ <- forkIO $ forever $ do
@@ -246,17 +309,17 @@ merge, rebase, revert, cherry-pick, or bisect.
 -}
 syncRepo :: Options -> Logger -> RepoConfig -> IO ()
 syncRepo opts logger repo = do
-    logRepo logger repo "sync cycle starting"
+    logRepoAt logger Debug repo "sync cycle starting"
     -- Guard: bail out if an operation (merge, rebase, revert, etc.) is in progress
     inProgress <- isInMiddleOfOperation (rcPath repo)
     when inProgress $ do
-        logRepo logger repo "*** SKIPPING: an operation (merge/rebase/revert/cherry-pick/bisect) is in progress ***"
+        logRepoAt logger Warn repo "*** SKIPPING: an operation (merge/rebase/revert/cherry-pick/bisect) is in progress ***"
     unless inProgress $ do
         -- Check what's changed
         (_, statusOut, _) <- runGitIn (rcPath repo) ["status", "--porcelain"]
         let changed = filter (not . T.null) (T.lines statusOut)
         if null changed
-            then logRepo logger repo "no changes to commit"
+            then logRepoAt logger Debug repo "no changes to commit"
             else do
                 let count = length changed
                 let preview = T.unlines (take 15 changed)
@@ -271,7 +334,7 @@ syncRepo opts logger repo = do
                             || "nothing to commit" `T.isInfixOf` commitErr ->
                             logRepo logger repo "nothing to commit (working tree clean)"
                         | otherwise -> do
-                            logRepo logger repo ("commit FAILED (exit " <> T.pack (show commitCode) <> "): " <> T.strip (commitOut <> commitErr))
+                            logRepoAt logger Error repo ("commit FAILED (exit " <> T.pack (show commitCode) <> "): " <> T.strip (commitOut <> commitErr))
                             notifyUser
                                 opts
                                 "Converge: Commit Failed"
@@ -286,7 +349,7 @@ syncRepo opts logger repo = do
                     then logRepo logger repo "pull: already up to date"
                     else logRepo logger repo ("pull succeeded:\n" <> trimmed)
             _ -> do
-                logRepo logger repo ("pull FAILED (exit " <> T.pack (show pullCode) <> "): " <> T.strip (pullOut <> pullErr))
+                logRepoAt logger Error repo ("pull FAILED (exit " <> T.pack (show pullCode) <> "): " <> T.strip (pullOut <> pullErr))
                 notifyUser
                     opts
                     "Converge: Pull Failed"
@@ -295,7 +358,7 @@ syncRepo opts logger repo = do
         conflicted <- hasConflicts (rcPath repo)
         if conflicted
             then do
-                logRepo logger repo "*** MERGE CONFLICT detected! ***"
+                logRepoAt logger Error repo "*** MERGE CONFLICT detected! ***"
                 notifyUser
                     opts
                     "Converge: Merge Conflict"
@@ -308,7 +371,7 @@ syncRepo opts logger repo = do
                     ExitSuccess ->
                         logRepo logger repo "push succeeded"
                     _ -> do
-                        logRepo logger repo ("push FAILED (exit " <> T.pack (show pushCode) <> "): " <> T.strip (pushOut <> pushErr))
+                        logRepoAt logger Error repo ("push FAILED (exit " <> T.pack (show pushCode) <> "): " <> T.strip (pushOut <> pushErr))
                         notifyUser
                             opts
                             "Converge: Push Failed"
@@ -323,7 +386,7 @@ gitCommitAll :: Logger -> FilePath -> IO (ExitCode, Text, Text)
 gitCommitAll logger repoPath = do
     addResult@(addCode, _, addErr) <- loggedGit logger repoPath ["add", "-A"]
     unless (T.null addErr) $
-        logInfo logger ("git add stderr: " <> addErr)
+        logWarn logger ("git add stderr: " <> addErr)
     if addCode /= ExitSuccess
         then pure addResult
         else do
@@ -349,14 +412,17 @@ gitPush logger repo =
 -- | Run a git command and log the invocation and exit code.
 loggedGit :: Logger -> FilePath -> [String] -> IO (ExitCode, Text, Text)
 loggedGit logger repoPath args = do
-    logInfo logger ("RUN: git -C " <> T.pack repoPath <> " " <> T.intercalate " " (map T.pack args))
+    logDebug logger ("RUN: git -C " <> T.pack repoPath <> " " <> T.intercalate " " (map T.pack args))
     result@(code, _, err) <- runGitIn repoPath args
     let msg = "EXIT " <> T.pack (show code)
         details =
             if code /= ExitSuccess && not (T.null err)
                 then ": " <> T.strip err
                 else ""
-    logInfo logger (msg <> details)
+    let exitLevel = case code of
+            ExitSuccess -> Debug
+            _ -> Error
+    logMsg logger exitLevel (msg <> details)
     pure result
 
 -- | Check if the repository currently has merge conflicts.

test/TestHelper.hs

@@ -16,12 +16,13 @@ module TestHelper (
 ) where
 
 import Control.Concurrent.MVar (newMVar)
-import Converge (Logger (..))
+import Converge (Logger (..), LogLevel (..))
 import Data.Text (Text)
 import qualified Data.Text as T
 import System.Directory (createDirectory)
 import System.Exit (ExitCode)
 import System.FilePath ((</>))
+import System.IO (stderr)
 import System.IO.Temp (withSystemTempDirectory)
 import System.Process (readProcessWithExitCode)
 
@@ -37,9 +38,9 @@ rawGit args = do
     (code, out, err) <- readProcessWithExitCode "git" args ""
     pure (code, T.pack out, T.pack err)
 
--- | Create a test logger (serialized writes to stderr).
+-- | Create a test logger (serialized writes to stderr, Debug level).
 testLogger :: IO Logger
-testLogger = Logger <$> newMVar ()
+testLogger = Logger <$> newMVar () <*> pure Debug <*> pure stderr
 
 {- | Create a temporary git repository, configure a user, make an initial
 commit on branch "main", run the action with the repo path, then clean up.