git-monitor 3.1.1.5 → 3.2.1
raw patch · 3 files changed
+136/−28 lines, 3 filesdep −lifted-asyncdep ~gitlibdep ~gitlib-libgit2
Dependencies removed: lifted-async
Dependency ranges changed: gitlib, gitlib-libgit2
Files
- Main.hs +90/−23
- README.md +42/−0
- git-monitor.cabal +4/−5
Main.hs view
@@ -34,6 +34,7 @@ import Shelly (silently, shelly, run) import System.Directory import System.FilePath.Posix+import Data.List (isInfixOf) #if !MIN_VERSION_time (1,5,0) import System.Locale (defaultTimeLocale) #endif@@ -44,6 +45,7 @@ , optDebug :: Bool , optGitDir :: FilePath , optWorkingDir :: FilePath+ , optRefName :: String , optInterval :: Int , optResume :: Bool }@@ -54,10 +56,12 @@ <*> switch (short 'v' <> long "verbose" <> help "Display more info") <*> switch (short 'D' <> long "debug" <> help "Display debug") <*> strOption- (long "git-dir" <> value ".git"+ (long "git-dir" <> value "some.git.directory" <> help "Git repository to store snapshots in (def: \".git\")") <*> strOption (short 'd' <> long "work-dir" <> value "" <> help "The working tree to snapshot (def: \".\")")+ <*> strOption (short 'r' <> long "ref" <> value "HEAD"+ <> help "The ref name whose work should be tracked") <*> option auto (short 'i' <> long "interval" <> value 60 <> help "Snapshot each N seconds") <*> switch (short 'r' <> long "resume"@@ -86,29 +90,22 @@ (,) <$> (T.init <$> run "git" ["config", "user.name"]) <*> (T.init <$> run "git" ["config", "user.email"]) - let gDir = optGitDir opts- isDir <- doesDirectoryExist gDir- gd <- if isDir- then return gDir- else shelly $ silently $- T.unpack . T.init <$> run "git" ["rev-parse", "--git-dir"]-- let wDir = optWorkingDir opts- wd = if null wDir then takeDirectory gd else wDir+ -- Determine the git directory and working directory+ -- Handle both regular clones (.git is a directory) and worktrees (.git is a file)+ (gd, wd) <- resolveGitDir (optGitDir opts) (optWorkingDir opts) -- Make sure we're in a known branch, and if so, let it begin forever $ withRepository lgFactory gd $ do log' $ pack $ "Working tree: " ++ wd- ref <- lookupReference "HEAD"- case ref of- Just (RefSymbolic name) -> do- log' $ "Tracking branch " <> name- log' $ "Saving snapshots under " <> T.pack gd- log' $ "Snapshot ref is refs/snapshots/" <> name- void $ start wd userName userEmail name- _ -> do- log' "Cannot use git-monitor if no branch is checked out"- liftIO $ threadDelay (optInterval opts * 1000000)+ let rname = T.pack (optRefName opts)+ ref <- lookupReference rname+ let name = case ref of+ Just (RefSymbolic name) -> name+ _ -> rname+ log' $ "Tracking branch " <> name+ log' $ "Saving snapshots under " <> T.pack gd+ log' $ "Snapshot ref is refs/snapshots/" <> name+ void $ start wd userName userEmail name where start wd userName userEmail ref = do let sref = "refs/snapshots/" <> ref@@ -125,7 +122,7 @@ scr <- if optResume opts then resolveReference sref else return Nothing- scr' <- maybe (resolveReference "HEAD") (return . Just) scr+ scr' <- maybe (resolveReference ref) (return . Just) scr case scr' of Nothing -> errorL "Failed to lookup reference" Just r -> do@@ -141,6 +138,75 @@ mutateTreeOid toid $ snapshotTree opts wd userName userEmail ref sref sc toid ft +-- | Resolve the git directory, handling both regular repositories and worktrees.+-- In a worktree, .git is a file containing "gitdir: /path/to/.git/worktrees/name"+resolveGitDir :: FilePath -> FilePath -> IO (FilePath, FilePath)+resolveGitDir userGitDir userWorkDir = do+ -- First, try .git in current directory (handles worktrees properly)+ let defaultGitPath = ".git"++ -- Check if user specified a custom git-dir or we should use default+ let gDir = if userGitDir == "some.git.directory" then defaultGitPath else userGitDir++ isDir <- doesDirectoryExist gDir+ if isDir+ then do+ -- Regular clone: .git is a directory+ let wd = if null userWorkDir then takeDirectory gDir else userWorkDir+ -- If gDir is ".git", working dir should be "." not ""+ let wd' = if wd == "" then "." else wd+ return (gDir, wd')+ else do+ -- Check if .git is a file (worktree case)+ isFile <- doesFileExist gDir+ if isFile+ then parseWorktreeGitFile gDir userWorkDir+ else do+ -- Neither file nor directory at specified path, use git command+ gitDir <- shelly $ silently $+ T.unpack . T.init <$> run "git" ["rev-parse", "--git-dir"]+ -- Check if this is a worktree path+ isWorktreeDir <- doesDirectoryExist gitDir+ if isWorktreeDir && "/worktrees/" `isInfixOf` gitDir+ then do+ -- Extract main .git dir from worktree path+ let mainGitDir = takeDirectory $ takeDirectory gitDir+ cwd <- getCurrentDirectory+ let wd = if null userWorkDir then cwd else userWorkDir+ return (mainGitDir, wd)+ else do+ let wd = if null userWorkDir then takeDirectory gitDir else userWorkDir+ let wd' = if wd == "" then "." else wd+ return (gitDir, wd')++-- | Parse a .git file (used in worktrees) to extract the actual git directory+parseWorktreeGitFile :: FilePath -> FilePath -> IO (FilePath, FilePath)+parseWorktreeGitFile gitFile userWorkDir = do+ contents <- B.readFile gitFile+ let gitdirLine = T.strip $ T.decodeUtf8 contents+ case T.stripPrefix "gitdir: " gitdirLine of+ Just worktreeGitDir -> do+ -- For worktrees, we need the main repo's .git dir+ -- The worktree git dir looks like: /path/to/.git/worktrees/name+ -- We need to get: /path/to/.git+ let worktreePath = T.unpack worktreeGitDir+ mainGitDir = takeDirectory $ takeDirectory worktreePath++ -- The working directory should be the worktree root (parent of .git file)+ let wd = if null userWorkDir+ then takeDirectory gitFile+ else userWorkDir+ -- If gitFile is ".git", working dir should be "."+ let wd' = if wd == "" then "." else wd+ return (mainGitDir, wd')+ Nothing -> do+ -- File doesn't have gitdir: line, fall back to git command+ gitDir <- shelly $ silently $+ T.unpack . T.init <$> run "git" ["rev-parse", "--git-dir"]+ let wd = if null userWorkDir then takeDirectory gitDir else userWorkDir+ let wd' = if wd == "" then "." else wd+ return (gitDir, wd')+ -- | 'snapshotTree' is the core workhorse of this utility. It periodically -- checks the filesystem for changes to Git-tracked files, and snapshots any -- changes that have occurred in them.@@ -188,8 +254,9 @@ liftIO $ threadDelay (optInterval opts * 1000000) -- Rinse, wash, repeat.- ref' <- lift $ lookupReference "HEAD"- let curRef = case ref' of Just (RefSymbolic ref'') -> ref''; _ -> ""+ let rname = T.pack (optRefName opts)+ ref' <- lift $ lookupReference rname+ let curRef = case ref' of Just (RefSymbolic ref'') -> ref''; _ -> rname if ref /= curRef then lift $ log' $ "Branch changed to " <> curRef <> ", restarting" else loop sc' toid' ft'
README.md view
@@ -0,0 +1,42 @@+# git-monitor++Passively snapshots working tree changes efficiently.++## Building++This package is part of the gitlib multi-package repository. Build from the repository root:++```bash+# From the gitlib repository root+nix build # Builds git-monitor (default package)+```++Or from this directory:++```bash+# From git-monitor directory+nix build ../#default+```++## Development++For development with direnv:++```bash+# From git-monitor directory+direnv allow # The .envrc file loads the parent flake+```++Or manually enter the development shell:++```bash+nix develop ../#default+```++## Dependencies++- gitlib >= 3.3.0+- gitlib-libgit2 >= 3.3.0+- Other dependencies listed in git-monitor.cabal++All dependencies are managed at the repository root level via the main flake.nix and cabal.project files.
git-monitor.cabal view
@@ -1,5 +1,5 @@ Name: git-monitor-Version: 3.1.1.5+Version: 3.2.1 Synopsis: Passively snapshots working tree changes efficiently. Description: Passively snapshots working tree changes efficiently.@@ -21,8 +21,8 @@ ghc-options: -Wall -threaded -rtsopts Build-depends: base >= 4 && < 5- , gitlib >= 3.1.1- , gitlib-libgit2 >= 3.1.1+ , gitlib >= 3.3.0+ , gitlib-libgit2 >= 3.3.0 , bytestring >= 0.9.2.1 , containers >= 0.4.2.1 , directory >= 1.1.0.2@@ -37,9 +37,8 @@ , time >= 1.4 , transformers >= 0.3.0.0 , unordered-containers >= 0.2.3.0- , lifted-async >= 0.1.1 , unix Source-repository head type: git- location: git://github.com/jwiegley/gitlib+ location: https://github.com/jwiegley/gitlib