1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
|
{- git-annex command
-
- Copyright 2010-2014 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
{-# LANGUAGE CPP #-}
module Command.PreCommit where
import Command
import Config
import qualified Command.Add
import qualified Command.Fix
import qualified Command.Smudge
import Annex.Direct
import Annex.Hook
import Annex.Link
import Annex.View
import Annex.Version
import Annex.View.ViewedFile
import Annex.LockFile
import Logs.View
import Logs.MetaData
import Types.View
import Types.MetaData
import qualified Git.Index as Git
import qualified Git.LsFiles as Git
import qualified Data.Set as S
import qualified Data.Text as T
cmd :: Command
cmd = command "pre-commit" SectionPlumbing
"run by git pre-commit hook"
paramPaths
(withParams seek)
seek :: CmdParams -> CommandSeek
seek ps = lockPreCommitHook $ ifM isDirect
( do
-- update direct mode mappings for committed files
withWords (commandAction . startDirect) ps
runAnnexHook preCommitAnnexHook
, do
ifM (not <$> versionSupportsUnlockedPointers <&&> liftIO Git.haveFalseIndex)
( do
(fs, cleanup) <- inRepo $ Git.typeChangedStaged ps
whenM (anyM isOldUnlocked fs) $
giveup "Cannot make a partial commit with unlocked annexed files. You should `git annex add` the files you want to commit, and then run git commit."
void $ liftIO cleanup
, do
l <- workTreeItems ps
-- fix symlinks to files being committed
flip withFilesToBeCommitted l $ \f -> commandAction $
maybe stop (Command.Fix.start Command.Fix.FixSymlinks f)
=<< isAnnexLink f
ifM versionSupportsUnlockedPointers
-- 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
-- When there's a false index,
-- restaging the files won't work.
. Restage =<< liftIO Git.haveFalseIndex
-- inject unlocked files into the annex
-- (not needed when repo version uses
-- unlocked pointer files)
, withFilesOldUnlockedToBeCommitted (commandAction . startInjectUnlocked) l
)
)
runAnnexHook preCommitAnnexHook
-- committing changes to a view updates metadata
mv <- currentView
case mv of
Nothing -> noop
Just v -> withViewChanges
(addViewMetaData v)
(removeViewMetaData v)
)
startInjectUnlocked :: FilePath -> CommandStart
startInjectUnlocked f = next $ do
unlessM (callCommandAction $ Command.Add.start f) $
error $ "failed to add " ++ f ++ "; canceling commit"
next $ return True
startDirect :: [String] -> CommandStart
startDirect _ = next $ next preCommitDirect
addViewMetaData :: View -> ViewedFile -> Key -> CommandStart
addViewMetaData v f k = do
showStart "metadata" f
next $ next $ changeMetaData k $ fromView v f
removeViewMetaData :: View -> ViewedFile -> Key -> CommandStart
removeViewMetaData v f k = do
showStart "metadata" f
next $ next $ changeMetaData k $ unsetMetaData $ fromView v f
changeMetaData :: Key -> MetaData -> CommandCleanup
changeMetaData k metadata = do
showMetaDataChange metadata
addMetaData k metadata
return True
showMetaDataChange :: MetaData -> Annex ()
showMetaDataChange = showLongNote . 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 = "-"
{- Takes exclusive lock; blocks until available. -}
lockPreCommitHook :: Annex a -> Annex a
lockPreCommitHook = withExclusiveLock gitAnnexPreCommitLock
|
