blob: c5a61d7391924f52f9aa1ec03e1181aa097170de (
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
|
{- git-annex command
-
- Copyright 2010,2012 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Command.DropUnused where
import Command
import qualified Command.Drop
import qualified Remote
import qualified Git
import Command.Unused (withUnusedMaps, UnusedMaps(..), startUnused)
import Annex.NumCopies
import Annex.Content
cmd :: Command
cmd = command "dropunused" SectionMaintenance
"drop unused file content"
(paramRepeating paramNumRange) (seek <$$> optParser)
data DropUnusedOptions = DropUnusedOptions
{ rangesToDrop :: CmdParams
, dropFrom :: Maybe (DeferredParse Remote)
}
optParser :: CmdParamsDesc -> Parser DropUnusedOptions
optParser desc = DropUnusedOptions
<$> cmdParams desc
<*> optional (Command.Drop.parseDropFromOption)
seek :: DropUnusedOptions -> CommandSeek
seek o = do
numcopies <- getNumCopies
from <- maybe (pure Nothing) (Just <$$> getParsed) (dropFrom o)
withUnusedMaps (start from numcopies) (rangesToDrop o)
start :: Maybe Remote -> NumCopies -> UnusedMaps -> Int -> CommandStart
start from numcopies = startUnused "dropunused"
(perform from numcopies)
(performOther gitAnnexBadLocation)
(performOther gitAnnexTmpObjectLocation)
perform :: Maybe Remote -> NumCopies -> Key -> CommandPerform
perform from numcopies key = case from of
Just r -> do
showAction $ "from " ++ Remote.name r
Command.Drop.performRemote key (AssociatedFile Nothing) numcopies r
Nothing -> ifM (inAnnex key)
( Command.Drop.performLocal key (AssociatedFile Nothing) numcopies []
, next (return True)
)
performOther :: (Key -> Git.Repo -> FilePath) -> Key -> CommandPerform
performOther filespec key = do
f <- fromRepo $ filespec key
pruneTmpWorkDirBefore f (liftIO . nukeFile)
next $ return True
|
