git-annex/Command/PreCommit.hs
Joey Hess 3475b09c3e
pre-commit: Avoid committing the git-annex branch
Except when a commit is made in a view, which changes metadata.

Make the assistant commit the git-annex branch after git commit of working
tree changes.

This allows using the annex.commitmessage-command in the assistant to
generate a commit message for the git-annex branch that relies on state
gathered during the commit of the working tree. Eg, it might reuse the
commit message.

Note that, when not using the assistant, a git-annex add still commits
the git-annex branch, so such a annex.commitmessage-command set up would
not work then. But if someone is using the assistant and wants
programmatic control over commit messages, this is useful. Someone not
using the assistant can get the same result by using annex.alwayscommit=false
during the git-annex add, and git-annex merge after they git commit.

pre-commit was never really intended to commit the git-annex branch
(except after recording changed metadata), but the assistant did sort of
rely on it. It does later commit the git-annex branch before pushing to
remotes, but I didn't want to risk building up lots of uncommitted changes
to it if that didn't happen frequently.

Sponsored-by: the NIH-funded NICEMAN (ReproNim TR&D3) project
2024-02-12 14:42:11 -04:00

88 lines
2.5 KiB
Haskell

{- git-annex command
-
- Copyright 2010-2024 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE CPP #-}
module Command.PreCommit where
import Command
import qualified Command.Fix
import qualified Command.Smudge
import Annex.Hook
import Annex.Link
import Annex.View
import Annex.View.ViewedFile
import Logs.View
import Logs.MetaData
import Types.View
import Types.MetaData
import qualified Annex
import qualified Annex.Branch
import qualified Data.Set as S
import qualified Data.Text as T
cmd :: Command
cmd = noCommit $ command "pre-commit" SectionPlumbing
"run by git pre-commit hook"
paramPaths
(withParams seek)
seek :: CmdParams -> CommandSeek
seek ps = do
let ww = WarnUnmatchWorkTreeItems "pre-commit"
l <- workTreeItems ww ps
-- fix symlinks to files being committed
flip (withFilesToBeCommitted ww) l $ \(si, f) -> commandAction $
maybe stop (Command.Fix.start Command.Fix.FixSymlinks si f)
=<< isAnnexLink f
-- after a merge conflict or git cherry-pick or stash, pointer
-- files in the worktree won't be populated, so populate them here
Command.Smudge.updateSmudged (Restage False)
runAnnexHook preCommitAnnexHook
-- committing changes to a view updates metadata
currentView >>= \case
Nothing -> noop
Just (v, _madj) -> do
withViewChanges
(addViewMetaData v)
(removeViewMetaData v)
-- Manually commit in this case, because
-- noCommit prevents automatic commit.
whenM (annexAlwaysCommit <$> Annex.getGitConfig) $
Annex.Branch.commit =<< Annex.Branch.commitMessage
addViewMetaData :: View -> ViewedFile -> Key -> CommandStart
addViewMetaData v f k = starting "metadata" ai si $
next $ changeMetaData k $ fromView v f
where
ai = mkActionItem (k, toRawFilePath f)
si = SeekInput []
removeViewMetaData :: View -> ViewedFile -> Key -> CommandStart
removeViewMetaData v f k = starting "metadata" ai si $
next $ changeMetaData k $ unsetMetaData $ fromView v f
where
ai = mkActionItem (k, toRawFilePath f)
si = SeekInput []
changeMetaData :: Key -> MetaData -> CommandCleanup
changeMetaData k metadata = do
showMetaDataChange metadata
addMetaData k metadata
return True
showMetaDataChange :: MetaData -> Annex ()
showMetaDataChange = showLongNote . UnquotedString . unlines . concatMap showmeta . fromMetaData
where
showmeta (f, vs) = map (showmetavalue f) $ S.toList vs
showmetavalue f v = T.unpack (fromMetaField f) <> showset v <> "=" <> decodeBS (fromMetaValue v)
showset v
| isSet v = "+"
| otherwise = "-"