converting more log files to use Builder

Probably not any particular speedup in this, since most of these logs
are not written to often. Possibly chunk log writing is sped up, but
writes to chunk logs are interleaved with expensive data transfers to
remotes, so unlikely to be a noticiable speedup.

Annex/Branch/Transitions.hs

@@ -46,10 +46,12 @@ dropDead f content trustmap = case getLogVariety f of
 		| f == trustLog -> PreserveFile
 		| otherwise -> ChangeFile $ encodeBL $
 			UUIDBased.showLog id $ dropDeadFromMapLog trustmap id $ UUIDBased.parseLog Just (decodeBL content)
-	Just NewUUIDBasedLog -> ChangeFile $ encodeBL $
+	Just NewUUIDBasedLog -> ChangeFile $ toLazyByteString $
-		UUIDBased.showLogNew id $ dropDeadFromMapLog trustmap id $ UUIDBased.parseLogNew Just (decodeBL content)
+		UUIDBased.buildLogNew (byteString . encodeBS) $
-	Just (ChunkLog _) -> ChangeFile $ encodeBL $
+			dropDeadFromMapLog trustmap id $
-		Chunk.showLog $ dropDeadFromMapLog trustmap fst $ Chunk.parseLog (decodeBL content)
+				UUIDBased.parseLogNew Just (decodeBL content)
+	Just (ChunkLog _) -> ChangeFile $ toLazyByteString $
+		Chunk.buildLog $ dropDeadFromMapLog trustmap fst $ Chunk.parseLog (decodeBL content)
 	Just (PresenceLog _) ->
 		let newlog = Presence.compactLog $ dropDeadFromPresenceLog trustmap $ Presence.parseLog content
 		in if null newlog

Annex/VectorClock.hs

@@ -3,7 +3,7 @@
  - We don't have a way yet to keep true distributed vector clocks.
  - The next best thing is a timestamp.
  -
- - Copyright 2017 Joey Hess <id@joeyh.name>
+ - Copyright 2017-2019 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -11,12 +11,14 @@
 module Annex.VectorClock where
 
 import Data.Time.Clock.POSIX
+import Data.ByteString.Builder
 import Control.Applicative
 import Prelude
 
 import Utility.Env
 import Utility.TimeStamp
 import Utility.QuickCheck
+import Utility.FileSystemEncoding
 import qualified Data.Attoparsec.ByteString.Lazy as A
 
 -- | Some very old logs did not have any time stamp at all;
@@ -40,9 +42,12 @@ currentVectorClock = go =<< getEnv "GIT_ANNEX_VECTOR_CLOCK"
 		Nothing -> VectorClock <$> getPOSIXTime
 
 formatVectorClock :: VectorClock -> String
-formatVectorClock  Unknown = "0"
+formatVectorClock Unknown = "0"
 formatVectorClock (VectorClock t) = show t
 
+buildVectorClock :: VectorClock -> Builder
+buildVectorClock = byteString . encodeBS' . formatVectorClock
+
 parseVectorClock :: String -> Maybe VectorClock
 parseVectorClock t = VectorClock <$> parsePOSIXTime t
 

Logs/Chunk.hs

@@ -38,7 +38,7 @@ chunksStored u k chunkmethod chunkcount = do
 	c <- liftIO currentVectorClock
 	config <- Annex.getGitConfig
 	Annex.Branch.change (chunkLogFile config k) $
-		encodeBL . showLog . changeMapLog c (u, chunkmethod) chunkcount . parseLog . decodeBL
+		buildLog . changeMapLog c (u, chunkmethod) chunkcount . parseLog . decodeBL
 
 chunksRemoved :: UUID -> Key -> ChunkMethod -> Annex ()
 chunksRemoved u k chunkmethod = chunksStored u k chunkmethod 0

Logs/Chunk/Pure.hs

@@ -1,6 +1,6 @@
 {- Chunk logs, pure operations.
  -
- - Copyright 2014 Joey Hess <id@joeyh.name>
+ - Copyright 2014, 2019 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -11,16 +11,19 @@ module Logs.Chunk.Pure
 	, ChunkCount
 	, ChunkLog
 	, parseLog
-	, showLog
+	, buildLog
 	) where
 
 import Annex.Common
 import Logs.MapLog
 import Data.Int
 
+import qualified Data.ByteString as S
+import Data.ByteString.Builder
+
 -- Currently chunks are all fixed size, but other chunking methods
 -- may be added.
