diff --git a/src/Data/ByteArray/Builder.hs b/src/Data/ByteArray/Builder.hs index a61228f..4b36b17 100644 --- a/src/Data/ByteArray/Builder.hs +++ b/src/Data/ByteArray/Builder.hs @@ -60,6 +60,7 @@ module Data.ByteArray.Builder , word8 -- ** Prefixing with Length , consLength32BE + , consLength64BE -- * Encode Floating-Point Types -- ** Human-Readable , doubleDec @@ -460,6 +461,23 @@ consLength32BE (Builder f) = Builder $ \arr off len s0 -> case len >=# 4# of (# s2, _ #) -> (# s2, r #) _ -> (# s0, (-1#) #) + +-- | Prefix a builder with its size in bytes. This size is +-- presented as a big-endian 64-bit word. See 'consLength32BE'. +consLength64BE :: Builder -> Builder +consLength64BE (Builder f) = Builder $ \arr off len s0 -> case len >=# 8# of + 1# -> case f arr (off +# 8# ) (len -# 8# ) s0 of + (# s1, r #) -> case r of + (-1#) -> (# s1, (-1#) #) + _ -> + let ST g = UnsafeBounded.pasteST + (Bounded.word64BE (fromIntegral ((I# r - I# off) - 8))) + (MutableByteArray arr) + (I# off) + in case g s1 of + (# s2, _ #) -> (# s2, r #) + _ -> (# s0, (-1#) #) + -- ShortText is already UTF-8 encoded. This is a no-op. shortTextToByteArray :: ShortText -> ByteArray shortTextToByteArray x = case TS.toShortByteString x of diff --git a/test/Main.hs b/test/Main.hs index c2ab6e0..6f27852 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -61,6 +61,10 @@ tests = testGroup "Tests" run 1 (consLength32BE (word8Dec w)) === pack ('\x00' : '\x00' : '\x00' : chr (L.length (show w)) : show w) + , TQC.testProperty "consLength64BE" $ \w -> + run 1 (consLength64BE (word16Dec w)) + === + pack ('\x00' : '\x00' : '\x00' : '\x00' : '\x00' : '\x00' : '\x00' : chr (L.length (show w)) : show w) , TQC.testProperty "pasteArrayST" $ \(xs :: [Word64]) -> (runArray word64Dec (V.fromList xs)) ===