add consLength64BE

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

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))
         ===