convert old uuid-based log parsers to attoparsec

This preserves the workaround for the old bug that caused NoUUID items
to be stored in the log, prefixing log lines with " ". It's now handled
implicitly, by using takeWhile1 (/= ' ') to get the uuid.

There is a behavior change from the old parser, which split the value
into words and then recombined it. That meant that "foo  bar" and "foo\tbar"
came out as "foo bar". That behavior was not documented, and seems
surprising; it meant that after a git-annex describe here "foo  bar",
you wouldn't get that same string back out when git-annex displayed repo
descriptions.

Otoh, some other parsers relied on the old behavior, and the attoparsec
rewrites had to deal with the issue themselves...

For group.log, there are some edge cases around the user providing a
group name with a leading or trailing space. The old parser would ignore
such excess whitespace. The new parser does too, because the alternative
is to refuse to parse something like " group1  group2 " due to excess
whitespace, which would be even more confusing behavior.

The only git-annex branch log file that is not converted to attoparsec
and bytestring-builder now is transitions.log.

Annex/Branch.hs

@@ -573,7 +573,7 @@ performTransitionsLocked jl ts neednewlocalbranch transitionedrefs = do
 	 -}
 	run [] = noop
 	run changers = do
-		trustmap <- calcTrustMap . decodeBL <$> getStaged trustLog
+		trustmap <- calcTrustMap <$> getStaged trustLog
 		fs <- branchFiles
 		forM_ fs $ \f -> do
 			content <- getStaged f
@@ -598,7 +598,7 @@ performTransitionsLocked jl ts neednewlocalbranch transitionedrefs = do
 
 checkBranchDifferences :: Git.Ref -> Annex ()
 checkBranchDifferences ref = do
-	theirdiffs <- allDifferences . parseDifferencesLog . decodeBL
+	theirdiffs <- allDifferences . parseDifferencesLog
 		<$> catFile ref differenceLog
 	mydiffs <- annexDifferences <$> Annex.getGitConfig
 	when (theirdiffs /= mydiffs) $

Annex/Branch/Transitions.hs

@@ -46,8 +46,9 @@ dropDead f content trustmap = case getLogVariety f of
 		-- to still know it's dead.
 		| f == trustLog -> PreserveFile
 		| otherwise -> ChangeFile $
-			UUIDBased.buildLog (byteString . encodeBS) $
+			UUIDBased.buildLog byteString $
-				dropDeadFromMapLog trustmap id $ UUIDBased.parseLog Just (decodeBL content)
+				dropDeadFromMapLog trustmap id $
+					UUIDBased.parseLog A.takeByteString content
 	Just NewUUIDBasedLog -> ChangeFile $
 		UUIDBased.buildLogNew byteString $
 			dropDeadFromMapLog trustmap id $
@@ -55,7 +56,8 @@ dropDead f content trustmap = case getLogVariety f of
 	Just (ChunkLog _) -> ChangeFile $
 		Chunk.buildLog $ dropDeadFromMapLog trustmap fst $ Chunk.parseLog content
 	Just (PresenceLog _) ->
-		let newlog = Presence.compactLog $ dropDeadFromPresenceLog trustmap $ Presence.parseLog content
+		let newlog = Presence.compactLog $
+			dropDeadFromPresenceLog trustmap $ Presence.parseLog content
 		in if null newlog
 			then RemoveFile
 			else ChangeFile $ Presence.buildLog newlog

CHANGELOG

@@ -22,6 +22,9 @@ git-annex (7.20181212) UNRELEASED; urgency=medium
     last touched by that ancient git-annex version, the descriptions
     of remotes would appear missing when used with this version of
     git-annex.
+  * Improve uuid.log parser to preserve whitespace in repo descriptions.
+  * Improve activity.log parser to not remove unknown activities,
+    allowing for future expansion.
 
  -- Joey Hess <id@joeyh.name>  Tue, 18 Dec 2018 12:24:52 -0400
 

Logs/Activity.hs

