53ede1a10e
A dead key is both not present at the location that thinks it has a copy, and also is assumed to probably not be present anywhere else. Although there may be lurking disconnected repos that somehow still have a copy. Suprisingly few changes needed for this! This is because the presence log code only really concerns itself with keys that are present, and dead keys are not present. Note that both the location and web log can be parsed as having a dead key. I don't see any value to having keys listed as dead in the web log, but since it doesn't change any behavior, there was no point in not parsing it.
87 lines
2.2 KiB
Haskell
87 lines
2.2 KiB
Haskell
{- git-annex presence log, pure operations
|
|
-
|
|
- Copyright 2010-2013 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
module Logs.Presence.Pure where
|
|
|
|
import Data.Time.Clock.POSIX
|
|
import qualified Data.Map as M
|
|
|
|
import Common.Annex
|
|
import Logs.TimeStamp
|
|
import Utility.QuickCheck
|
|
|
|
data LogLine = LogLine {
|
|
date :: POSIXTime,
|
|
status :: LogStatus,
|
|
info :: String
|
|
} deriving (Eq, Show)
|
|
|
|
data LogStatus = InfoPresent | InfoMissing | InfoDead
|
|
deriving (Eq, Show, Bounded, Enum)
|
|
|
|
{- Parses a log file. Unparseable lines are ignored. -}
|
|
parseLog :: String -> [LogLine]
|
|
parseLog = mapMaybe parseline . lines
|
|
where
|
|
parseline l = LogLine
|
|
<$> parsePOSIXTime d
|
|
<*> parseStatus s
|
|
<*> pure rest
|
|
where
|
|
(d, pastd) = separate (== ' ') l
|
|
(s, rest) = separate (== ' ') pastd
|
|
|
|
parseStatus :: String -> Maybe LogStatus
|
|
parseStatus "1" = Just InfoPresent
|
|
parseStatus "0" = Just InfoMissing
|
|
parseStatus "X" = Just InfoDead
|
|
parseStatus _ = Nothing
|
|
|
|
{- Generates a log file. -}
|
|
showLog :: [LogLine] -> String
|
|
showLog = unlines . map genline
|
|
where
|
|
genline (LogLine d s i) = unwords [show d, genstatus s, i]
|
|
genstatus InfoPresent = "1"
|
|
genstatus InfoMissing = "0"
|
|
genstatus InfoDead = "X"
|
|
|
|
{- Given a log, returns only the info that is are still in effect. -}
|
|
getLog :: String -> [String]
|
|
getLog = map info . filterPresent . parseLog
|
|
|
|
{- Returns the info from LogLines that are in effect. -}
|
|
filterPresent :: [LogLine] -> [LogLine]
|
|
filterPresent = filter (\l -> InfoPresent == status l) . compactLog
|
|
|
|
{- Compacts a set of logs, returning a subset that contains the current
|
|
- status. -}
|
|
compactLog :: [LogLine] -> [LogLine]
|
|
compactLog = M.elems . foldr mapLog M.empty
|
|
|
|
type LogMap = M.Map String LogLine
|
|
|
|
{- Inserts a log into a map of logs, if the log has better (ie, newer)
|
|
- information than the other logs in the map -}
|
|
mapLog :: LogLine -> LogMap -> LogMap
|
|
mapLog l m
|
|
| better = M.insert i l m
|
|
| otherwise = m
|
|
where
|
|
better = maybe True newer $ M.lookup i m
|
|
newer l' = date l' <= date l
|
|
i = info l
|
|
|
|
instance Arbitrary LogLine where
|
|
arbitrary = LogLine
|
|
<$> arbitrary
|
|
<*> elements [minBound..maxBound]
|
|
<*> arbitrary `suchThat` ('\n' `notElem`)
|
|
|
|
prop_parse_show_log :: [LogLine] -> Bool
|
|
prop_parse_show_log l = parseLog (showLog l) == l
|
|
|