From a93ff12905005d1cbd2339ddeb8e8abfe2b20079 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 14 Aug 2017 14:43:56 -0400 Subject: avoid accidental Show of VectorClock Removed its Show instance. --- Logs/MapLog.hs | 7 +++---- Logs/Presence/Pure.hs | 14 ++++++++------ Logs/SingleValue.hs | 9 ++++----- Logs/Transitions.hs | 9 ++++----- Logs/UUIDBased.hs | 8 ++------ 5 files changed, 21 insertions(+), 26 deletions(-) (limited to 'Logs') diff --git a/Logs/MapLog.hs b/Logs/MapLog.hs index 7fe9e5782..a881eae34 100644 --- a/Logs/MapLog.hs +++ b/Logs/MapLog.hs @@ -19,7 +19,6 @@ module Logs.MapLog ( import Common import Annex.VectorClock -import Logs.TimeStamp import Logs.Line import qualified Data.Map as M @@ -27,7 +26,7 @@ import qualified Data.Map as M data LogEntry v = LogEntry { changed :: VectorClock , value :: v - } deriving (Eq, Show) + } deriving (Eq) type MapLog f v = M.Map f (LogEntry v) @@ -43,9 +42,9 @@ parseMapLog :: Ord f => (String -> Maybe f) -> (String -> Maybe v) -> String -> parseMapLog fieldparser valueparser = M.fromListWith best . mapMaybe parse . splitLines where parse line = do - let (ts, rest) = splitword line + let (sc, rest) = splitword line (sf, sv) = splitword rest - c <- VectorClock <$> parsePOSIXTime ts + c <- parseVectorClock sc f <- fieldparser sf v <- valueparser sv Just (f, LogEntry c v) diff --git a/Logs/Presence/Pure.hs b/Logs/Presence/Pure.hs index 03cbdcdc1..8fc154177 100644 --- a/Logs/Presence/Pure.hs +++ b/Logs/Presence/Pure.hs @@ -9,7 +9,6 @@ module Logs.Presence.Pure where import Annex.Common import Annex.VectorClock -import Logs.TimeStamp import Logs.Line import Utility.QuickCheck @@ -19,7 +18,10 @@ data LogLine = LogLine { date :: VectorClock , status :: LogStatus , info :: String - } deriving (Eq, Show) + } deriving (Eq) + +instance Show LogLine where + show l = "LogLine " ++ formatVectorClock (date l) ++ show (status l) ++ " " ++ show (info l) data LogStatus = InfoPresent | InfoMissing | InfoDead deriving (Eq, Show, Bounded, Enum) @@ -29,12 +31,12 @@ parseLog :: String -> [LogLine] parseLog = mapMaybe parseline . splitLines where parseline l = LogLine - <$> (VectorClock <$> parsePOSIXTime d) + <$> parseVectorClock c <*> parseStatus s <*> pure rest where - (d, pastd) = separate (== ' ') l - (s, rest) = separate (== ' ') pastd + (c, pastc) = separate (== ' ') l + (s, rest) = separate (== ' ') pastc parseStatus :: String -> Maybe LogStatus parseStatus "1" = Just InfoPresent @@ -46,7 +48,7 @@ parseStatus _ = Nothing showLog :: [LogLine] -> String showLog = unlines . map genline where - genline (LogLine d s i) = unwords [show d, genstatus s, i] + genline (LogLine c s i) = unwords [formatVectorClock c, genstatus s, i] genstatus InfoPresent = "1" genstatus InfoMissing = "0" genstatus InfoDead = "X" diff --git a/Logs/SingleValue.hs b/Logs/SingleValue.hs index 24242c83f..1a6181f56 100644 --- a/Logs/SingleValue.hs +++ b/Logs/SingleValue.hs @@ -15,7 +15,6 @@ module Logs.SingleValue where import Annex.Common import qualified Annex.Branch -import Logs.TimeStamp import Logs.Line import Annex.VectorClock @@ -28,21 +27,21 @@ class SingleValueSerializable v where data LogEntry v = LogEntry { changed :: VectorClock , value :: v - } deriving (Eq, Show, Ord) + } deriving (Eq, Ord) type Log v = S.Set (LogEntry v) showLog :: (SingleValueSerializable v) => Log v -> String showLog = unlines . map showline . S.toList where - showline (LogEntry t v) = unwords [show t, serialize v] + showline (LogEntry c v) = unwords [formatVectorClock c, serialize v] parseLog :: (Ord v, SingleValueSerializable v) => String -> Log v parseLog = S.fromList . mapMaybe parse . splitLines where parse line = do - let (ts, s) = splitword line - c <- VectorClock <$> parsePOSIXTime ts + let (sc, s) = splitword line + c <- parseVectorClock sc v <- deserialize s Just (LogEntry c v) splitword = separate (== ' ') diff --git a/Logs/Transitions.hs b/Logs/Transitions.hs index 79acb87dd..0a90f118f 100644 --- a/Logs/Transitions.hs +++ b/Logs/Transitions.hs @@ -16,7 +16,6 @@ module Logs.Transitions where import Annex.Common import Annex.VectorClock -import Logs.TimeStamp import Logs.Line import qualified Data.Set as S @@ -32,7 +31,7 @@ data Transition data TransitionLine = TransitionLine { transitionStarted :: VectorClock , transition :: Transition - } deriving (Show, Ord, Eq) + } deriving (Ord, Eq) type Transitions = S.Set TransitionLine @@ -63,16 +62,16 @@ parseTransitionsStrictly source = fromMaybe badsource . parseTransitions badsource = giveup $ "unknown transitions listed in " ++ source ++ "; upgrade git-annex!" showTransitionLine :: TransitionLine -> String -showTransitionLine (TransitionLine ts t) = unwords [show t, show ts] +showTransitionLine (TransitionLine c t) = unwords [show t, formatVectorClock c] parseTransitionLine :: String -> Maybe TransitionLine parseTransitionLine s = TransitionLine - <$> (VectorClock <$> parsePOSIXTime ds) + <$> parseVectorClock cs <*> readish ts where ws = words s ts = Prelude.head ws - ds = unwords $ Prelude.tail ws + cs = unwords $ Prelude.tail ws combineTransitions :: [Transitions] -> Transitions combineTransitions = S.unions diff --git a/Logs/UUIDBased.hs b/Logs/UUIDBased.hs index fd1cd7c2d..4f32c19c7 100644 --- a/Logs/UUIDBased.hs +++ b/Logs/UUIDBased.hs @@ -35,7 +35,6 @@ import Common import Types.UUID import Annex.VectorClock import Logs.MapLog -import Logs.TimeStamp import Logs.Line type Log v = MapLog UUID v @@ -68,15 +67,12 @@ parseLogWithUUID parser = M.fromListWith best . mapMaybe parse . splitLines u = toUUID $ Prelude.head ws t = Prelude.last ws ts - | tskey `isPrefixOf` t = - pdate $ drop 1 $ dropWhile (/= '=') t + | tskey `isPrefixOf` t = fromMaybe Unknown $ + parseVectorClock $ drop 1 $ dropWhile (/= '=') t | otherwise = Unknown info | ts == Unknown = drop 1 ws | otherwise = drop 1 $ beginning ws - pdate s = case parsePOSIXTime s of - Nothing -> Unknown - Just d -> VectorClock d showLogNew :: (v -> String) -> Log v -> String showLogNew = showMapLog fromUUID -- cgit v1.2.3