blob: 1793ddedb78152be3fa54b02b09f8ecfb7e8b70e (
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
|
{- git-annex command
-
- Copyright 2015 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Command.Clean where
import Common.Annex
import Command
import Annex.Content
import Annex.MetaData
import Annex.FileMatcher
import Types.KeySource
import Types.Key
import Backend
import qualified Data.ByteString.Lazy as B
cmd :: Command
cmd = dontCheck repoExists $
command "clean" SectionPlumbing
"git clean filter"
paramFile (withParams seek)
seek :: CmdParams -> CommandSeek
seek = withWords start
start :: [String] -> CommandStart
start [file] = do
ifM (shouldAnnex file)
( do
k <- ingest file
liftIO $ putStrLn (key2file k)
, liftIO $ B.hGetContents stdin >>= B.hPut stdout -- cat file
)
stop
start [] = error "clean filter run without filename; upgrade git"
start _ = error "clean filter passed multiple filenames"
shouldAnnex :: FilePath -> Annex Bool
shouldAnnex file = do
matcher <- largeFilesMatcher
checkFileMatcher matcher file
ingest :: FilePath -> Annex Key
ingest file = do
backend <- chooseBackend file
let source = KeySource
{ keyFilename = file
, contentLocation = file
, inodeCache = Nothing
}
k <- fst . fromMaybe (error "failed to generate a key")
<$> genKey source backend
-- Hard link (or copy) file content to annex
-- to prevent it from being lost when git checks out
-- a branch not containing this file.
unlessM (linkAnnex k file) $
error "Problem adding file to the annex"
genMetaData k file
=<< liftIO (getFileStatus file)
return k
|