diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -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' diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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. diff --git a/git-monitor.cabal b/git-monitor.cabal --- a/git-monitor.cabal +++ b/git-monitor.cabal @@ -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