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
|
