summaryrefslogtreecommitdiff
path: root/Command/DropUnused.hs
blob: 63216ce4f103d20696aea9a3da416e760d86e6a3 (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
{- 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 Command
import Types
import Messages
import Locations
import qualified Annex
import qualified Command.Drop
import Backend

command :: [Command]
command = [Command "dropunused" (paramRepeating paramNumber) seek
	"drop unused file content"]

seek :: [CommandSeek]
seek = [withStrings start]

{- Drops unused content by number. -} 
start :: CommandStartString
start s = do
	m <- readUnusedLog
	case M.lookup s m of
		Nothing -> return Nothing
		Just key -> do
			g <- Annex.gitRepo
			showStart "dropunused" s
			backend <- keyBackend key
			-- drop both content in the backend and any tmp
			-- file for the key
			let tmp = gitAnnexTmpLocation g key
			tmp_exists <- liftIO $ doesFileExist tmp
			when tmp_exists $ liftIO $ removeFile tmp
			return $ Just $ Command.Drop.perform key backend (Just 0)

readUnusedLog :: Annex (M.Map String Key)
readUnusedLog = do
	g <- Annex.gitRepo
	let f = gitAnnexUnusedLog 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, tokey $ unwords $ tail ws)
			where
				ws = words line
				tokey s = read s :: Key