-data ChunkMethod = FixedSizeChunks ChunkSize | UnknownChunks String
+data ChunkMethod = FixedSizeChunks ChunkSize | UnknownChunks S.ByteString
 	deriving (Ord, Eq, Show)
 
 type ChunkSize = Int64
@@ -31,25 +34,23 @@ type ChunkCount = Integer
 type ChunkLog = MapLog (UUID, ChunkMethod) ChunkCount
 
 parseChunkMethod :: String -> ChunkMethod
-parseChunkMethod s = maybe (UnknownChunks s) FixedSizeChunks (readish s)
+parseChunkMethod s = maybe (UnknownChunks $ encodeBS s) FixedSizeChunks (readish s)
 
-showChunkMethod :: ChunkMethod -> String
+buildChunkMethod :: ChunkMethod -> Builder
-showChunkMethod (FixedSizeChunks sz) = show sz
+buildChunkMethod (FixedSizeChunks sz) = int64Dec sz
-showChunkMethod (UnknownChunks s) = s
+buildChunkMethod (UnknownChunks s) = byteString s
 
 parseLog :: String -> ChunkLog
 parseLog = parseMapLog fieldparser valueparser
   where
 	fieldparser s =
-		let (u,m) = separate (== sep) s
+		let (u,m) = separate (== ':') s
 		in Just (toUUID u, parseChunkMethod m)
 	valueparser = readish
 
-showLog :: ChunkLog -> String
+buildLog :: ChunkLog -> Builder
-showLog = showMapLog fieldshower valueshower
+buildLog = buildMapLog fieldbuilder valuebuilder
   where
-	fieldshower (u, m) = fromUUID u ++ sep : showChunkMethod m
+	fieldbuilder (u, m) = byteString (fromUUID u) <> sep <> buildChunkMethod m
-	valueshower = show
+	valuebuilder = integerDec
-
+	sep = charUtf8 ':'
-sep :: Char
-sep = ':'

Logs/Config.hs

@@ -1,6 +1,6 @@
 {- git-annex repository-global config 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.
  -}
@@ -20,6 +20,7 @@ import Logs.MapLog
 import qualified Annex.Branch
 
 import qualified Data.Map as M
+import Data.ByteString.Builder
 
 type ConfigName = String
 type ConfigValue = String
@@ -34,7 +35,7 @@ setGlobalConfig' :: ConfigName -> ConfigValue -> Annex ()
 setGlobalConfig' name new = do
 	c <- liftIO currentVectorClock
 	Annex.Branch.change configLog $ 
-		encodeBL . showMapLog id id . changeMapLog c name new . parseGlobalConfig . decodeBL
+		buildGlobalConfig . changeMapLog c name new . parseGlobalConfig . decodeBL
 
 unsetGlobalConfig :: ConfigName -> Annex ()
 unsetGlobalConfig name = do
@@ -46,6 +47,12 @@ unsetGlobalConfig name = do
 getGlobalConfig :: ConfigName -> Annex (Maybe ConfigValue)
 getGlobalConfig name = M.lookup name <$> loadGlobalConfig
 
+buildGlobalConfig :: MapLog ConfigName ConfigValue -> Builder
+buildGlobalConfig = buildMapLog fieldbuilder valuebuilder
+  where
+	fieldbuilder = byteString . encodeBS
+	valuebuilder = byteString . encodeBS
+
 parseGlobalConfig :: String -> MapLog ConfigName ConfigValue
 parseGlobalConfig = parseMapLog Just Just
 

Logs/Export.hs

@@ -18,6 +18,8 @@ import Logs
 import Logs.MapLog
 import Annex.UUID
 
