3475b09c3e
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
88 lines
2.5 KiB
Haskell
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 = "-"
|