summaryrefslogtreecommitdiff
path: root/Assistant/Unused.hs
blob: 3ad98c12e292c5073f4a3ed748e47efd378b5307 (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
81
82
83
84
85
86
{- git-annex assistant unused files
 -
 - Copyright 2014 Joey Hess <joey@kitenet.net>
 -
 - Licensed under the GNU GPL version 3 or higher.
 -}

{-# LANGUAGE OverloadedStrings #-}

module Assistant.Unused where

import qualified Data.Map as M

import Assistant.Common
import qualified Git
import Types.Key
import Logs.Unused
import Logs.Location
import Annex.Content
import Utility.DataUnits
import Utility.DiskFree
import Utility.HumanTime
import Utility.Tense

import Data.Time.Clock.POSIX
import qualified Data.Text as T

describeUnused :: Assistant (Maybe TenseText)
describeUnused = describeUnused' False

describeUnusedWhenBig :: Assistant (Maybe TenseText)
describeUnusedWhenBig = describeUnused' True

{- This uses heuristics: 1000 unused keys, or more unused keys 
 - than the remaining free disk space, or more than 1/10th the total
 - disk space being unused keys all suggest a problem. -}
describeUnused' :: Bool -> Assistant (Maybe TenseText)
describeUnused' whenbig = liftAnnex $ go =<< readUnusedLog ""
  where
	go m = do
		let num = M.size m
		let diskused = foldl' sumkeysize 0 (M.keys m)
		df <- forpath getDiskFree
		disksize <- forpath getDiskSize
		return $ if num == 0
			then Nothing
			else if not whenbig || moreused df diskused || tenthused disksize diskused
				then Just $ tenseWords
					[ UnTensed $ T.pack $ roughSize storageUnits False diskused
					, Tensed "are" "were"
					, "taken up by unused files"
					]
				else if num > 1000
					then Just $ tenseWords
						[ UnTensed $ T.pack $ show num ++ " unused files"
						, Tensed "exist" "existed"
						]
					else Nothing

	moreused Nothing _ = False
	moreused (Just df) used = df <= used

	tenthused Nothing _ = False
	tenthused (Just disksize) used = used >= disksize `div` 10

	sumkeysize s k = s + fromMaybe 0 (keySize k)

	forpath a = inRepo $ liftIO . a . Git.repoPath

{- With a duration, expires all unused files that are older.
 - With Nothing, expires *all* unused files. -}
expireUnused :: Maybe Duration -> Assistant ()
expireUnused duration = do
	m <- liftAnnex $ readUnusedLog ""
	now <- liftIO getPOSIXTime
	let oldkeys = M.keys $ M.filter (tooold now) m
	forM_ oldkeys $ \k -> do
		debug ["removing old unused key", key2file k]
		liftAnnex $ do
			removeAnnex k
			logStatus k InfoMissing
  where
	boundry = durationToPOSIXTime <$> duration
	tooold now (_, mt) = case boundry of
		Nothing -> True
		Just b -> maybe False (\t -> now - t >= b) mt