diff --git a/CHANGELOG.md b/CHANGELOG.md index d51176e..abef4a3 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -6,6 +6,8 @@ that require prefixing a payload with its length. * Add `int64BE` as a convenience. * Add little-endian encoding functions for `Word16`, `Word32`, and `Word64`. +* Add big-endian and little-endian functions for copying a + `PrimArray` of numbers into a builder. * Add `flush`, `copy`, and `insert` for better control when converting byte sequences to builders. diff --git a/small-bytearray-builder.cabal b/small-bytearray-builder.cabal index 97fba3c..a2e699d 100644 --- a/small-bytearray-builder.cabal +++ b/small-bytearray-builder.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: small-bytearray-builder -version: 0.2.2.0 +version: 0.3.0.0 synopsis: Serialize to a small byte arrays description: This is similar to the builder facilities provided by diff --git a/src/Data/ByteArray/Builder.hs b/src/Data/ByteArray/Builder.hs index 1c7e59e..6166cac 100644 --- a/src/Data/ByteArray/Builder.hs +++ b/src/Data/ByteArray/Builder.hs @@ -64,8 +64,14 @@ module Data.ByteArray.Builder , int64LE -- *** Many , word8Array + -- **** Big Endian + , word16ArrayBE + , word32ArrayBE + , word64ArrayBE -- **** Little Endian , word16ArrayLE + , word32ArrayLE + , word64ArrayLE -- ** Prefixing with Length , consLength32BE , consLength64BE @@ -222,20 +228,97 @@ insert (Bytes (ByteArray src# ) (I# soff# ) (I# slen# )) = Builder word8Array :: PrimArray Word8 -> Int -> Int -> Builder word8Array (PrimArray arr) off len = bytes (Bytes (ByteArray arr) off len) +word64ArrayLE :: PrimArray Word64 -> Int -> Int -> Builder +word64ArrayLE src@(PrimArray arr) soff0 slen0 = case targetByteOrder of + LittleEndian -> bytes (Bytes (ByteArray arr) (soff0 * 8) (slen0 * 8)) + BigEndian -> word64ArraySwap src soff0 slen0 + +word64ArrayBE :: PrimArray Word64 -> Int -> Int -> Builder +word64ArrayBE src@(PrimArray arr) soff0 slen0 = case targetByteOrder of + BigEndian -> bytes (Bytes (ByteArray arr) (soff0 * 8) (slen0 * 8)) + LittleEndian -> word64ArraySwap src soff0 slen0 + +word32ArrayLE :: PrimArray Word32 -> Int -> Int -> Builder +word32ArrayLE src@(PrimArray arr) soff0 slen0 = case targetByteOrder of + LittleEndian -> bytes (Bytes (ByteArray arr) (soff0 * 4) (slen0 * 4)) + BigEndian -> word32ArraySwap src soff0 slen0 + +word32ArrayBE :: PrimArray Word32 -> Int -> Int -> Builder +word32ArrayBE src@(PrimArray arr) soff0 slen0 = case targetByteOrder of + BigEndian -> bytes (Bytes (ByteArray arr) (soff0 * 4) (slen0 * 4)) + LittleEndian -> word32ArraySwap src soff0 slen0 + word16ArrayLE :: PrimArray Word16 -> Int -> Int -> Builder word16ArrayLE src@(PrimArray arr) soff0 slen0 = case targetByteOrder of LittleEndian -> bytes (Bytes (ByteArray arr) (soff0 * 2) (slen0 * 2)) - BigEndian -> fromFunction (slen0 * 2) (go soff0 (soff0 + slen0)) + BigEndian -> word16ArraySwap src soff0 slen0 + +word16ArrayBE :: PrimArray Word16 -> Int -> Int -> Builder +word16ArrayBE src@(PrimArray arr) soff0 slen0 = case targetByteOrder of + BigEndian -> bytes (Bytes (ByteArray arr) (soff0 * 2) (slen0 * 2)) + LittleEndian -> word16ArraySwap src soff0 slen0 + +word16ArraySwap :: PrimArray Word16 -> Int -> Int -> Builder +word16ArraySwap src soff0 slen0 = + fromFunction (slen0 * 2) (go (soff0 * 2) ((soff0 + slen0) * 2)) where go :: Int -> Int -> MutableByteArray s -> Int -> ST s Int go !soff !send !dst !doff = if soff < send then do - doff' <- UnsafeBounded.pasteST - (Bounded.word16LE (PM.indexPrimArray src soff)) - dst doff - go (soff + 1) send dst doff' + let v0 = PM.indexPrimArray (asWord8s src) soff + v1 = PM.indexPrimArray (asWord8s src) (soff + 1) + PM.writeByteArray dst doff v1 + PM.writeByteArray dst (doff + 1) v0 + go (soff + 2) send dst (doff + 2) else pure doff +word32ArraySwap :: PrimArray Word32 -> Int -> Int -> Builder +word32ArraySwap src soff0 slen0 = + fromFunction (slen0 * 4) (go (soff0 * 4) ((soff0 + slen0) * 4)) + where + go :: Int -> Int -> MutableByteArray s -> Int -> ST s Int + go !soff !send !dst !doff = if soff < send + then do + let v0 = PM.indexPrimArray (asWord8s src) soff + v1 = PM.indexPrimArray (asWord8s src) (soff + 1) + v2 = PM.indexPrimArray (asWord8s src) (soff + 2) + v3 = PM.indexPrimArray (asWord8s src) (soff + 3) + PM.writeByteArray dst doff v3 + PM.writeByteArray dst (doff + 1) v2 + PM.writeByteArray dst (doff + 2) v1 + PM.writeByteArray dst (doff + 3) v0 + go (soff + 4) send dst (doff + 4) + else pure doff + +word64ArraySwap :: PrimArray Word64 -> Int -> Int -> Builder +word64ArraySwap src soff0 slen0 = + fromFunction (slen0 * 8) (go (soff0 * 8) ((soff0 + slen0) * 8)) + where + go :: Int -> Int -> MutableByteArray s -> Int -> ST s Int + go !soff !send !dst !doff = if soff < send + then do + let v0 = PM.indexPrimArray (asWord8s src) soff + v1 = PM.indexPrimArray (asWord8s src) (soff + 1) + v2 = PM.indexPrimArray (asWord8s src) (soff + 2) + v3 = PM.indexPrimArray (asWord8s src) (soff + 3) + v4 = PM.indexPrimArray (asWord8s src) (soff + 4) + v5 = PM.indexPrimArray (asWord8s src) (soff + 5) + v6 = PM.indexPrimArray (asWord8s src) (soff + 6) + v7 = PM.indexPrimArray (asWord8s src) (soff + 7) + PM.writeByteArray dst doff v7 + PM.writeByteArray dst (doff + 1) v6 + PM.writeByteArray dst (doff + 2) v5 + PM.writeByteArray dst (doff + 3) v4 + PM.writeByteArray dst (doff + 4) v3 + PM.writeByteArray dst (doff + 5) v2 + PM.writeByteArray dst (doff + 6) v1 + PM.writeByteArray dst (doff + 7) v0 + go (soff + 8) send dst (doff + 8) + else pure doff + +asWord8s :: PrimArray a -> PrimArray Word8 +asWord8s (PrimArray x) = PrimArray x + -- Internal function. Precondition, the referenced slice of the -- byte sequence is UTF-8 encoded text. slicedUtf8TextJson :: ByteArray# -> Int# -> Int# -> Builder diff --git a/test/Main.hs b/test/Main.hs index f78e56b..5fe9994 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -4,8 +4,8 @@ {-# language OverloadedStrings #-} import Control.Monad.ST (runST) -import Data.Bytes.Types (MutableBytes(..)) import Data.ByteArray.Builder +import Data.Primitive (PrimArray) import Data.Word import Data.Char (ord,chr) import Data.Primitive (ByteArray) @@ -134,6 +134,36 @@ tests = testGroup "Tests" byteArray d <> byteArray e <> byteArray f <> byteArray g <> byteArray h <> byteArray i ) + , TQC.testProperty "word16ArrayLE" $ \(xs :: [Word16]) -> + let ys = Exts.fromList xs :: PrimArray Word16 + in runConcat 1 (foldMap word16LE xs) + === + runConcat 1 (word16ArrayLE ys 0 (Prelude.length xs)) + , TQC.testProperty "word16ArrayBE" $ \(xs :: [Word16]) -> + let ys = Exts.fromList xs :: PrimArray Word16 + in runConcat 1 (foldMap word16BE xs) + === + runConcat 1 (word16ArrayBE ys 0 (Prelude.length xs)) + , TQC.testProperty "word32ArrayLE" $ \(xs :: [Word32]) -> + let ys = Exts.fromList xs :: PrimArray Word32 + in runConcat 1 (foldMap word32LE xs) + === + runConcat 1 (word32ArrayLE ys 0 (Prelude.length xs)) + , TQC.testProperty "word32ArrayBE" $ \(xs :: [Word32]) -> + let ys = Exts.fromList xs :: PrimArray Word32 + in runConcat 1 (foldMap word32BE xs) + === + runConcat 1 (word32ArrayBE ys 0 (Prelude.length xs)) + , TQC.testProperty "word64ArrayLE" $ \(xs :: [Word64]) -> + let ys = Exts.fromList xs :: PrimArray Word64 + in runConcat 1 (foldMap word64LE xs) + === + runConcat 1 (word64ArrayLE ys 0 (Prelude.length xs)) + , TQC.testProperty "word64ArrayBE" $ \(xs :: [Word64]) -> + let ys = Exts.fromList xs :: PrimArray Word64 + in runConcat 1 (foldMap word64BE xs) + === + runConcat 1 (word64ArrayBE ys 0 (Prelude.length xs)) ] , testGroup "alternate" [ TQC.testProperty "HexWord64" $ \x y ->