+import Data.ByteString.Builder
+
 data Exported = Exported
 	{ exportedTreeish :: Git.Ref
 	, incompleteExportedTreeish :: [Git.Ref]
@@ -69,7 +71,7 @@ recordExport remoteuuid ec = do
 	let ep = ExportParticipants { exportFrom = u, exportTo = remoteuuid }
 	let exported = Exported (newTreeish ec) []
 	Annex.Branch.change exportLog $
-		encodeBL . showExportLog
+		buildExportLog
 			. changeMapLog c ep exported 
 			. M.mapWithKey (updateothers c u)
 			. parseExportLog . decodeBL
@@ -94,7 +96,7 @@ recordExportBeginning remoteuuid newtree = do
 		<$> Annex.Branch.get exportLog
 	let new = old { incompleteExportedTreeish = nub (newtree:incompleteExportedTreeish old) }
 	Annex.Branch.change exportLog $
-		encodeBL . showExportLog 
+		buildExportLog 
 			. changeMapLog c ep new
 			. parseExportLog . decodeBL
 	Annex.Branch.graftTreeish newtree (asTopFilePath "export.tree")
@@ -102,12 +104,14 @@ recordExportBeginning remoteuuid newtree = do
 parseExportLog :: String -> MapLog ExportParticipants Exported
 parseExportLog = parseMapLog parseExportParticipants parseExported
 
-showExportLog :: MapLog ExportParticipants Exported -> String
+buildExportLog :: MapLog ExportParticipants Exported -> Builder
-showExportLog = showMapLog formatExportParticipants formatExported
+buildExportLog = buildMapLog buildExportParticipants buildExported
 
-formatExportParticipants :: ExportParticipants -> String
+buildExportParticipants :: ExportParticipants -> Builder
-formatExportParticipants ep = 
+buildExportParticipants ep = byteString (fromUUID (exportFrom ep)) 
-	fromUUID (exportFrom ep) ++ ':' : fromUUID (exportTo ep)
+	<> sep <> byteString (fromUUID (exportTo ep))
+  where
+	sep = charUtf8 ':'
 
 parseExportParticipants :: String -> Maybe ExportParticipants
 parseExportParticipants s = case separate (== ':') s of
@@ -117,9 +121,13 @@ parseExportParticipants s = case separate (== ':') s of
 		{ exportFrom = toUUID f
 		, exportTo = toUUID t
 		}
-formatExported :: Exported -> String
+
-formatExported exported = unwords $ map Git.fromRef $
+buildExported :: Exported -> Builder
-	exportedTreeish exported : incompleteExportedTreeish exported
+buildExported exported = go (exportedTreeish exported : incompleteExportedTreeish exported)
+  where
+	go [] = mempty
+	go (r:rs) = rref r <> mconcat [ charUtf8 ' ' <> rref r' | r' <- rs ]
+	rref r = byteString (encodeBS' (Git.fromRef r))
 
 parseExported :: String -> Maybe Exported
 parseExported s = case words s of

Logs/MapLog.hs

@@ -1,12 +1,10 @@
-{-# LANGUAGE CPP #-}
-
 {- git-annex Map log
  -
  - This is used to store a Map, in a way that can be union merged.
  -
  - A line of the log will look like: "timestamp field value"
  -
- - Copyright 2014 Joey Hess <id@joeyh.name>
+ - Copyright 2014, 2019 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -22,6 +20,7 @@ import Annex.VectorClock
 import Logs.Line
 
 import qualified Data.Map.Strict as M
+import Data.ByteString.Builder
 
 data LogEntry v = LogEntry
 	{ changed :: VectorClock
@@ -30,13 +29,16 @@ data LogEntry v = LogEntry
 
 type MapLog f v = M.Map f (LogEntry v)
 
-showMapLog :: (f -> String) -> (v -> String) -> MapLog f v -> String
+buildMapLog :: (f -> Builder) -> (v -> Builder) -> MapLog f v -> Builder
-showMapLog fieldshower valueshower = unlines . map showpair . M.toList
+buildMapLog fieldbuilder valuebuilder = mconcat . map genline . M.toList
   where
-	showpair (f, LogEntry (VectorClock c) v) =
+	genline (f, LogEntry c v) = 
-		unwords [show c, fieldshower f, valueshower v]
+		buildVectorClock c <> sp 
-	showpair (f, LogEntry Unknown v) =
+			<> fieldbuilder f <> sp 
-		unwords ["0", fieldshower f, valueshower v]
+			<> valuebuilder v <> nl
+	sp = charUtf8 ' '
+	nl = charUtf8 '\n'
+
 
 parseMapLog :: Ord f => (String -> Maybe f) -> (String -> Maybe v) -> String -> MapLog f v
 parseMapLog fieldparser valueparser = M.fromListWith best . mapMaybe parse . splitLines

Logs/PreferredContent/Raw.hs

@@ -1,6 +1,6 @@
 {- unparsed preferred content expressions
  -
- - 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.
  -}
@@ -17,6 +17,7 @@ import Types.StandardGroups
 import Types.Group
 
 import qualified Data.Map as M
+import Data.ByteString.Builder
 
 {- Changes the preferred content configuration of a remote. -}
 preferredContentSet :: UUID -> PreferredContentExpression -> Annex ()
@@ -43,11 +44,17 @@ groupPreferredContentSet :: Group -> PreferredContentExpression -> Annex ()
 groupPreferredContentSet g val = do
 	c <- liftIO currentVectorClock
 	Annex.Branch.change groupPreferredContentLog $
-		encodeBL . showMapLog id id 
+		buildGroupPreferredContent
 		. changeMapLog c g val 
 		. parseMapLog Just Just . decodeBL
 	Annex.changeState $ \s -> s { Annex.preferredcontentmap = Nothing }
 
+buildGroupPreferredContent :: MapLog Group PreferredContentExpression -> Builder
+buildGroupPreferredContent = buildMapLog buildgroup buildexpr
+  where
+	buildgroup = byteString . encodeBS
+	buildexpr = byteString . encodeBS
+
 preferredContentMapRaw :: Annex (M.Map UUID PreferredContentExpression)
 preferredContentMapRaw = simpleMap . parseLog Just . decodeBL
 	<$> Annex.Branch.get preferredContentLog

Logs/Presence/Pure.hs

@@ -64,8 +64,7 @@ buildLog :: [LogLine] -> Builder
 buildLog = mconcat . map genline
   where
 	genline (LogLine c s (LogInfo i)) = 
-		byteString (encodeBS' (formatVectorClock c)) <> sp <>
+		buildVectorClock c <> sp <> genstatus s <> sp <> byteString i <> nl
-		genstatus s <> sp <> byteString i <> nl
 	sp = charUtf8 ' '
 	nl = charUtf8 '\n'
 	genstatus InfoPresent = charUtf8 '1'

Logs/RemoteState.hs

@@ -1,6 +1,6 @@
 {- Remote state logs.
  -
- - Copyright 2014 Joey Hess <id@joeyh.name>
+ - Copyright 2014, 2019 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -17,6 +17,7 @@ import qualified Annex.Branch
 import qualified Annex
 
 import qualified Data.Map as M
+import Data.ByteString.Builder
 
 type RemoteState = String
 
@@ -25,7 +26,10 @@ setRemoteState u k s = do
 	c <- liftIO currentVectorClock
 	config <- Annex.getGitConfig
 	Annex.Branch.change (remoteStateLogFile config k) $
-		encodeBL . showLogNew id . changeLog c u s . parseLogNew Just . decodeBL
+		buildRemoteState . changeLog c u s . parseLogNew Just . decodeBL
+
+buildRemoteState :: Log RemoteState -> Builder
+buildRemoteState = buildLogNew (byteString . encodeBS)
 
 getRemoteState :: UUID -> Key -> Annex (Maybe RemoteState)
 getRemoteState u k = do

Logs/SingleValue/Pure.hs

@@ -33,9 +33,7 @@ buildLog :: (SingleValueSerializable v) => Log v -> Builder
 buildLog = mconcat . map genline . S.toList
   where
 	genline (LogEntry c v) =
-		byteString (encodeBS' (formatVectorClock c)) <> sp 
+		buildVectorClock c <> sp <> byteString (serialize v) <> nl
-			<> byteString (serialize v)
-			<> nl
 	sp = charUtf8 ' '
 	nl = charUtf8 '\n'
 

Logs/UUIDBased.hs

@@ -9,7 +9,7 @@
  -
  - New uuid based logs instead use the form: "timestamp UUID INFO"
  - 
- - Copyright 2011-2013 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2019 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -23,7 +23,7 @@ module Logs.UUIDBased (
 	parseLogNew,
 	parseLogWithUUID,
 	showLog,
-	showLogNew,
+	buildLogNew,
 	changeLog,
 	addLog,
 	simpleMap,
@@ -37,6 +37,8 @@ import Annex.VectorClock
 import Logs.MapLog
 import Logs.Line
 
+import Data.ByteString.Builder
+
 type Log v = MapLog UUID v
 
 showLog :: (v -> String) -> Log v -> String
@@ -74,8 +76,8 @@ parseLogWithUUID parser = M.fromListWith best . mapMaybe parse . splitLines
 			| ts == Unknown = drop 1 ws
 			| otherwise = drop 1 $ beginning ws
 
-showLogNew :: (v -> String) -> Log v -> String
+buildLogNew :: (v -> Builder) -> Log v -> Builder
-showLogNew = showMapLog fromUUID
+buildLogNew = buildMapLog (byteString . fromUUID)
 
 parseLogNew :: (String -> Maybe v) -> String -> Log v
 parseLogNew = parseMapLog (Just . toUUID)