@@ -1,6 +1,6 @@
 {- git-annex activity log
  -
- - Copyright 2015 Joey Hess <id@joeyh.name>
+ - Copyright 2015-2019 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -17,23 +17,36 @@ import qualified Annex.Branch
 import Logs
 import Logs.UUIDBased
 
+import qualified Data.ByteString as S
+import qualified Data.Attoparsec.ByteString as A
 import Data.ByteString.Builder
 
-data Activity = Fsck
+data Activity 
+	= Fsck
 	deriving (Eq, Read, Show, Enum, Bounded)
 
 recordActivity :: Activity -> UUID -> Annex ()
 recordActivity act uuid = do
 	c <- liftIO currentVectorClock
 	Annex.Branch.change activityLog $
-		buildLog (byteString . encodeBS . show) 
+		buildLog buildActivity
-			. changeLog c uuid act 
+			. changeLog c uuid (Right act)
-			. parseLog readish . decodeBL
+			. parseLog parseActivity
 
 lastActivities :: Maybe Activity -> Annex (Log Activity)
-lastActivities wantact = parseLog onlywanted . decodeBL <$> Annex.Branch.get activityLog
+lastActivities wantact = parseLog (onlywanted =<< parseActivity)
+	<$> Annex.Branch.get activityLog
   where
-	onlywanted s = case readish s of
+	onlywanted (Right a) | wanted a = pure a
-		Just a | wanted a -> Just a
+	onlywanted _ = fail "unwanted activity"
-		_ -> Nothing
 	wanted a = maybe True (a ==) wantact
+
+buildActivity :: Either S.ByteString Activity -> Builder
+buildActivity (Right a) = byteString $ encodeBS $ show a
+buildActivity (Left b) = byteString b
+
+-- Allow for unknown activities to be added later by preserving them.
+parseActivity :: A.Parser (Either S.ByteString Activity)
+parseActivity = go <$> A.takeByteString
+  where
+	go b = maybe (Left b) Right $ readish $ decodeBS b

Logs/Difference.hs

@@ -13,6 +13,7 @@ module Logs.Difference (
 ) where
 
 import qualified Data.Map as M
+import qualified Data.Attoparsec.ByteString as A
 import Data.ByteString.Builder
 
 import Annex.Common
@@ -26,17 +27,16 @@ recordDifferences :: Differences -> UUID -> Annex ()
 recordDifferences ds@(Differences {}) uuid = do
 	c <- liftIO currentVectorClock
 	Annex.Branch.change differenceLog $
-		buildLog (byteString . encodeBS) 
+		buildLog byteString 
-			. changeLog c uuid (showDifferences ds) 
+			. changeLog c uuid (encodeBS $ showDifferences ds) 
-			. parseLog Just . decodeBL
+			. parseLog A.takeByteString
 recordDifferences UnknownDifferences _ = return ()
 
 -- Map of UUIDs that have Differences recorded.
 -- If a new version of git-annex has added a Difference this version
 -- doesn't know about, it will contain UnknownDifferences.
 recordedDifferences :: Annex (M.Map UUID Differences)
-recordedDifferences = parseDifferencesLog . decodeBL <$> Annex.Branch.get differenceLog
+recordedDifferences = parseDifferencesLog <$> Annex.Branch.get differenceLog
 
 recordedDifferencesFor :: UUID -> Annex Differences
-recordedDifferencesFor u = fromMaybe mempty . M.lookup u 
+recordedDifferencesFor u = fromMaybe mempty . M.lookup u <$> recordedDifferences
-	<$> recordedDifferences

Logs/Difference/Pure.hs

@@ -11,13 +11,16 @@ module Logs.Difference.Pure (
 ) where
 
 import qualified Data.Map as M
+import qualified Data.ByteString.Lazy as L
+import qualified Data.Attoparsec.ByteString as A
 
 import Annex.Common
 import Types.Difference
 import Logs.UUIDBased
 
-parseDifferencesLog :: String -> (M.Map UUID Differences)
+parseDifferencesLog :: L.ByteString -> (M.Map UUID Differences)
-parseDifferencesLog = simpleMap . parseLog (Just . readDifferences)
+parseDifferencesLog = simpleMap
+	. parseLog (readDifferences . decodeBS <$> A.takeByteString)
 
 -- The sum of all recorded differences, across all UUIDs.
 allDifferences :: M.Map UUID Differences -> Differences

Logs/Group.hs

@@ -16,9 +16,10 @@ module Logs.Group (
 	inUnwantedGroup
 ) where
 
-import qualified Data.ByteString.Lazy as L
 import qualified Data.Map as M
 import qualified Data.Set as S
+import qualified Data.Attoparsec.ByteString as A
+import qualified Data.Attoparsec.ByteString.Char8 as A8
 import Data.ByteString.Builder
 
 import Annex.Common
@@ -39,7 +40,7 @@ groupChange uuid@(UUID _) modifier = do
 	curr <- lookupGroups uuid
 	c <- liftIO currentVectorClock
 	Annex.Branch.change groupLog $
-		buildLog buildGroup . changeLog c uuid (modifier curr) . parseGroup
+		buildLog buildGroup . changeLog c uuid (modifier curr) . parseLog parseGroup
 	
 	-- The changed group invalidates the preferred content cache.
 	Annex.changeState $ \s -> s
@@ -55,8 +56,15 @@ buildGroup = go . S.toList
 	go (g:gs) = bld g <> mconcat [ charUtf8 ' ' <> bld g' | g' <- gs ]
 	bld (Group g) = byteString g
 
-parseGroup :: L.ByteString -> Log (S.Set Group)
+parseGroup :: A.Parser (S.Set Group)
-parseGroup = parseLog (Just . S.fromList . map toGroup . words) . decodeBL
+parseGroup = S.fromList <$> go []
+  where
+	go l = (A.endOfInput *> pure l)
+		<|> ((getgroup <* A8.char ' ') >>= go . (:l))
+		<|> ((:l) <$> getgroup)
+		-- allow extra writespace before or after a group name
+		<|> (A8.char ' ' >>= const (go l))
+	getgroup = Group <$> A8.takeWhile1 (/= ' ')
 
 groupSet :: UUID -> S.Set Group -> Annex ()
 groupSet u g = groupChange u (const g)
@@ -68,7 +76,7 @@ groupMap = maybe groupMapLoad return =<< Annex.getState Annex.groupmap
 {- Loads the map, updating the cache. -}
 groupMapLoad :: Annex GroupMap
 groupMapLoad = do
-	m <- makeGroupMap . simpleMap . parseGroup <$> Annex.Branch.get groupLog
+	m <- makeGroupMap . simpleMap . parseLog parseGroup <$> Annex.Branch.get groupLog
 	Annex.changeState $ \s -> s { Annex.groupmap = Just m }
 	return m
 

Logs/Multicast.hs

@@ -1,6 +1,6 @@
 {- git-annex multicast fingerprint log
  -
- - Copyright 2017 Joey Hess <id@joeyh.name>
+ - Copyright 2017, 2019 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -17,6 +17,7 @@ import Logs
 import Logs.UUIDBased
 
 import qualified Data.Map as M
+import qualified Data.Attoparsec.ByteString.Lazy as A
 import Data.ByteString.Builder
 
 newtype Fingerprint = Fingerprint String
@@ -26,9 +27,17 @@ recordFingerprint :: Fingerprint -> UUID -> Annex ()
 recordFingerprint fp uuid = do
 	c <- liftIO currentVectorClock
 	Annex.Branch.change multicastLog $
-		buildLog (byteString . encodeBS . show)
+		buildLog buildFindgerPrint
 			. changeLog c uuid fp
-			. parseLog readish . decodeBL
+			. parseLog fingerprintParser
 
 knownFingerPrints :: Annex (M.Map UUID Fingerprint)
-knownFingerPrints = simpleMap . parseLog readish . decodeBL <$> Annex.Branch.get activityLog
+knownFingerPrints = simpleMap . parseLog fingerprintParser
+	<$> Annex.Branch.get activityLog
+
+fingerprintParser :: A.Parser Fingerprint
+fingerprintParser = maybe (fail "fingerprint parse failed") pure 
+	. readish . decodeBS =<< A.takeByteString
+
+buildFindgerPrint :: Fingerprint -> Builder
+buildFindgerPrint = byteString . encodeBS . show

Logs/PreferredContent.hs

@@ -1,6 +1,6 @@
 {- git-annex preferred content matcher configuration
  -
- - Copyright 2012-2014 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2019 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -26,6 +26,7 @@ module Logs.PreferredContent (
 import qualified Data.Map as M
 import qualified Data.Set as S
 import Data.Either
+import qualified Data.Attoparsec.ByteString.Lazy as A
 
 import Annex.Common
 import Logs.PreferredContent.Raw
@@ -73,8 +74,7 @@ preferredRequiredMapsLoad = do
 	groupmap <- groupMap
 	configmap <- readRemoteLog
 	let genmap l gm = simpleMap
-		. parseLogWithUUID ((Just .) . makeMatcher groupmap configmap gm)
+		. parseLogWithUUID (\u -> makeMatcher groupmap configmap gm u . decodeBS <$> A.takeByteString)
-		. decodeBL
 		<$> Annex.Branch.get l
 	pc <- genmap preferredContentLog =<< groupPreferredContentMapRaw
 	rc <- genmap requiredContentLog M.empty

Logs/PreferredContent/Raw.hs

@@ -32,9 +32,9 @@ setLog :: FilePath -> UUID -> PreferredContentExpression -> Annex ()
 setLog logfile uuid@(UUID _) val = do
 	c <- liftIO currentVectorClock
 	Annex.Branch.change logfile $
-		buildLog (byteString . encodeBS)
+		buildLog buildPreferredContentExpression
 		. changeLog c uuid val
-		. parseLog Just . decodeBL
+		. parseLog parsePreferredContentExpression
 	Annex.changeState $ \s -> s 
 		{ Annex.preferredcontentmap = Nothing
 		, Annex.requiredcontentmap = Nothing
@@ -63,12 +63,18 @@ buildGroupPreferredContent = buildMapLog buildgroup buildexpr
 	buildgroup (Group g) = byteString g
 	buildexpr = byteString . encodeBS
 
+parsePreferredContentExpression :: A.Parser PreferredContentExpression
+parsePreferredContentExpression = decodeBS <$> A.takeByteString
+
+buildPreferredContentExpression :: PreferredContentExpression -> Builder
+buildPreferredContentExpression = byteString . encodeBS
+
 preferredContentMapRaw :: Annex (M.Map UUID PreferredContentExpression)
-preferredContentMapRaw = simpleMap . parseLog Just . decodeBL
+preferredContentMapRaw = simpleMap . parseLog parsePreferredContentExpression
 	<$> Annex.Branch.get preferredContentLog
 
 requiredContentMapRaw :: Annex (M.Map UUID PreferredContentExpression)
-requiredContentMapRaw = simpleMap . parseLog Just . decodeBL
+requiredContentMapRaw = simpleMap . parseLog parsePreferredContentExpression
 	<$> Annex.Branch.get requiredContentLog
 
 groupPreferredContentMapRaw :: Annex (M.Map Group PreferredContentExpression)

Logs/Remote.hs

@@ -12,7 +12,6 @@ module Logs.Remote (
 	keyValToConfig,
 	configToKeyVal,
 	showConfig,
-	parseConfig,
 
 	prop_isomorphic_configEscape,
 	prop_parse_show_Config,
@@ -26,6 +25,7 @@ import Logs.UUIDBased
 
 import qualified Data.Map as M
 import Data.Char
+import qualified Data.Attoparsec.ByteString.Lazy as A
 import Data.ByteString.Builder
 
 {- Adds or updates a remote's config in the log. -}
@@ -35,14 +35,15 @@ configSet u cfg = do
 	Annex.Branch.change remoteLog $
 		buildLog (byteString . encodeBS . showConfig)
 			. changeLog c u cfg
-			. parseLog parseConfig . decodeBL
+			. parseLog remoteConfigParser
 
 {- Map of remotes by uuid containing key/value config maps. -}
 readRemoteLog :: Annex (M.Map UUID RemoteConfig)
-readRemoteLog = simpleMap . parseLog parseConfig . decodeBL <$> Annex.Branch.get remoteLog
+readRemoteLog = simpleMap . parseLog remoteConfigParser
+	<$> Annex.Branch.get remoteLog
 
-parseConfig :: String -> Maybe RemoteConfig
+remoteConfigParser :: A.Parser RemoteConfig
-parseConfig = Just . keyValToConfig . words
+remoteConfigParser = keyValToConfig . words . decodeBS <$> A.takeByteString
 
 showConfig :: RemoteConfig -> String
 showConfig = unwords . configToKeyVal
@@ -93,7 +94,7 @@ prop_parse_show_Config :: RemoteConfig -> Bool
 prop_parse_show_Config c
 	-- whitespace and '=' are not supported in keys
 	| any (\k -> any isSpace k || elem '=' k) (M.keys c) = True
-	| otherwise = parseConfig (showConfig c) ~~ Just c
+	| otherwise = A.parseOnly remoteConfigParser (encodeBS $ showConfig c) ~~ Right c
   where
 	normalize v = sort . M.toList <$> v
 	a ~~ b = normalize a == normalize b

Logs/Schedule.hs

@@ -20,6 +20,7 @@ module Logs.Schedule (
 import qualified Data.Map as M
 import qualified Data.Set as S
 import Data.Time.LocalTime
+import qualified Data.Attoparsec.ByteString.Lazy as A
 import Data.ByteString.Builder
 
 import Annex.Common
@@ -33,19 +34,18 @@ scheduleSet :: UUID -> [ScheduledActivity] -> Annex ()
 scheduleSet uuid@(UUID _) activities = do
 	c <- liftIO currentVectorClock
 	Annex.Branch.change scheduleLog $
-		buildLog (byteString . encodeBS) 
+		buildLog byteString 
-			. changeLog c uuid val 
+			. changeLog c uuid (encodeBS val)
-			. parseLog Just . decodeBL
+			. parseLog A.takeByteString
   where
 	val = fromScheduledActivities activities
 scheduleSet NoUUID _ = error "unknown UUID; cannot modify"
 
 scheduleMap :: Annex (M.Map UUID [ScheduledActivity])
-scheduleMap = simpleMap
+scheduleMap = simpleMap . parseLog parser <$> Annex.Branch.get scheduleLog
-	. parseLog parser . decodeBL
-	<$> Annex.Branch.get scheduleLog
   where
-	parser = eitherToMaybe . parseScheduledActivities
+	parser = either fail pure . parseScheduledActivities . decodeBS 
+		=<< A.takeByteString
 
 scheduleGet :: UUID -> Annex (S.Set ScheduledActivity)
 scheduleGet u = do

Logs/Trust/Basic.hs

@@ -19,20 +19,18 @@ import Logs
 import Logs.UUIDBased
 import Logs.Trust.Pure as X
 
-import Data.ByteString.Builder
-
 {- Changes the trust level for a uuid in the trustLog. -}
 trustSet :: UUID -> TrustLevel -> Annex ()
 trustSet uuid@(UUID _) level = do
 	c <- liftIO currentVectorClock
 	Annex.Branch.change trustLog $
-		buildLog (byteString . encodeBS . showTrustLog) .
+		buildLog buildTrustLevel .
 			changeLog c uuid level .
-				parseLog (Just . parseTrustLog) . decodeBL
+				parseLog trustLevelParser
 	Annex.changeState $ \s -> s { Annex.trustmap = Nothing }
 trustSet NoUUID _ = error "unknown UUID; cannot modify"
 
 {- Does not include forcetrust or git config values, just those from the
  - log file. -}
 trustMapRaw :: Annex TrustMap
-trustMapRaw = calcTrustMap . decodeBL <$> Annex.Branch.get trustLog
+trustMapRaw = calcTrustMap <$> Annex.Branch.get trustLog

Logs/Trust/Pure.hs

@@ -1,36 +1,49 @@
 {- git-annex trust log, pure operations
  -
- - Copyright 2010-2013 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2018 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
+{-# LANGUAGE OverloadedStrings #-}
+
 module Logs.Trust.Pure where
 
 import Annex.Common
 import Types.TrustLevel
 import Logs.UUIDBased
 
-calcTrustMap :: String -> TrustMap
+import qualified Data.ByteString.Lazy as L
-calcTrustMap = simpleMap . parseLog (Just . parseTrustLog)
+import qualified Data.Attoparsec.ByteString.Lazy as A
+import qualified Data.Attoparsec.ByteString.Char8 as A8
+import Data.ByteString.Builder
 
-{- The trust.log used to only list trusted repos, without a field for the
+calcTrustMap :: L.ByteString -> TrustMap
- - trust status, which is why this defaults to Trusted. -}
+calcTrustMap = simpleMap . parseLog trustLevelParser
-parseTrustLog :: String -> TrustLevel
+
-parseTrustLog s = maybe Trusted parse $ headMaybe $ words s
+trustLevelParser :: A.Parser TrustLevel
+trustLevelParser = (totrust <$> A8.anyChar <* A.endOfInput)
+	-- The trust log used to only list trusted repos, without a 
+	-- value for the trust status
+	<|> (const Trusted <$> A.endOfInput)
   where
-	parse "1" = Trusted
+	totrust '1' = Trusted
-	parse "0" = UnTrusted
+	totrust '0' = UnTrusted
-	parse "X" = DeadTrusted
+	totrust 'X' = DeadTrusted
-	parse _ = SemiTrusted
+	-- Allow for future expansion by treating unknown trust levels as
+	-- semitrusted.
+	totrust _ = SemiTrusted
 
-showTrustLog :: TrustLevel -> String
+buildTrustLevel :: TrustLevel -> Builder
-showTrustLog Trusted = "1"
+buildTrustLevel Trusted = byteString "1"
-showTrustLog UnTrusted = "0"
+buildTrustLevel UnTrusted = byteString "0"
-showTrustLog DeadTrusted = "X"
+buildTrustLevel DeadTrusted = byteString "X"
-showTrustLog SemiTrusted = "?"
+buildTrustLevel SemiTrusted = byteString "?"
 
-prop_parse_show_TrustLog :: Bool
+prop_parse_build_TrustLevelLog :: Bool
-prop_parse_show_TrustLog = all check [minBound .. maxBound]
+prop_parse_build_TrustLevelLog = all check [minBound .. maxBound]
   where
-	check l = parseTrustLog (showTrustLog l) == l
+	check l = 
+		let v = A.parseOnly trustLevelParser $ L.toStrict $
+			toLazyByteString $ buildTrustLevel l
+		in v == Right l

Logs/UUID.hs

@@ -24,15 +24,15 @@ import Logs.UUIDBased
 import qualified Annex.UUID
 
 import qualified Data.Map.Strict as M
+import qualified Data.ByteString.Lazy as L
+import qualified Data.Attoparsec.ByteString.Lazy as A
 
 {- Records a description for a uuid in the log. -}
 describeUUID :: UUID -> UUIDDesc -> Annex ()
 describeUUID uuid desc = do
 	c <- liftIO currentVectorClock
 	Annex.Branch.change uuidLog $
-		buildLog buildUUIDDesc 
+		buildLog buildUUIDDesc . changeLog c uuid desc . parseUUIDLog
-			. changeLog c uuid desc 
-			. parseLog (Just . UUIDDesc . encodeBS) . decodeBL
 
 {- The map is cached for speed. -}
 uuidDescMap :: Annex UUIDDescMap
@@ -44,11 +44,13 @@ uuidDescMap = maybe uuidDescMapLoad return =<< Annex.getState Annex.uuiddescmap
  - it may not have been described and otherwise would not appear. -}
 uuidDescMapLoad :: Annex UUIDDescMap
 uuidDescMapLoad = do
-	m <- (simpleMap . parseLog (Just . UUIDDesc . encodeBS)) . decodeBL
+	m <- simpleMap . parseUUIDLog <$> Annex.Branch.get uuidLog
-		<$> Annex.Branch.get uuidLog
 	u <- Annex.UUID.getUUID
 	let m' = M.insertWith preferold u mempty m
 	Annex.changeState $ \s -> s { Annex.uuiddescmap = Just m' }
 	return m'
   where
 	preferold = flip const
+
+parseUUIDLog :: L.ByteString -> Log UUIDDesc
+parseUUIDLog = parseLog (UUIDDesc <$> A.takeByteString)

Logs/UUIDBased.hs

@@ -14,7 +14,7 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings, TupleSections #-}
 
 module Logs.UUIDBased (
 	Log,
@@ -39,9 +39,12 @@ import Annex.VectorClock
 import Logs.MapLog
 import Logs.Line
 
+import qualified Data.ByteString as S
 import qualified Data.ByteString.Lazy as L
 import qualified Data.Attoparsec.ByteString.Lazy as A
+import qualified Data.Attoparsec.ByteString.Char8 as A8
 import Data.ByteString.Builder
+import qualified Data.DList as D
 
 type Log v = MapLog UUID v
 
@@ -56,32 +59,28 @@ buildLog builder = mconcat . map genline . M.toList
 	sp = charUtf8 ' '
 	nl = charUtf8 '\n'
 
-parseLog :: (String -> Maybe a) -> String -> Log a
+parseLog :: A.Parser a -> L.ByteString -> Log a
 parseLog = parseLogWithUUID . const
 
-parseLogWithUUID :: (UUID -> String -> Maybe a) -> String -> Log a
+parseLogWithUUID :: (UUID -> A.Parser a) -> L.ByteString -> Log a
-parseLogWithUUID parser = M.fromListWith best . mapMaybe parse . splitLines
+parseLogWithUUID parser = fromMaybe M.empty . A.maybeResult
+	. A.parse (logParser parser)
+
+logParser :: (UUID -> A.Parser a) -> A.Parser (Log a)
+logParser parser = M.fromListWith best <$> parseLogLines go
   where
-	parse line
+	go = do
-		-- This is a workaround for a bug that caused
+		u <- toUUID <$> A8.takeWhile1 (/= ' ')
-		-- NoUUID items to be stored in the log.
+		(dl, ts) <- accumval D.empty
-		-- It can be removed at any time; is just here to clean
+		v <- either fail return $ A.parseOnly (parser u <* A.endOfInput)
-		-- up logs where that happened temporarily.
+			(S.intercalate " " $ D.toList dl)
-		| " " `isPrefixOf` line = Nothing
+		return (u, LogEntry ts v)
-		| null ws = Nothing
+	accumval dl =
-		| otherwise = parser u (unwords info) >>= makepair
+		((dl,) <$> parsetimestamp)
-	  where
+		<|> (A8.char ' ' *> (A8.takeWhile (/= ' ')) >>= accumval . D.snoc dl)
-		makepair v = Just (u, LogEntry ts v)
+	parsetimestamp = 
-		ws = words line
+		(A8.string " timestamp=" *> vectorClockParser <* A.endOfInput)
-		u = toUUID $ Prelude.head ws
+		<|> (const Unknown <$> A.endOfInput)
-		t = Prelude.last ws
-		ts
-			| tskey `isPrefixOf` t = fromMaybe Unknown $
-				parseVectorClock $ drop 1 $ dropWhile (/= '=') t
-			| otherwise = Unknown
-		info
-			| ts == Unknown = drop 1 ws
-			| otherwise = drop 1 $ beginning ws
 
 buildLogNew :: (v -> Builder) -> Log v -> Builder
 buildLogNew = buildMapLog buildUUID
@@ -94,6 +93,3 @@ changeLog = changeMapLog
 
 addLog :: UUID -> LogEntry v -> Log v -> Log v
 addLog = addMapLog
-
-tskey :: String
-tskey = "timestamp="

Test.hs

@@ -180,7 +180,7 @@ properties = localOption (QuickCheckTests 1000) $ testGroup "QuickCheck"
 	, testProperty "prop_read_show_inodecache" Utility.InodeCache.prop_read_show_inodecache
 	, testProperty "prop_parse_build_log" Logs.Presence.prop_parse_build_log
 	, testProperty "prop_read_show_TrustLevel" Types.TrustLevel.prop_read_show_TrustLevel
-	, testProperty "prop_parse_show_TrustLog" Logs.Trust.prop_parse_show_TrustLog
+	, testProperty "prop_parse_build_TrustLevelLog" Logs.Trust.prop_parse_build_TrustLevelLog
 	, testProperty "prop_hashes_stable" Utility.Hash.prop_hashes_stable
 	, testProperty "prop_mac_stable" Utility.Hash.prop_mac_stable
 	, testProperty "prop_schedule_roundtrips" Utility.Scheduled.QuickCheck.prop_schedule_roundtrips

Types/Group.hs

@@ -21,7 +21,7 @@ import qualified Data.Set as S
 import qualified Data.ByteString as S
 
 newtype Group = Group S.ByteString
-	deriving (Eq, Ord)
+	deriving (Eq, Ord, Show)
 
 fromGroup :: Group -> String
 fromGroup (Group g) = decodeBS g