From 459c48a2d921bd226037639a6c9e5f2fbb7e9e3f Mon Sep 17 00:00:00 2001
From: Andrew Martin <andrew.thaddeus@gmail.com>
Date: Thu, 19 Sep 2019 12:10:13 -0400
Subject: [PATCH] add consLength64BE

---
 src/Data/ByteArray/Builder.hs | 18 ++++++++++++++++++
 test/Main.hs                  |  4 ++++
 2 files changed, 22 insertions(+)

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