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
|
{- git-annex core functions -}
module Core where
import Maybe
import System.IO
import System.Directory
import Control.Monad.State (liftIO)
import System.Path
import Types
import Locations
import LocationLog
import UUID
import qualified GitRepo as Git
import qualified Annex
import Utility
{- Sets up a git repo for git-annex. -}
startup :: [Flag] -> Annex ()
startup flags = do
mapM (\f -> Annex.flagChange f True) flags
g <- Annex.gitRepo
liftIO $ gitAttributes g
prepUUID
{- When git-annex is done, it runs this. -}
shutdown :: Annex ()
shutdown = do
g <- Annex.gitRepo
nocommit <- Annex.flagIsSet NoCommit
needcommit <- Annex.flagIsSet NeedCommit
if (needcommit && not nocommit)
then liftIO $ Git.run g ["commit", "-q", "-m",
"git-annex log update", gitStateDir g]
else return ()
{- configure git to use union merge driver on state files, if it is not
- already -}
gitAttributes :: Git.Repo -> IO ()
gitAttributes repo = do
exists <- doesFileExist attributes
if (not exists)
then do
writeFile attributes $ attrLine ++ "\n"
commit
else do
content <- readFile attributes
if (all (/= attrLine) (lines content))
then do
appendFile attributes $ attrLine ++ "\n"
commit
else return ()
where
attrLine = stateLoc ++ "*.log merge=union"
attributes = Git.attributes repo
commit = do
Git.run repo ["add", attributes]
Git.run repo ["commit", "-m", "git-annex setup",
attributes]
{- Checks if a given key is currently present in the annexLocation -}
inAnnex :: Key -> Annex Bool
inAnnex key = do
g <- Annex.gitRepo
liftIO $ doesFileExist $ annexLocation g key
{- Adds, optionally also commits a file to git.
-
- All changes to the git repository should go through this function.
-
- This is careful to not rely on the index. It may have staged changes,
- so only use operations that avoid committing such changes.
-}
gitAdd :: FilePath -> Maybe String -> Annex ()
gitAdd file commitmessage = do
nocommit <- Annex.flagIsSet NoCommit
if (nocommit)
then return ()
else do
g <- Annex.gitRepo
liftIO $ Git.run g ["add", file]
if (isJust commitmessage)
then liftIO $ Git.run g ["commit", "-m",
(fromJust commitmessage), file]
else Annex.flagChange NeedCommit True
{- Calculates the relative path to use to link a file to a key. -}
calcGitLink :: FilePath -> Key -> Annex FilePath
calcGitLink file key = do
g <- Annex.gitRepo
cwd <- liftIO $ getCurrentDirectory
let absfile = case (absNormPath cwd file) of
Just f -> f
Nothing -> error $ "unable to normalize " ++ file
return $ (relPathDirToDir (parentDir absfile) (Git.workTree g)) ++
annexLocationRelative g key
{- Updates the LocationLog when a key's presence changes. -}
logStatus :: Key -> LogStatus -> Annex ()
logStatus key status = do
g <- Annex.gitRepo
u <- getUUID g
f <- liftIO $ logChange g key u status
gitAdd f Nothing -- all logs are committed at end
|
