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
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
|
{- git-annex command
-
- Copyright 2010, 2013 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Command.Add where
import Command
import Annex.Ingest
import Logs.Location
import Annex.Content
import Annex.Content.Direct
import qualified Annex
import qualified Annex.Queue
import qualified Database.Keys
import Config
import Annex.FileMatcher
import Annex.Version
cmd :: Command
cmd = notBareRepo $ withGlobalOptions (jobsOption : jsonOption : fileMatchingOptions) $
command "add" SectionCommon "add files to annex"
paramPaths (seek <$$> optParser)
data AddOptions = AddOptions
{ addThese :: CmdParams
, includeDotFiles :: Bool
, batchOption :: BatchMode
}
optParser :: CmdParamsDesc -> Parser AddOptions
optParser desc = AddOptions
<$> cmdParams desc
<*> switch
( long "include-dotfiles"
<> help "don't skip dotfiles"
)
<*> parseBatchOption
{- Add acts on both files not checked into git yet, and unlocked files.
-
- In direct mode, it acts on any files that have changed. -}
seek :: AddOptions -> CommandSeek
seek o = allowConcurrentOutput $ do
matcher <- largeFilesMatcher
let gofile file = ifM (checkFileMatcher matcher file <||> Annex.getState Annex.force)
( start file
, ifM (annexAddSmallFiles <$> Annex.getGitConfig)
( startSmall file
, stop
)
)
case batchOption o of
Batch -> batchFiles gofile
NoBatch -> do
let go a = a gofile (addThese o)
go (withFilesNotInGit (not $ includeDotFiles o))
ifM (versionSupportsUnlockedPointers <||> isDirect)
( go withFilesMaybeModified
, go withFilesOldUnlocked
)
{- Pass file off to git-add. -}
startSmall :: FilePath -> CommandStart
startSmall file = do
showStart "add" file
next $ next $ addSmall file
addSmall :: FilePath -> Annex Bool
addSmall file = do
showNote "non-large file; adding content to git repository"
addFile file
addFile :: FilePath -> Annex Bool
addFile file = do
ps <- forceParams
Annex.Queue.addCommand "add" (ps++[Param "--"]) [file]
return True
start :: FilePath -> CommandStart
start file = ifAnnexed file addpresent add
where
add = do
ms <- liftIO $ catchMaybeIO $ getSymbolicLinkStatus file
case ms of
Nothing -> stop
Just s
| not (isRegularFile s) && not (isSymbolicLink s) -> stop
| otherwise -> do
showStart "add" file
next $ if isSymbolicLink s
then next $ addFile file
else perform file
addpresent key = ifM versionSupportsUnlockedPointers
( do
ms <- liftIO $ catchMaybeIO $ getSymbolicLinkStatus file
case ms of
Just s | isSymbolicLink s -> fixuplink key
_ -> ifM (sameInodeCache file =<< Database.Keys.getInodeCaches key)
( stop, add )
, ifM isDirect
( do
ms <- liftIO $ catchMaybeIO $ getSymbolicLinkStatus file
case ms of
Just s | isSymbolicLink s -> fixuplink key
_ -> ifM (goodContent key file)
( stop , add )
, fixuplink key
)
)
fixuplink key = do
-- the annexed symlink is present but not yet added to git
showStart "add" file
liftIO $ removeFile file
next $ next $ do
addLink file key Nothing
cleanup key =<< inAnnex key
perform :: FilePath -> CommandPerform
perform file = do
lockingfile <- not <$> addUnlocked
let cfg = LockDownConfig
{ lockingFile = lockingfile
, hardlinkFileTmp = True
}
lockDown cfg file >>= ingestAdd >>= finish
where
finish (Just key) = next $ cleanup key True
finish Nothing = stop
cleanup :: Key -> Bool -> CommandCleanup
cleanup key hascontent = do
maybeShowJSON [("key", key2file key)]
when hascontent $
logStatus key InfoPresent
return True
|
