From 575d29730dfd7a6700597e43b4d90f2362ac0ee1 Mon Sep 17 00:00:00 2001
From: Andrew Martin <andrew.thaddeus@gmail.com>
Date: Fri, 25 Oct 2019 12:57:56 -0400
Subject: [PATCH] Add little-endian variant of length-consing function

---
 CHANGELOG.md                  |  1 +
 src/Data/ByteArray/Builder.hs | 22 ++++++++++++++++++++++
 2 files changed, 23 insertions(+)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index ba12082..1d5cebc 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -6,6 +6,7 @@
   both the single and multiple element variants.
 * Export `reverseCommitsOntoChunks` from the `Unsafe` module.
 * Add `Semigroup` and `Monoid` instances for `Chunks`.
+* Add `consLengthLE32`.
 
 ## 0.3.0.0 -- 2019-10-17
 
diff --git a/src/Data/ByteArray/Builder.hs b/src/Data/ByteArray/Builder.hs
index 18614c0..a77117b 100644
--- a/src/Data/ByteArray/Builder.hs
+++ b/src/Data/ByteArray/Builder.hs
@@ -88,6 +88,7 @@ module Data.ByteArray.Builder
   , int32ArrayLE
   , int16ArrayLE
     -- ** Prefixing with Length
+  , consLength32LE
   , consLength32BE
   , consLength64BE
     -- * Encode Floating-Point Types
@@ -683,6 +684,27 @@ word16BE w = fromBounded Nat.constant (Bounded.word16BE w)
 word8 :: Word8 -> Builder
 word8 w = fromBoundedOne (Bounded.word8 w)
 
+-- | Variant of 'consLength32BE' the encodes the length in
+-- a little-endian fashion.
+consLength32LE :: Builder -> Builder
+consLength32LE (Builder f) = Builder $ \buf0 off0 len0 cs0 s0 ->
+  let !(# s1, buf1, off1, len1, cs1 #) = case len0 >=# 4# of
+        1# -> (# s0, buf0, off0, len0, cs0 #)
+        _ -> case Exts.newByteArray# 4080# s0 of
+          (# sX, bufX #) ->
+            (# sX, bufX, 0#, 4080#, Mutable buf0 off0 cs0 #)
+   in case f buf1 (off1 +# 4# ) (len1 -# 4# ) cs1 s1 of
+        (# s2, buf2, off2, len2, cs2 #) ->
+          let !dist = case Exts.sameMutableByteArray# buf1 buf2 of
+                1# -> off2 -# off1
+                _ -> commitDistance buf1 off2 cs2 -# off1
+              ST g = UnsafeBounded.pasteST
+                (Bounded.word32LE (fromIntegral (I# (dist -# 4# ))))
+                (MutableByteArray buf1)
+                (I# off1)
+           in case g s2 of
+                (# s3, _ #) -> (# s3, buf2, off2, len2, cs2 #)
+
 -- | Prefix a builder with its size in bytes. This size is
 -- presented as a big-endian 32-bit word. The need to prefix
 -- a builder with its length shows up a numbers of wire protocols