181 lines
6.3 KiB
Haskell
181 lines
6.3 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
|
|
}
|