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
|
{- git-annex command
-
- Copyright 2010 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Command.DropUnused where
import Control.Monad (when)
import Control.Monad.State (liftIO)
import qualified Data.Map as M
import System.Directory
import Data.Maybe
import Command
import Types
import Messages
import Locations
import qualified Annex
import qualified Command.Drop
import qualified Command.Move
import qualified Remote
import qualified GitRepo as Git
import Backend
import Key
type UnusedMap = M.Map String Key
command :: [Command]
command = [repoCommand "dropunused" (paramRepeating paramNumber) seek
"drop unused file content"]
seek :: [CommandSeek]
seek = [withUnusedMaps]
{- Read unused logs once, and pass the maps to each start action. -}
withUnusedMaps :: CommandSeek
withUnusedMaps params = do
unused <- readUnusedLog ""
unusedbad <- readUnusedLog "bad"
unusedtmp <- readUnusedLog "tmp"
return $ map (start (unused, unusedbad, unusedtmp)) params
start :: (UnusedMap, UnusedMap, UnusedMap) -> CommandStartString
start (unused, unusedbad, unusedtmp) s = notBareRepo $ search
[ (unused, perform)
, (unusedbad, performOther gitAnnexBadLocation)
, (unusedtmp, performOther gitAnnexTmpLocation)
]
where
search [] = return Nothing
search ((m, a):rest) = do
case M.lookup s m of
Nothing -> search rest
Just key -> do
showStart "dropunused" s
return $ Just $ a key
perform :: Key -> CommandPerform
perform key = do
from <- Annex.getState Annex.fromremote
case from of
Just name -> do
r <- Remote.byName name
showNote $ "from " ++ Remote.name r ++ "..."
return $ Just $ Command.Move.fromCleanup r True key
_ -> do
backend <- keyBackend key
Command.Drop.perform key backend (Just 0) -- force drop
performOther :: (Git.Repo -> Key -> FilePath) -> Key -> CommandPerform
performOther filespec key = do
g <- Annex.gitRepo
let f = filespec g key
e <- liftIO $ doesFileExist f
when e $ liftIO $ removeFile f
return $ Just $ return True
readUnusedLog :: FilePath -> Annex UnusedMap
readUnusedLog prefix = do
g <- Annex.gitRepo
let f = gitAnnexUnusedLog prefix g
e <- liftIO $ doesFileExist f
if e
then do
l <- liftIO $ readFile f
return $ M.fromList $ map parse $ lines l
else return $ M.empty
where
parse line = (head ws, fromJust $ readKey $ unwords $ tail ws)
where
ws = words line
|
