blob: cca2e8faef6f0ec1d88621979f7405a534f24fb1 (
plain)
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
123
|
{- git-annex command
-
- Copyright 2010 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Command.Init where
import Control.Monad.State (liftIO)
import Control.Monad (when, unless)
import System.Directory
import System.FilePath
import Command
import qualified Annex
import qualified GitRepo as Git
import UUID
import Version
import Messages
import Locations
import Types
import Utility
command :: [Command]
command = [repoCommand "init" paramDesc seek
"initialize git-annex with repository description"]
seek :: [CommandSeek]
seek = [withString start]
{- Stores description for the repository etc. -}
start :: CommandStartString
start description = do
when (null description) $
error "please specify a description of this repository\n"
showStart "init" description
return $ Just $ perform description
perform :: String -> CommandPerform
perform description = do
g <- Annex.gitRepo
u <- getUUID g
setVersion
if Git.repoIsLocalBare g
then do
showLongNote $
"This is a bare repository, so its description cannot be committed.\n" ++
"To record the description, run this command in a clone of this repository:\n" ++
" git annex describe " ++ show u ++ " " ++ show description ++ "\n\n"
return $ Just $ return True
else do
describeUUID u description
liftIO $ gitAttributesWrite g
gitPreCommitHookWrite g
return $ Just cleanup
cleanup :: CommandCleanup
cleanup = do
g <- Annex.gitRepo
logfile <- uuidLog
liftIO $ Git.run g "add" [File logfile]
liftIO $ Git.run g "commit"
[ Params "-q -m"
, Param "git annex repository description"
, File logfile
]
return True
{- configure git to use union merge driver on state files, if it is not
- already -}
gitAttributesWrite :: Git.Repo -> IO ()
gitAttributesWrite repo = do
exists <- doesFileExist attributes
if not exists
then do
safeWriteFile attributes $ unlines attrLines
commit
else do
content <- readFile attributes
let present = lines content
let missing = filter (\l -> not $ l `elem` present) attrLines
unless (null missing) $ do
appendFile attributes $ unlines missing
commit
where
attributes = Git.attributes repo
commit = do
Git.run repo "add" [Param attributes]
Git.run repo "commit"
[ Params "-q -m"
, Param "git-annex setup"
, Param attributes
]
attrLines :: [String]
attrLines =
[ stateDir </> "*.log merge=union"
, stateDir </> "*/*/*.log merge=union"
]
{- set up a git pre-commit hook, if one is not already present -}
gitPreCommitHookWrite :: Git.Repo -> Annex ()
gitPreCommitHookWrite repo = do
exists <- liftIO $ doesFileExist hook
if exists
then warning $ "pre-commit hook (" ++ hook ++ ") already exists, not configuring"
else liftIO $ do
safeWriteFile hook preCommitScript
p <- getPermissions hook
setPermissions hook $ p {executable = True}
where
hook = preCommitHook repo
preCommitHook :: Git.Repo -> FilePath
preCommitHook repo =
Git.workTree repo ++ "/" ++ Git.gitDir repo ++ "/hooks/pre-commit"
preCommitScript :: String
preCommitScript =
"#!/bin/sh\n" ++
"# automatically configured by git-annex\n" ++
"git annex pre-commit .\n"
|