git-annex/Annex/Hook.hs
Joey Hess ca7de61454
git post-checkout and post-merge hooks
* init, upgrade: Install git post-checkout and post-merge hooks that run
  git annex smudge --update.
* precommit: Run git annex smudge --update, because the post-merge
  hook is not run when there is a merge conflict. So the work tree will
  be updated when a commit is made to resolve the merge conflict.
* precommit: Run git annex smudge --update, because the post-merge
  hook is not run when there is a merge conflict. So the work tree will
  be updated when a commit is made to resolve the merge conflict.
* Note that git has no hooks run after git stash or git cherry-pick,
  so the user will have to manually run git annex smudge --update
  after such commands.

Nothing currently installs the hooks into v6 repos that already exist.
Something will need to be done about that, either move this behavior to v7,
or document that the user will need to manually fix up their v6 repos.

This commit was sponsored by Eric Drechsel on Patreon.
2018-10-25 15:59:51 -04:00

91 lines
2.8 KiB
Haskell

{- git-annex git hooks
-
- Note that it's important that the scripts installed by git-annex
- not change, otherwise removing old hooks using an old version of
- the script would fail.
-
- Copyright 2013-2018 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Annex.Hook where
import Annex.Common
import qualified Git.Hook as Git
import Config
import qualified Annex
import Utility.Shell
import qualified Data.Map as M
preCommitHook :: Git.Hook
preCommitHook = Git.Hook "pre-commit" (mkHookScript "git annex pre-commit .") []
postReceiveHook :: Git.Hook
postReceiveHook = Git.Hook "post-receive"
-- Only run git-annex post-receive when git-annex supports it,
-- to avoid failing if the repository with this hook is used
-- with an older version of git-annex.
(mkHookScript "if git annex post-receive --help >/dev/null 2>&1; then git annex post-receive; fi")
-- This is an old version of the hook script.
[ mkHookScript "git annex post-receive"
]
postCheckoutHook :: Git.Hook
postCheckoutHook = Git.Hook "post-checkout" smudgeHook []
postMergeHook :: Git.Hook
postMergeHook = Git.Hook "post-merge" smudgeHook []
-- Only run git-annex smudge --update when git-annex supports it.
-- Older versions of git-annex didn't need this hook.
smudgeHook :: String
smudgeHook = mkHookScript "if git annex smudge --update >/dev/null 2>&1; then git-annex smudge --update; fi"
preCommitAnnexHook :: Git.Hook
preCommitAnnexHook = Git.Hook "pre-commit-annex" "" []
postUpdateAnnexHook :: Git.Hook
postUpdateAnnexHook = Git.Hook "post-update-annex" "" []
mkHookScript :: String -> String
mkHookScript s = unlines
[ shebang
, "# automatically configured by git-annex"
, s
]
hookWrite :: Git.Hook -> Annex ()
hookWrite h =
-- cannot have git hooks in a crippled filesystem (no execute bit)
unlessM crippledFileSystem $
unlessM (inRepo $ Git.hookWrite h) $
hookWarning h "already exists, not configuring"
hookUnWrite :: Git.Hook -> Annex ()
hookUnWrite h = unlessM (inRepo $ Git.hookUnWrite h) $
hookWarning h "contents modified; not deleting. Edit it to remove call to git annex."
hookWarning :: Git.Hook -> String -> Annex ()
hookWarning h msg = do
r <- gitRepo
warning $ Git.hookName h ++ " hook (" ++ Git.hookFile h r ++ ") " ++ msg
{- Runs a hook. To avoid checking if the hook exists every time,
- the existing hooks are cached. -}
runAnnexHook :: Git.Hook -> Annex ()
runAnnexHook hook = do
m <- Annex.getState Annex.existinghooks
case M.lookup hook m of
Just True -> run
Just False -> noop
Nothing -> do
exists <- inRepo $ Git.hookExists hook
Annex.changeState $ \s -> s
{ Annex.existinghooks = M.insert hook exists m }
when exists run
where
run = unlessM (inRepo $ Git.runHook hook) $ do
h <- fromRepo $ Git.hookFile hook
warning $ h ++ " failed"