Files
converge/app/Main.hs
T
jbrechtel 477a86c18a
Build / build (push) Failing after 6s
Add --sync flag for one-shot sync-and-exit mode
Useful for wake-from-sleep hooks: run 'converge --sync' to commit
any pending changes, pull from remotes, and push, then exit.
Shows 'Syncing N repo(s)' instead of 'Watching N repo(s)'.
2026-05-14 10:34:36 -04:00

176 lines
6.2 KiB
Haskell

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)
data CliArgs = CliArgs
{ cliConfig :: !(Maybe FilePath)
-- ^ Optional path to a YAML config file.
, cliRepo :: !(Maybe FilePath)
-- ^ Optional single repo path (requires --config to be absent).
, cliRemote :: !Text
-- ^ Remote name (used only in single-repo mode).
, cliBranch :: !Text
-- ^ 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.
, cliSync :: !Bool
-- ^ Run a single sync cycle and exit (useful for wake-from-sleep hooks).
}
cliParser :: Parser CliArgs
cliParser =
CliArgs
<$> optional
( strOption
( long "config"
<> short 'c'
<> metavar "FILE"
<> help "Path to YAML config file listing repositories"
)
)
<*> optional
( strOption
( long "repo"
<> short 'r'
<> metavar "PATH"
<> help "Path to a single git repository to watch (default: cwd)"
)
)
<*> strOption
( long "remote"
<> metavar "NAME"
<> value "origin"
<> showDefault
<> help "Remote name to pull from (single-repo mode)"
)
<*> strOption
( long "branch"
<> short 'b'
<> metavar "NAME"
<> value "main"
<> showDefault
<> help "Branch to pull (single-repo mode)"
)
<*> optional
( option
auto
( long "debounce"
<> short 'd'
<> metavar "MS"
<> 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"
)
)
<*> switch
( long "sync"
<> short 's'
<> help "Run a single sync cycle (commit + pull + push) and exit"
)
parserInfo :: ParserInfo CliArgs
parserInfo =
info
(cliParser <**> helper)
( fullDesc
<> progDesc "Auto-sync git repos by watching, committing, and pulling"
<> header "converge - keep git repos in sync"
)
main :: IO ()
main = do
cli <- execParser parserInfo
let mDebounceOverride = cliDebounce cli
(options, configSource) <- case cliConfig cli of
Just cfgPath -> do
cfg <- loadConfig cfgPath
let opts = applyOverrides mDebounceOverride (cliLogLevel cli) (cliLogFile cli) (configToOptions cfg)
pure (opts, Just cfgPath)
Nothing -> do
exists <- configFileExists
if exists
then do
cfgPath <- defaultConfigPath
cfg <- loadConfig cfgPath
let opts = applyOverrides mDebounceOverride (cliLogLevel cli) (cliLogFile cli) (configToOptions cfg)
pure (opts, Just cfgPath)
else
pure
( applyOverrides mDebounceOverride (cliLogLevel cli) (cliLogFile cli)
defaultOptions
{ optRepos =
[ defaultRepoConfig
{ rcPath = fromMaybe "." (cliRepo cli)
, rcRemote = cliRemote cli
, rcBranch = cliBranch cli
}
]
, optDebounceMs = fromMaybe 5000 mDebounceOverride
}
, Nothing
)
case configSource of
Just path ->
hPutStrLn stderr ("Using config: " <> path)
Nothing ->
hPutStrLn stderr "No config file found, using single-repo mode"
let repos = optRepos options
if cliSync cli
then do
hPutStrLn stderr $
"Syncing "
<> show (length repos)
<> " repo(s)"
mapM_ (\r -> hPutStrLn stderr (" - " <> rcPath r)) repos
logger <- newLogger (optLogLevel options) (optLogFile options)
mapM_ (syncRepo options logger) repos
else do
hPutStrLn stderr $
"Watching "
<> show (length repos)
<> " repo(s)"
<> " (debounce: "
<> show (optDebounceMs options)
<> "ms)"
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 =
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
}