jbrechtel/converge
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Support multiple repositories per execution

Browse Source 
- 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
This commit is contained in:
James Brechtel
2026-05-11 09:48:26 -04:00
parent bf3329e5ce
commit eb77e7c0e6
5 changed files with 233 additions and 100 deletions
Download Patch File Download Diff File Expand all files Collapse all files
README.md
+34 -8
View File
@@ -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)
app/Main.hs
+67 -47
View File
@@ -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
converge.example.yaml
+12
View File
@@ -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
package.yaml
+2
View File
@@ -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
src/Converge.hs
+118 -45
View File
@@ -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 ()