diff options
Diffstat (limited to 'Logs')
| -rw-r--r-- | Logs/Location.hs | 2 | ||||
| -rw-r--r-- | Logs/Presence.hs | 54 | ||||
| -rw-r--r-- | Logs/Trust.hs | 14 | ||||
| -rw-r--r-- | Logs/UUIDBased.hs | 17 |
4 files changed, 37 insertions, 50 deletions
diff --git a/Logs/Location.hs b/Logs/Location.hs index 602c46f31..ff874a596 100644 --- a/Logs/Location.hs +++ b/Logs/Location.hs @@ -37,7 +37,7 @@ logChange repo _ NoUUID _ = error $ {- Returns a list of repository UUIDs that, according to the log, have - the value of a key. -} keyLocations :: Key -> Annex [UUID] -keyLocations key = map read <$> (currentLog . logFile) key +keyLocations key = map toUUID <$> (currentLog . logFile) key {- Finds all keys that have location log information. - (There may be duplicate keys in the list.) -} diff --git a/Logs/Presence.hs b/Logs/Presence.hs index 7211eba03..f5e4f1ea9 100644 --- a/Logs/Presence.hs +++ b/Logs/Presence.hs @@ -16,6 +16,7 @@ module Logs.Presence ( addLog, readLog, parseLog, + showLog, logNow, compactLog, currentLog, @@ -36,41 +37,9 @@ data LogLine = LogLine { info :: String } deriving (Eq) -data LogStatus = InfoPresent | InfoMissing | Undefined +data LogStatus = InfoPresent | InfoMissing deriving (Eq) -instance Show LogStatus where - show InfoPresent = "1" - show InfoMissing = "0" - show Undefined = "undefined" - -instance Read LogStatus where - readsPrec _ "1" = [(InfoPresent, "")] - readsPrec _ "0" = [(InfoMissing, "")] - readsPrec _ _ = [(Undefined, "")] - -instance Show LogLine where - show (LogLine d s i) = unwords [show d, show s, i] - -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 maybe bad good pdate - else bad - where - w = words string - s = read $ w !! 1 - i = w !! 2 - pdate :: Maybe UTCTime - pdate = parseTime defaultTimeLocale "%s%Qs" $ head w - - good v = ret $ LogLine (utcTimeToPOSIXSeconds v) s i - bad = ret $ LogLine 0 Undefined "" - ret v = [(v, "")] - addLog :: FilePath -> LogLine -> Annex () addLog file line = Annex.Branch.change file $ \s -> showLog $ compactLog (line : parseLog s) @@ -80,15 +49,26 @@ addLog file line = Annex.Branch.change file $ \s -> readLog :: FilePath -> Annex [LogLine] readLog file = parseLog <$> Annex.Branch.get file +{- Parses a log file. Unparseable lines are ignored. -} parseLog :: String -> [LogLine] -parseLog = filter parsable . map read . lines +parseLog = mapMaybe (parseline . words) . lines where - -- some lines may be unparseable, avoid them - parsable l = status l /= Undefined + parseline (a:b:c:_) = do + d <- parseTime defaultTimeLocale "%s%Qs" a + s <- parsestatus b + Just $ LogLine (utcTimeToPOSIXSeconds d) s c + parseline _ = Nothing + parsestatus "1" = Just InfoPresent + parsestatus "0" = Just InfoMissing + parsestatus _ = Nothing {- Generates a log file. -} showLog :: [LogLine] -> String -showLog = unlines . map show +showLog = unlines . map genline + where + genline (LogLine d s i) = unwords [show d, genstatus s, i] + genstatus InfoPresent = "1" + genstatus InfoMissing = "0" {- Generates a new LogLine with the current date. -} logNow :: LogStatus -> String -> Annex LogLine diff --git a/Logs/Trust.hs b/Logs/Trust.hs index 53a1bca2c..8c4507dcb 100644 --- a/Logs/Trust.hs +++ b/Logs/Trust.hs @@ -45,18 +45,26 @@ trustMap = do parseTrust :: String -> Maybe TrustLevel parseTrust s - | length w > 0 = readMaybe $ head w + | length w > 0 = Just $ parse $ head w -- back-compat; the trust.log used to only list trusted repos - | otherwise = Just Trusted + | otherwise = Just $ Trusted where w = words s + parse "1" = Trusted + parse "0" = UnTrusted + parse _ = SemiTrusted + +showTrust :: TrustLevel -> String +showTrust SemiTrusted = "?" +showTrust UnTrusted = "0" +showTrust Trusted = "1" {- Changes the trust level for a uuid in the trustLog. -} trustSet :: UUID -> TrustLevel -> Annex () trustSet uuid@(UUID _) level = do ts <- liftIO $ getPOSIXTime Annex.Branch.change trustLog $ - showLog show . changeLog ts uuid level . parseLog parseTrust + showLog showTrust . changeLog ts uuid level . parseLog parseTrust Annex.changeState $ \s -> s { Annex.trustmap = Nothing } trustSet NoUUID _ = error "unknown UUID; cannot modify trust level" diff --git a/Logs/UUIDBased.hs b/Logs/UUIDBased.hs index 7184709fe..9609d7321 100644 --- a/Logs/UUIDBased.hs +++ b/Logs/UUIDBased.hs @@ -50,28 +50,27 @@ showLog :: (a -> String) -> Log a -> String showLog shower = unlines . map showpair . M.toList where showpair (k, LogEntry (Date p) v) = - unwords [show k, shower v, tskey ++ show p] + unwords [fromUUID k, shower v, tskey ++ show p] showpair (k, LogEntry Unknown v) = - unwords [show k, shower v] + unwords [fromUUID k, shower v] parseLog :: (String -> Maybe a) -> String -> Log a -parseLog parser = M.fromListWith best . catMaybes . map pair . lines +parseLog parser = M.fromListWith best . catMaybes . map parse . lines where - pair line + parse line | null ws = Nothing - | otherwise = case parser $ unwords info of - Nothing -> Nothing - Just v -> Just (read u, LogEntry c v) + | otherwise = parser (unwords info) >>= makepair where + makepair v = Just (toUUID u, LogEntry ts v) ws = words line u = head ws end = last ws - c + ts | tskey `isPrefixOf` end = pdate $ tail $ dropWhile (/= '=') end | otherwise = Unknown info - | c == Unknown = drop 1 ws + | ts == Unknown = drop 1 ws | otherwise = drop 1 $ init ws pdate s = case parseTime defaultTimeLocale "%s%Qs" s of Nothing -> Unknown |