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
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
|
{- git-annex location log
-
- git-annex keeps track of on which repository it last saw a file's content.
- This can be useful when using it for archiving with offline storage.
- When you indicate you --want a file, git-annex will tell you which
- repositories have the file's content.
-
- Location tracking information is stored in `.git-annex/filename.log`.
- Repositories record their name and the date when they --get or --drop
- a file's content.
-
- A line of the log will look like: "date N reponame"
- Where N=1 when the repo has the file, and 0 otherwise.
-
- Git is configured to use a union merge for this file,
- so the lines may be in arbitrary order, but it will never conflict.
-}
module LocationLog (
) where
import Data.Time.Clock.POSIX
import Data.Time
import System.Locale
import qualified Data.Map as Map
import System.IO
import System.Directory
import Data.Char
import GitRepo
import Utility
import Locations
data LogLine = LogLine {
date :: POSIXTime,
status :: LogStatus,
reponame :: String
} deriving (Eq)
data LogStatus = FilePresent | FileMissing | Undefined
deriving (Eq)
instance Show LogStatus where
show FilePresent = "1"
show FileMissing = "0"
show Undefined = "undefined"
instance Read LogStatus where
readsPrec _ "1" = [(FilePresent, "")]
readsPrec _ "0" = [(FileMissing, "")]
readsPrec _ _ = [(Undefined, "")]
instance Show LogLine where
show (LogLine date status reponame) = unwords
[(show date), (show status), reponame]
instance Read LogLine where
-- This parser is robust in that even unparsable log lines are
-- read without an exception being thrown.
-- Such lines have a status of Undefined.
readsPrec _ string =
if (length w >= 3)
then case (pdate) of
Just v -> good v
Nothing -> undefined
else undefined
where
w = words string
date = w !! 0
status = read $ w !! 1
reponame = unwords $ drop 2 w
pdate = (parseTime defaultTimeLocale "%s%Qs" date) :: Maybe UTCTime
good v = ret $ LogLine (utcTimeToPOSIXSeconds v) status reponame
undefined = ret $ LogLine (0) Undefined ""
ret v = [(v, "")]
{- Reads a log file.
- Note that the LogLines returned may be in any order. -}
readLog :: FilePath -> IO [LogLine]
readLog file = do
exists <- doesFileExist file
if exists
then do
s <- withFileLocked file ReadMode $ \h ->
hGetContentsStrict h
-- filter out any unparsable lines
return $ filter (\l -> (status l) /= Undefined )
$ map read $ lines s
else do
return []
{- Adds a LogLine to a log file -}
appendLog :: FilePath -> LogLine -> IO ()
appendLog file line = do
createDirectoryIfMissing True (parentDir file)
withFileLocked file AppendMode $ \h ->
hPutStrLn h $ show line
-- TODO git add log
{- Writes a set of lines to a log file -}
writeLog :: FilePath -> [LogLine] -> IO ()
writeLog file lines = do
createDirectoryIfMissing True (parentDir file)
withFileLocked file WriteMode $ \h ->
hPutStr h $ unlines $ map show lines
{- Generates a new LogLine with the current date. -}
logNow :: LogStatus -> String -> IO LogLine
logNow status reponame = do
now <- getPOSIXTime
return $ LogLine now status reponame
{- Returns the filename of the log file for a given annexed file. -}
logFile :: GitRepo -> FilePath -> IO String
logFile repo annexedFile = do
return $ (gitStateDir repo) ++
(gitRelative repo annexedFile) ++ ".log"
{- Returns a list of repositories that, according to the log, have
- the content of a file -}
fileLocations :: GitRepo -> FilePath -> IO [String]
fileLocations thisrepo file = do
log <- logFile thisrepo file
lines <- readLog log
return $ map reponame (filterPresent lines)
{- Filters the list of LogLines to find ones where the file
- is (or should still be) present. -}
filterPresent :: [LogLine] -> [LogLine]
filterPresent lines = filter (\l -> FilePresent == status l) $ compactLog lines
{- Compacts a set of logs, returning a subset that contains the current
- status. -}
compactLog :: [LogLine] -> [LogLine]
compactLog lines = compactLog' Map.empty lines
compactLog' map [] = Map.elems map
compactLog' map (l:ls) = compactLog' (mapLog map l) ls
{- Inserts a log into a map of logs, if the log has better (ie, newer)
- information about a repo than the other logs in the map -}
mapLog map log =
if (better)
then Map.insert (reponame log) log map
else map
where
better = case (Map.lookup (reponame log) map) of
Just l -> (date l <= date log)
Nothing -> True
|
