From 81ddcd5baaa0b8801a17b25b3126338e4e2f651b Mon Sep 17 00:00:00 2001 From: Ben Gamari Date: Wed, 17 May 2023 11:29:56 -0400 Subject: [PATCH] Track overall position in error reporting --- src/GHC/RTS/Events/Incremental.hs | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/src/GHC/RTS/Events/Incremental.hs b/src/GHC/RTS/Events/Incremental.hs index 22c0208..a016ae0 100644 --- a/src/GHC/RTS/Events/Incremental.hs +++ b/src/GHC/RTS/Events/Incremental.hs @@ -140,16 +140,18 @@ readEvents header = f . break isLeft . readEvents' header -- Note that it doesn't fail if it consumes all input in the middle of decoding -- of an event. readEvents' :: Header -> BL.ByteString -> [Either String Event] -readEvents' header = go (decodeEvents header) 0 +readEvents' header = go (decodeEvents header) 0 0 0 where - go :: Decoder Event -> Word64 -> BL.ByteString -> [Either String Event] - go decoder !event_n bytes = case decoder of - Produce event decoder' -> Right event : go decoder' (event_n+1) bytes + go :: Decoder Event -> Word64 -> Word64 -> Word64 -> BL.ByteString -> [Either String Event] + go decoder !last_chunk_sz !bytes_consumed !event_n bytes = case decoder of + Produce event decoder' -> Right event : go decoder' last_chunk_sz bytes_consumed (event_n+1) bytes Consume k -> case bytes of BL.Empty -> [] - BL.Chunk chunk chunks -> go (k chunk) event_n chunks + BL.Chunk chunk chunks -> go (k chunk) (fromIntegral $ B.length chunk) (bytes_consumed + last_chunk_sz) event_n chunks Done {} -> [] - Error _ err -> [Left $ "in event " ++ show event_n ++ ": " ++ err] + Error leftovers err -> + let pos = bytes_consumed + last_chunk_sz - fromIntegral (B.length leftovers) + in [Left $ concat [ "in event ", show event_n, " @ offset ", show pos, ": ", err] ] -- | Read an entire event log from a lazy bytestring. It returns an error message if it -- encounters an error while decoding.