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
|
{- git-annex command
-
- Copyright 2010,2012,2018 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE OverloadedStrings #-}
module Command.DropUnused where
import Command
import qualified Annex
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 = withAnnexOptions [jobsOption, jsonOptions] $
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 = startConcurrency commandStages $ do
numcopies <- getNumCopies
mincopies <- getMinCopies
from <- maybe (pure Nothing) (Just <$$> getParsed) (dropFrom o)
withUnusedMaps (start from numcopies mincopies) (rangesToDrop o)
start :: Maybe Remote -> NumCopies -> MinCopies -> UnusedMaps -> Int -> CommandStart
start from numcopies mincopies = startUnused
(go (perform from numcopies mincopies))
(go (performOther gitAnnexBadLocation))
(go (performOther gitAnnexTmpObjectLocation))
where
go a n key = starting "dropunused"
(ActionItemOther $ Just $ UnquotedString $ show n)
(SeekInput [show n])
(a key)
perform :: Maybe Remote -> NumCopies -> MinCopies -> Key -> CommandPerform
perform from numcopies mincopies key = case from of
Just r -> do
showAction $ UnquotedString $ "from " ++ Remote.name r
Command.Drop.performRemote NoLiveUpdate pcc key
(AssociatedFile Nothing) numcopies mincopies r ud
Nothing -> ifM (inAnnex key)
( droplocal
, ifM (objectFileExists key)
( ifM (Annex.getRead Annex.force)
( droplocal
, do
warning "Annexed object has been modified and dropping it would probably lose the only copy. Run this command with --force if you want to drop it anyway."
next $ return False
)
, next $ return True
)
)
where
droplocal = Command.Drop.performLocal NoLiveUpdate pcc
key (AssociatedFile Nothing) numcopies mincopies [] ud
pcc = Command.Drop.PreferredContentChecked False
ud = Command.Drop.DroppingUnused True
performOther :: (Key -> Git.Repo -> OsPath) -> Key -> CommandPerform
performOther filespec key = do
f <- fromRepo $ filespec key
pruneTmpWorkDirBefore f (liftIO . removeWhenExistsWith removeFile)
next $ return True
|
