From eb77e7c0e6714a357185e1a27321ec8903de2578 Mon Sep 17 00:00:00 2001 From: James Brechtel Date: Mon, 11 May 2026 09:48:26 -0400 Subject: [PATCH] Support multiple repositories per execution - Add RepoConfig type for per-repo path/remote/branch - Options now holds [RepoConfig] instead of single repo - YAML config file support (--config) for multi-repo setup - --repo still works for quick single-repo usage - Concurrent watchers via async (one thread per repo) - --debounce flag overrides config file value --- README.md | 42 ++++++++--- app/Main.hs | 114 +++++++++++++++++------------ converge.example.yaml | 12 ++++ package.yaml | 2 + src/Converge.hs | 163 ++++++++++++++++++++++++++++++------------ 5 files changed, 233 insertions(+), 100 deletions(-) create mode 100644 converge.example.yaml diff --git a/README.md b/README.md index bd15e6d..5f688b7 100644 --- a/README.md +++ b/README.md @@ -1,30 +1,54 @@ # Converge -Auto-sync a git repository by watching for file changes, automatically committing them, and pulling from a remote. +Auto-sync one or more git repositories by watching for file changes, automatically committing them, and pulling from a remote. Converge notifies the user via libnotify / `notify-send` whenever a merge conflict occurs during automatic pulling. ## Usage +### Single repository + ```bash # Watch the current directory (defaults) ./scripts/run # Watch a specific repo -./scripts/run -- --repo /path/to/repo --branch master +./scripts/run -- --repo /path/to/repo --branch master --debounce 10000 +``` -# Custom debounce (10 seconds) -./scripts/run -- --debounce 10000 +### Multiple repositories (config file) + +```bash +# Create a config file +cp converge.example.yaml converge.yaml +# Edit to list your repos +vim converge.yaml + +# Run with config +./scripts/run -- --config converge.yaml ``` ### Options | Option | Default | Description | |--------|---------|-------------| -| `-r`, `--repo PATH` | `.` (cwd) | Path to the git repository | -| `-d`, `--debounce MS` | `5000` | Debounce window in milliseconds | -| `--remote NAME` | `origin` | Remote name to pull from | -| `-b`, `--branch NAME` | `main` | Branch to pull | +| `-c`, `--config FILE` | — | Path to YAML config file listing repositories | +| `-r`, `--repo PATH` | `.` (cwd) | Path to a single git repository | +| `-d`, `--debounce MS` | `5000` | Debounce window in milliseconds (overrides config) | +| `--remote NAME` | `origin` | Remote name (single-repo mode) | +| `-b`, `--branch NAME` | `main` | Branch to pull (single-repo mode) | + +### Config file format + +```yaml +repos: + - path: /absolute/or/relative/path + remote: origin # optional, defaults to "origin" + branch: main # optional, defaults to "main" + - path: /another/repo + +debounce_ms: 5000 # optional, defaults to 5000 +``` ## Development @@ -48,5 +72,7 @@ All development tools run inside Docker via the `hs` wrapper script. - **Language**: Haskell (GHC 9.10.3 via lts-24.38) - **File watching**: [fsnotify](https://hackage.haskell.org/package/fsnotify) +- **Concurrency**: one watcher thread per repository via `async` - **Notifications**: shell out to `notify-send` (libnotify) +- **Configuration**: YAML config file for multi-repo, CLI flags for single-repo - **Daemonization**: TBD (likely systemd service) diff --git a/app/Main.hs b/app/Main.hs index 9df651c..8138a88 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,43 +1,49 @@ module Main (main) where import Converge -import Control.Monad (unless) +import Control.Monad (when) +import Data.Maybe (fromMaybe, isJust) import Options.Applicative -import System.Exit (ExitCode (..)) import System.IO (hPutStrLn, stderr) -data CliOptions = CliOptions - { cliRepoPath :: !FilePath - , cliDebounce :: !Int +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. } -cliParser :: Parser CliOptions +cliParser :: Parser CliArgs cliParser = - CliOptions - <$> strOption - ( long "repo" - <> short 'r' - <> metavar "PATH" - <> value "." - <> showDefault - <> help "Path to the git repository to watch (default: cwd)" + CliArgs + <$> optional + ( strOption + ( long "config" + <> short 'c' + <> metavar "FILE" + <> help "Path to YAML config file listing repositories" + ) ) - <*> option auto - ( long "debounce" - <> short 'd' - <> metavar "MS" - <> value 5000 - <> showDefault - <> help "Debounce window in milliseconds" + <*> 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" + <> help "Remote name to pull from (single-repo mode)" ) <*> strOption ( long "branch" @@ -45,36 +51,50 @@ cliParser = <> metavar "NAME" <> value "main" <> showDefault - <> help "Branch to pull" + <> help "Branch to pull (single-repo mode)" ) + <*> optional + ( option auto + ( long "debounce" + <> short 'd' + <> metavar "MS" + <> help "Debounce window in milliseconds (overrides config file)" + ) + ) + +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 opts - let options = + cli <- execParser parserInfo + let mDebounceOverride = cliDebounce cli + options <- case cliConfig cli of + Just cfgPath -> do + cfg <- loadConfig cfgPath + let opts = configToOptions cfg + pure $ case mDebounceOverride of + Just ms -> opts {optDebounceMs = ms} + Nothing -> opts + Nothing -> + pure $ defaultOptions - { optRepoPath = cliRepoPath cli - , optDebounceMs = cliDebounce cli - , optRemote = cliRemote cli - , optBranch = cliBranch cli + { optRepos = + [ defaultRepoConfig + { rcPath = fromMaybe "." (cliRepo cli) + , rcRemote = cliRemote cli + , rcBranch = cliBranch cli + } + ] + , optDebounceMs = fromMaybe 5000 mDebounceOverride } hPutStrLn stderr $ - "Converge watching " <> optRepoPath options + "Converge watching " <> show (length (optRepos options)) <> " repo(s)" <> " (debounce: " <> show (optDebounceMs options) <> "ms)" - withWatcher options $ \_event -> do - (commitCode, _, commitErr) <- gitCommitAll (optRepoPath options) - unless (commitCode == ExitSuccess) $ - hPutStrLn stderr ("git commit failed: " <> show commitErr) - (pullCode, _, pullErr) <- gitPull options - unless (pullCode == ExitSuccess) $ - hPutStrLn stderr ("git pull failed: " <> show pullErr) - conflicted <- hasConflicts (optRepoPath options) - when conflicted $ - notifyConflict options - where - opts = - info (cliParser <**> helper) - ( fullDesc - <> progDesc "Auto-sync a git repo by watching, committing, and pulling" - <> header "converge - keep a git repo in sync" - ) + mapM_ (\r -> hPutStrLn stderr (" - " <> rcPath r)) (optRepos options) + runConverge options diff --git a/converge.example.yaml b/converge.example.yaml new file mode 100644 index 0000000..d3f3c05 --- /dev/null +++ b/converge.example.yaml @@ -0,0 +1,12 @@ +# Example converge configuration file. +# Usage: converge --config converge.yaml + +repos: + - path: /home/jbrechtel/org + remote: origin + branch: main + - path: /work/personal/hawat + # remote defaults to "origin" + # branch defaults to "main" + +# debounce_ms: 5000 # optional, defaults to 5000 diff --git a/package.yaml b/package.yaml index a9ad095..0c67798 100644 --- a/package.yaml +++ b/package.yaml @@ -29,6 +29,7 @@ ghc-options: dependencies: - base >= 4.7 && < 5 + - async - directory - filepath - fsnotify @@ -37,6 +38,7 @@ dependencies: - text - time - unix + - yaml library: source-dirs: src diff --git a/src/Converge.hs b/src/Converge.hs index 51f6f56..55e44c1 100644 --- a/src/Converge.hs +++ b/src/Converge.hs @@ -1,10 +1,17 @@ module Converge ( -- * Core types Options (..), + RepoConfig (..), defaultOptions, + defaultRepoConfig, - -- * Watching - withWatcher, + -- * Config file + Config (..), + loadConfig, + configToOptions, + + -- * Running + runConverge, -- * Git operations gitCommitAll, @@ -17,65 +24,135 @@ module Converge where import Control.Concurrent (threadDelay) +import Control.Concurrent.Async (mapConcurrently_) import Control.Exception (bracket) import Control.Monad (forever, unless, when) +import Data.Maybe (fromMaybe) import Data.Text (Text) import qualified Data.Text as T +import Data.Yaml (FromJSON (..), decodeFileThrow, withObject, (.:), (.:?)) +import GHC.Generics (Generic) import System.Directory (getCurrentDirectory) import System.Exit (ExitCode (..)) -import System.FilePath (()) +import System.FilePath (isAbsolute, ()) import System.FSNotify import System.IO (hPutStrLn, stderr) -import System.Process (readProcessWithExitCode, spawnProcess, waitForProcess) +import System.Process (readProcessWithExitCode, spawnProcess) --- | Command-line / configuration options for converge. -data Options = Options - { optRepoPath :: !FilePath - -- ^ Path to the git repository to watch. Defaults to cwd. - , optDebounceMs :: !Int - -- ^ Debounce window in milliseconds. Default: 5000. - , optRemote :: !Text - -- ^ Remote name to pull from. Default: @"origin"@. - , optBranch :: !Text - -- ^ Branch to pull. Default: @"main"@. - , optNotifyCmd :: !Text - -- ^ Command used for desktop notifications. Default: @"notify-send"@. +-- | Configuration for a single repository to watch. +data RepoConfig = RepoConfig + { rcPath :: !FilePath + -- ^ Path to the git repository. + , rcRemote :: !Text + -- ^ Remote name to pull from. + , rcBranch :: !Text + -- ^ Branch to pull. } deriving (Show, Eq) --- | Sensible defaults. +-- | Top-level options for converge. +data Options = Options + { optRepos :: ![RepoConfig] + -- ^ Repositories to watch. + , optDebounceMs :: !Int + -- ^ Debounce window in milliseconds. + , optNotifyCmd :: !Text + -- ^ Command used for desktop notifications. + } + deriving (Show, Eq) + +-- | Sensible defaults for a single repo (cwd, origin, main). +defaultRepoConfig :: RepoConfig +defaultRepoConfig = + RepoConfig + { rcPath = "." + , rcRemote = "origin" + , rcBranch = "main" + } + +-- | Sensible defaults for options. defaultOptions :: Options defaultOptions = Options - { optRepoPath = "." + { optRepos = [defaultRepoConfig] , optDebounceMs = 5000 - , optRemote = "origin" - , optBranch = "main" , optNotifyCmd = "notify-send" } ---------------------------------------------------------------------- --- File watcher +-- Config file (YAML) ---------------------------------------------------------------------- --- | Watch the repository for file changes, debounced. --- Calls the action after a quiet period of 'optDebounceMs' ms. -withWatcher :: Options -> (Event -> IO ()) -> IO () -withWatcher opts onQuietPeriod = do - repoPath <- if optRepoPath opts == "." - then getCurrentDirectory - else pure (optRepoPath opts) +-- | Shape of the optional YAML config file. +data Config = Config + { cfgRepos :: ![RepoConfig] + , cfgDebounceMs :: !(Maybe Int) + } + deriving (Show, Eq, Generic) + +instance FromJSON Config where + parseJSON = withObject "Config" $ \o -> + Config + <$> o .: "repos" + <*> o .:? "debounce_ms" + +instance FromJSON RepoConfig where + parseJSON = withObject "RepoConfig" $ \o -> + RepoConfig + <$> o .: "path" + <*> o .:? "remote" .!= "origin" + <*> o .:? "branch" .!= "main" + +-- | Load a YAML config file. +loadConfig :: FilePath -> IO Config +loadConfig = decodeFileThrow + +-- | Convert a Config to Options (filling in defaults). +configToOptions :: Config -> Options +configToOptions cfg = + defaultOptions + { optRepos = cfgRepos cfg + , optDebounceMs = fromMaybe 5000 (cfgDebounceMs cfg) + } + +---------------------------------------------------------------------- +-- Running +---------------------------------------------------------------------- + +-- | Watch all configured repositories concurrently. +runConverge :: Options -> IO () +runConverge opts = + mapConcurrently_ (watchRepo opts) (optRepos opts) + +watchRepo :: Options -> RepoConfig -> IO () +watchRepo opts repo = do + absPath <- resolvePath (rcPath repo) let debounceUs = optDebounceMs opts * 1000 bracket (startManagerConf defaultConfig {confDebounce = NoDebounce}) stopManager $ \mgr -> do - _ <- watchDir mgr repoPath (const True) $ \_event -> do - -- Debounce: wait for quiet period, then fire + _ <- watchDir mgr absPath (const True) $ \_event -> do threadDelay debounceUs - onQuietPeriod _event - -- Never finish + syncRepo opts repo forever $ threadDelay maxBound + where + resolvePath p + | isAbsolute p = pure p + | otherwise = ( p) <$> getCurrentDirectory + +-- | Run a full sync cycle on a single repo: commit + pull + conflict check. +syncRepo :: Options -> RepoConfig -> IO () +syncRepo opts repo = do + (commitCode, _, commitErr) <- gitCommitAll (rcPath repo) + unless (commitCode == ExitSuccess) $ + hPutStrLn stderr ("[" <> rcPath repo <> "] git commit failed: " <> show commitErr) + (pullCode, _, pullErr) <- gitPull repo + unless (pullCode == ExitSuccess) $ + hPutStrLn stderr ("[" <> rcPath repo <> "] git pull failed: " <> show pullErr) + conflicted <- hasConflicts (rcPath repo) + when conflicted $ + notifyConflict opts repo ---------------------------------------------------------------------- -- Git operations @@ -84,37 +161,33 @@ withWatcher opts onQuietPeriod = do -- | Stage all changes and commit with an auto-generated message. gitCommitAll :: FilePath -> IO (ExitCode, Text, Text) gitCommitAll repoPath = do - -- Stage everything (_, _, stageErr) <- runGitIn repoPath ["add", "-A"] unless (T.null stageErr) $ hPutStrLn stderr ("git add stderr: " <> T.unpack stageErr) - -- Commit - let msg = "converge: auto-commit" - runGitIn repoPath ["commit", "-m", T.unpack msg] + runGitIn repoPath ["commit", "-m", "converge: auto-commit"] -- | Pull from the configured remote and branch. -gitPull :: Options -> IO (ExitCode, Text, Text) -gitPull opts = - runGitIn (optRepoPath opts) - ["pull", "--no-edit", T.unpack (optRemote opts), T.unpack (optBranch opts)] +gitPull :: RepoConfig -> IO (ExitCode, Text, Text) +gitPull repo = + runGitIn (rcPath repo) + ["pull", "--no-edit", T.unpack (rcRemote repo), T.unpack (rcBranch repo)] -- | Check if the repository currently has merge conflicts. hasConflicts :: FilePath -> IO Bool hasConflicts repoPath = do - let conflictMarkers = [<<"<<<<<<<", "=======", ">>>>>>>"] (_, diffOut, _) <- runGitIn repoPath ["diff", "--check"] - pure $ any (`T.isInfixOf` diffOut) conflictMarkers + pure $ any (`T.isInfixOf` diffOut) ["<<<<<<<", "=======", ">>>>>>>"] ---------------------------------------------------------------------- -- Notifications ---------------------------------------------------------------------- -- | Send a desktop notification about a merge conflict. -notifyConflict :: Options -> IO () -notifyConflict opts = do +notifyConflict :: Options -> RepoConfig -> IO () +notifyConflict opts repo = do let cmd = T.unpack (optNotifyCmd opts) title = "Converge: Merge Conflict" - body = "A merge conflict occurred in " <> optRepoPath opts + body = "A merge conflict occurred in " <> T.pack (rcPath repo) <> ". Manual resolution required." _ <- spawnProcess cmd ["--urgency=critical", title, T.unpack body] pure ()