summaryrefslogtreecommitdiff
path: root/Logs/Unused.hs
blob: 7a12f186c85348c01457227867c466e7c7fe1dbb (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
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
{- git-annex unused log file
 -
 - This file is stored locally in .git/annex/, not in the git-annex branch.
 -
 - The format: "int key timestamp"
 -
 - The int is a short, stable identifier that the user can use to
 - refer to this key. (Equivilant to a filename.)
 -
 - The timestamp indicates when the key was first determined to be unused.
 - Older versions of the log omit the timestamp.
 -
 - Copyright 2010-2014 Joey Hess <id@joeyh.name>
 -
 - Licensed under the GNU GPL version 3 or higher.
 -}

{-# LANGUAGE CPP #-}

module Logs.Unused (
	UnusedMap,
	updateUnusedLog,
	readUnusedLog,
	readUnusedMap,
	dateUnusedLog,
	unusedKeys,
	unusedKeys',
	setUnusedKeys,
) where

import qualified Data.Map as M
import qualified Data.Set as S
import Data.Time.Clock.POSIX
import Data.Time

import Common.Annex
import qualified Annex
import Types.Key
import Utility.Tmp
import Logs.TimeStamp

-- everything that is stored in the unused log
type UnusedLog = M.Map Key (Int, Maybe POSIXTime)

-- used to look up unused keys specified by the user
type UnusedMap = M.Map Int Key

log2map :: UnusedLog -> UnusedMap
log2map = M.fromList . map (\(k, (i, _t)) -> (i, k)) . M.toList

map2log :: POSIXTime -> UnusedMap -> UnusedLog
map2log t = M.fromList . map (\(i, k) -> (k, (i, Just t))) . M.toList

{- Only keeps keys that are in the new log, but uses any timestamps
 - those keys had in the old log. -}
preserveTimestamps :: UnusedLog -> UnusedLog -> UnusedLog
preserveTimestamps oldl newl = M.intersection (M.unionWith oldts oldl newl) newl
  where
	oldts _old@(_, ts) _new@(int, _) = (int, ts)

updateUnusedLog :: FilePath -> UnusedMap -> Annex ()
updateUnusedLog prefix m = do
	oldl <- readUnusedLog prefix
	newl <- preserveTimestamps oldl . flip map2log m <$> liftIO getPOSIXTime
	writeUnusedLog prefix newl

writeUnusedLog :: FilePath -> UnusedLog -> Annex ()
writeUnusedLog prefix l = do
	logfile <- fromRepo $ gitAnnexUnusedLog prefix
	liftIO $ viaTmp writeFileAnyEncoding logfile $ unlines $ map format $ M.toList l
  where
	format (k, (i, Just t)) = show i ++ " " ++ key2file k ++ " " ++ show t
	format (k, (i, Nothing)) = show i ++ " " ++ key2file k

readUnusedLog :: FilePath -> Annex UnusedLog
readUnusedLog prefix = do
	f <- fromRepo $ gitAnnexUnusedLog prefix
	ifM (liftIO $ doesFileExist f)
		( M.fromList . mapMaybe parse . lines
			<$> liftIO (readFileStrictAnyEncoding f)
		, return M.empty
		)
  where
	parse line = case (readish sint, file2key skey, parsePOSIXTime ts) of
		(Just int, Just key, mtimestamp) -> Just (key, (int, mtimestamp))
		_ -> Nothing
	  where
		(sint, rest) = separate (== ' ') line
		(rts, rskey) = separate (== ' ') (reverse rest)
		skey = reverse rskey
		ts = reverse rts

readUnusedMap :: FilePath -> Annex UnusedMap
readUnusedMap = log2map <$$> readUnusedLog

dateUnusedLog :: FilePath -> Annex (Maybe UTCTime)
#if MIN_VERSION_directory(1,2,0)
dateUnusedLog prefix = do
	f <- fromRepo $ gitAnnexUnusedLog prefix
	liftIO $ catchMaybeIO $ getModificationTime f
#else
-- old ghc's getModificationTime returned a ClockTime
dateUnusedLog _prefix = return Nothing
#endif

{- Set of unused keys. This is cached for speed. -}
unusedKeys :: Annex (S.Set Key)
unusedKeys = maybe (setUnusedKeys =<< unusedKeys') return
	=<< Annex.getState Annex.unusedkeys

unusedKeys' :: Annex [Key]
unusedKeys' = M.keys <$> readUnusedLog ""

setUnusedKeys :: [Key] -> Annex (S.Set Key)
setUnusedKeys ks = do
	let v = S.fromList ks
	Annex.changeState $ \s -> s { Annex.unusedkeys = Just v }
	return v