summaryrefslogtreecommitdiff
path: root/Command/DropUnused.hs
blob: 46f2dc9f7f93dd592b3492697a529ae8c4ed804e (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
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
{- git-annex command
 -
 - Copyright 2010 Joey Hess <joey@kitenet.net>
 -
 - Licensed under the GNU GPL version 3 or higher.
 -}

module Command.DropUnused where

import qualified Data.Map as M

import Common.Annex
import Command
import qualified Annex
import qualified Command.Drop
import qualified Remote
import qualified Git
import Types.Key

type UnusedMap = M.Map String Key

command :: [Command]
command = [Command "dropunused" (paramRepeating paramNumber) (noTo >> needsRepo)
	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) -> FilePath -> CommandStart
start (unused, unusedbad, unusedtmp) s = notBareRepo $ search
	[ (unused, perform)
	, (unusedbad, performOther gitAnnexBadLocation)
	, (unusedtmp, performOther gitAnnexTmpLocation)
	]
	where
		search [] = stop
		search ((m, a):rest) =
			case M.lookup s m of
				Nothing -> search rest
				Just key -> do
					showStart "dropunused" s
					next $ a key

perform :: Key -> CommandPerform
perform key = maybe droplocal dropremote =<< Annex.getState Annex.fromremote
	where
		dropremote name = do
			r <- Remote.byName name
			showAction $ "from " ++ Remote.name r
			next $ Command.Drop.cleanupRemote key r
		droplocal = Command.Drop.performLocal key (Just 0) -- force drop

performOther :: (Git.Repo -> Key -> FilePath) -> Key -> CommandPerform
performOther filespec key = do
	g <- gitRepo
	let f = filespec g key
	liftIO $ whenM (doesFileExist f) $ removeFile f
	next $ return True

readUnusedLog :: FilePath -> Annex UnusedMap
readUnusedLog prefix = do
	g <- gitRepo
	let f = gitAnnexUnusedLog prefix g
	e <- liftIO $ doesFileExist f
	if e
		then return . M.fromList . map parse . lines
			=<< liftIO (readFile f)
		else return M.empty
	where
		parse line = (head ws, fromJust $ readKey $ unwords $ tail ws)
			where
				ws = words line