Initial commit: converge - auto-sync git repo watcher
This commit is contained in:
+11
@@ -0,0 +1,11 @@
|
|||||||
|
.stack-work/
|
||||||
|
.stack-root/
|
||||||
|
bin/
|
||||||
|
build/
|
||||||
|
converge.cabal
|
||||||
|
*.hi
|
||||||
|
*.o
|
||||||
|
dist/
|
||||||
|
dist-newstyle/
|
||||||
|
.claude/
|
||||||
|
.pi/
|
||||||
@@ -0,0 +1,52 @@
|
|||||||
|
# Converge
|
||||||
|
|
||||||
|
Auto-sync a git repository 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
|
||||||
|
|
||||||
|
```bash
|
||||||
|
# Watch the current directory (defaults)
|
||||||
|
./scripts/run
|
||||||
|
|
||||||
|
# Watch a specific repo
|
||||||
|
./scripts/run -- --repo /path/to/repo --branch master
|
||||||
|
|
||||||
|
# Custom debounce (10 seconds)
|
||||||
|
./scripts/run -- --debounce 10000
|
||||||
|
```
|
||||||
|
|
||||||
|
### 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 |
|
||||||
|
|
||||||
|
## Development
|
||||||
|
|
||||||
|
All development tools run inside Docker via the `hs` wrapper script.
|
||||||
|
|
||||||
|
```bash
|
||||||
|
# Build (format + compile)
|
||||||
|
./scripts/build
|
||||||
|
|
||||||
|
# Run tests
|
||||||
|
./scripts/test
|
||||||
|
|
||||||
|
# Run the tool
|
||||||
|
./scripts/run
|
||||||
|
|
||||||
|
# Install to ~/.local/bin
|
||||||
|
./scripts/install
|
||||||
|
```
|
||||||
|
|
||||||
|
## Design
|
||||||
|
|
||||||
|
- **Language**: Haskell (GHC 9.10.3 via lts-24.38)
|
||||||
|
- **File watching**: [fsnotify](https://hackage.haskell.org/package/fsnotify)
|
||||||
|
- **Notifications**: shell out to `notify-send` (libnotify)
|
||||||
|
- **Daemonization**: TBD (likely systemd service)
|
||||||
+80
@@ -0,0 +1,80 @@
|
|||||||
|
module Main (main) where
|
||||||
|
|
||||||
|
import Converge
|
||||||
|
import Control.Monad (unless)
|
||||||
|
import Options.Applicative
|
||||||
|
import System.Exit (ExitCode (..))
|
||||||
|
import System.IO (hPutStrLn, stderr)
|
||||||
|
|
||||||
|
data CliOptions = CliOptions
|
||||||
|
{ cliRepoPath :: !FilePath
|
||||||
|
, cliDebounce :: !Int
|
||||||
|
, cliRemote :: !Text
|
||||||
|
, cliBranch :: !Text
|
||||||
|
}
|
||||||
|
|
||||||
|
cliParser :: Parser CliOptions
|
||||||
|
cliParser =
|
||||||
|
CliOptions
|
||||||
|
<$> strOption
|
||||||
|
( long "repo"
|
||||||
|
<> short 'r'
|
||||||
|
<> metavar "PATH"
|
||||||
|
<> value "."
|
||||||
|
<> showDefault
|
||||||
|
<> help "Path to the git repository to watch (default: cwd)"
|
||||||
|
)
|
||||||
|
<*> option auto
|
||||||
|
( long "debounce"
|
||||||
|
<> short 'd'
|
||||||
|
<> metavar "MS"
|
||||||
|
<> value 5000
|
||||||
|
<> showDefault
|
||||||
|
<> help "Debounce window in milliseconds"
|
||||||
|
)
|
||||||
|
<*> strOption
|
||||||
|
( long "remote"
|
||||||
|
<> metavar "NAME"
|
||||||
|
<> value "origin"
|
||||||
|
<> showDefault
|
||||||
|
<> help "Remote name to pull from"
|
||||||
|
)
|
||||||
|
<*> strOption
|
||||||
|
( long "branch"
|
||||||
|
<> short 'b'
|
||||||
|
<> metavar "NAME"
|
||||||
|
<> value "main"
|
||||||
|
<> showDefault
|
||||||
|
<> help "Branch to pull"
|
||||||
|
)
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main = do
|
||||||
|
cli <- execParser opts
|
||||||
|
let options =
|
||||||
|
defaultOptions
|
||||||
|
{ optRepoPath = cliRepoPath cli
|
||||||
|
, optDebounceMs = cliDebounce cli
|
||||||
|
, optRemote = cliRemote cli
|
||||||
|
, optBranch = cliBranch cli
|
||||||
|
}
|
||||||
|
hPutStrLn stderr $
|
||||||
|
"Converge watching " <> optRepoPath options
|
||||||
|
<> " (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"
|
||||||
|
)
|
||||||
@@ -0,0 +1,19 @@
|
|||||||
|
#!/usr/bin/env bash
|
||||||
|
# Thin wrapper to run Haskell tooling (stack, hpack, fourmolu, hlint, ...)
|
||||||
|
# inside the flipstone/haskell-tools Docker image. Usage: ./hs <cmd> [args]
|
||||||
|
# e.g. ./hs stack build, ./hs stack test, ./hs hpack
|
||||||
|
set -euo pipefail
|
||||||
|
|
||||||
|
IMAGE="${CONVERGE_HASKELL_TOOLS_IMAGE:-ghcr.io/flipstone/haskell-tools:debian-ghc-9.10.3-5d6640d}"
|
||||||
|
PROJECT_DIR="$(cd "$(dirname "${BASH_SOURCE[0]}")" && pwd)"
|
||||||
|
STACK_ROOT_HOST="${PROJECT_DIR}/.stack-root"
|
||||||
|
|
||||||
|
mkdir -p "${STACK_ROOT_HOST}"
|
||||||
|
|
||||||
|
exec docker run --rm -i $([ -t 0 ] && printf -- -t) \
|
||||||
|
-v "${PROJECT_DIR}:/work" \
|
||||||
|
-v "${STACK_ROOT_HOST}:/stack-root" \
|
||||||
|
-e STACK_ROOT=/stack-root \
|
||||||
|
-w /work \
|
||||||
|
"${IMAGE}" \
|
||||||
|
"$@"
|
||||||
@@ -0,0 +1,65 @@
|
|||||||
|
name: converge
|
||||||
|
version: 0.1.0.0
|
||||||
|
synopsis: Auto-sync a git repository by watching for changes, committing, and pulling
|
||||||
|
description: |
|
||||||
|
Converge watches a git repository for file changes, automatically
|
||||||
|
commits them, and pulls from the remote. It notifies the user via
|
||||||
|
libnotify/notify-send when merge conflicts arise.
|
||||||
|
author: James Brechtel
|
||||||
|
maintainer: james@flipstone.com
|
||||||
|
copyright: 2026 James Brechtel
|
||||||
|
license: BSD-3-Clause
|
||||||
|
|
||||||
|
default-extensions:
|
||||||
|
- OverloadedStrings
|
||||||
|
- RecordWildCards
|
||||||
|
- ScopedTypeVariables
|
||||||
|
- TupleSections
|
||||||
|
|
||||||
|
ghc-options:
|
||||||
|
- -Wall
|
||||||
|
- -Wcompat
|
||||||
|
- -Widentities
|
||||||
|
- -Wincomplete-record-updates
|
||||||
|
- -Wincomplete-uni-patterns
|
||||||
|
- -Wmissing-export-lists
|
||||||
|
- -Wmissing-home-modules
|
||||||
|
- -Wpartial-fields
|
||||||
|
- -Wredundant-constraints
|
||||||
|
|
||||||
|
dependencies:
|
||||||
|
- base >= 4.7 && < 5
|
||||||
|
- directory
|
||||||
|
- filepath
|
||||||
|
- fsnotify
|
||||||
|
- optparse-applicative
|
||||||
|
- process
|
||||||
|
- text
|
||||||
|
- time
|
||||||
|
- unix
|
||||||
|
|
||||||
|
library:
|
||||||
|
source-dirs: src
|
||||||
|
|
||||||
|
executables:
|
||||||
|
converge:
|
||||||
|
main: Main.hs
|
||||||
|
source-dirs: app
|
||||||
|
ghc-options:
|
||||||
|
- -threaded
|
||||||
|
- -rtsopts
|
||||||
|
- -with-rtsopts=-N
|
||||||
|
dependencies:
|
||||||
|
- converge
|
||||||
|
|
||||||
|
tests:
|
||||||
|
converge-test:
|
||||||
|
main: Spec.hs
|
||||||
|
source-dirs: test
|
||||||
|
ghc-options:
|
||||||
|
- -threaded
|
||||||
|
- -rtsopts
|
||||||
|
- -with-rtsopts=-N
|
||||||
|
dependencies:
|
||||||
|
- converge
|
||||||
|
- hspec
|
||||||
Executable
+8
@@ -0,0 +1,8 @@
|
|||||||
|
#!/usr/bin/env bash
|
||||||
|
set -euo pipefail
|
||||||
|
cd "$(dirname "${BASH_SOURCE[0]}")/.."
|
||||||
|
|
||||||
|
echo "Formatting with fourmolu..."
|
||||||
|
./hs fourmolu --mode inplace app/ src/ test/
|
||||||
|
|
||||||
|
./hs stack build --copy-bins --local-bin-path /work/build
|
||||||
Executable
+8
@@ -0,0 +1,8 @@
|
|||||||
|
#!/usr/bin/env bash
|
||||||
|
set -euo pipefail
|
||||||
|
cd "$(dirname "${BASH_SOURCE[0]}")/.."
|
||||||
|
INSTALL_DIR="${INSTALL_DIR:-$HOME/.local/bin}"
|
||||||
|
mkdir -p "${INSTALL_DIR}"
|
||||||
|
./hs stack build --copy-bins --local-bin-path /work/bin
|
||||||
|
cp ./bin/converge "${INSTALL_DIR}/converge"
|
||||||
|
echo "Installed converge to ${INSTALL_DIR}/converge"
|
||||||
Executable
+4
@@ -0,0 +1,4 @@
|
|||||||
|
#!/usr/bin/env bash
|
||||||
|
set -euo pipefail
|
||||||
|
cd "$(dirname "${BASH_SOURCE[0]}")/.."
|
||||||
|
./hs stack run converge -- "$@"
|
||||||
Executable
+4
@@ -0,0 +1,4 @@
|
|||||||
|
#!/usr/bin/env bash
|
||||||
|
set -euo pipefail
|
||||||
|
cd "$(dirname "${BASH_SOURCE[0]}")/.."
|
||||||
|
./hs stack test
|
||||||
+129
@@ -0,0 +1,129 @@
|
|||||||
|
module Converge
|
||||||
|
( -- * Core types
|
||||||
|
Options (..),
|
||||||
|
defaultOptions,
|
||||||
|
|
||||||
|
-- * Watching
|
||||||
|
withWatcher,
|
||||||
|
|
||||||
|
-- * Git operations
|
||||||
|
gitCommitAll,
|
||||||
|
gitPull,
|
||||||
|
hasConflicts,
|
||||||
|
|
||||||
|
-- * Notifications
|
||||||
|
notifyConflict,
|
||||||
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
import Control.Concurrent (threadDelay)
|
||||||
|
import Control.Exception (bracket)
|
||||||
|
import Control.Monad (forever, unless, when)
|
||||||
|
import Data.Text (Text)
|
||||||
|
import qualified Data.Text as T
|
||||||
|
import System.Directory (getCurrentDirectory)
|
||||||
|
import System.Exit (ExitCode (..))
|
||||||
|
import System.FilePath ((</>))
|
||||||
|
import System.FSNotify
|
||||||
|
import System.IO (hPutStrLn, stderr)
|
||||||
|
import System.Process (readProcessWithExitCode, spawnProcess, waitForProcess)
|
||||||
|
|
||||||
|
-- | 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"@.
|
||||||
|
}
|
||||||
|
deriving (Show, Eq)
|
||||||
|
|
||||||
|
-- | Sensible defaults.
|
||||||
|
defaultOptions :: Options
|
||||||
|
defaultOptions =
|
||||||
|
Options
|
||||||
|
{ optRepoPath = "."
|
||||||
|
, optDebounceMs = 5000
|
||||||
|
, optRemote = "origin"
|
||||||
|
, optBranch = "main"
|
||||||
|
, optNotifyCmd = "notify-send"
|
||||||
|
}
|
||||||
|
|
||||||
|
----------------------------------------------------------------------
|
||||||
|
-- File watcher
|
||||||
|
----------------------------------------------------------------------
|
||||||
|
|
||||||
|
-- | 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)
|
||||||
|
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
|
||||||
|
threadDelay debounceUs
|
||||||
|
onQuietPeriod _event
|
||||||
|
-- Never finish
|
||||||
|
forever $ threadDelay maxBound
|
||||||
|
|
||||||
|
----------------------------------------------------------------------
|
||||||
|
-- Git operations
|
||||||
|
----------------------------------------------------------------------
|
||||||
|
|
||||||
|
-- | 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]
|
||||||
|
|
||||||
|
-- | 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)]
|
||||||
|
|
||||||
|
-- | 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
|
||||||
|
|
||||||
|
----------------------------------------------------------------------
|
||||||
|
-- Notifications
|
||||||
|
----------------------------------------------------------------------
|
||||||
|
|
||||||
|
-- | Send a desktop notification about a merge conflict.
|
||||||
|
notifyConflict :: Options -> IO ()
|
||||||
|
notifyConflict opts = do
|
||||||
|
let cmd = T.unpack (optNotifyCmd opts)
|
||||||
|
title = "Converge: Merge Conflict"
|
||||||
|
body = "A merge conflict occurred in " <> optRepoPath opts
|
||||||
|
<> ". Manual resolution required."
|
||||||
|
_ <- spawnProcess cmd ["--urgency=critical", title, T.unpack body]
|
||||||
|
pure ()
|
||||||
|
|
||||||
|
----------------------------------------------------------------------
|
||||||
|
-- Internal helpers
|
||||||
|
----------------------------------------------------------------------
|
||||||
|
|
||||||
|
runGitIn :: FilePath -> [String] -> IO (ExitCode, Text, Text)
|
||||||
|
runGitIn repoPath args = do
|
||||||
|
(code, out, err) <- readProcessWithExitCode "git" args ""
|
||||||
|
pure (code, T.pack out, T.pack err)
|
||||||
@@ -0,0 +1,4 @@
|
|||||||
|
resolver: lts-24.38
|
||||||
|
|
||||||
|
packages:
|
||||||
|
- .
|
||||||
@@ -0,0 +1,9 @@
|
|||||||
|
module Main (main) where
|
||||||
|
|
||||||
|
import Test.Hspec
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main = hspec $ do
|
||||||
|
describe "Converge" $ do
|
||||||
|
it "compiles" $ do
|
||||||
|
True `shouldBe` True
|
||||||
Reference in New Issue
Block a user