Move Data.Bytes.Chunks into byteslice
This commit is contained in:
parent
d496f23fd8
commit
71fa47a8ee
3 changed files with 4 additions and 138 deletions
|
@ -36,14 +36,15 @@ flag checked
|
||||||
|
|
||||||
library
|
library
|
||||||
exposed-modules:
|
exposed-modules:
|
||||||
Data.Bytes.Chunks
|
|
||||||
Data.ByteArray.Builder
|
Data.ByteArray.Builder
|
||||||
Data.ByteArray.Builder.Unsafe
|
Data.ByteArray.Builder.Unsafe
|
||||||
Data.ByteArray.Builder.Bounded
|
Data.ByteArray.Builder.Bounded
|
||||||
Data.ByteArray.Builder.Bounded.Unsafe
|
Data.ByteArray.Builder.Bounded.Unsafe
|
||||||
|
reexported-modules:
|
||||||
|
Data.Bytes.Chunks
|
||||||
build-depends:
|
build-depends:
|
||||||
, base >=4.12.0.0 && <5
|
, base >=4.12.0.0 && <5
|
||||||
, byteslice >=0.1 && <0.3
|
, byteslice >=0.2 && <0.3
|
||||||
, bytestring >=0.10.8.2 && <0.11
|
, bytestring >=0.10.8.2 && <0.11
|
||||||
, natural-arithmetic >=0.1 && <0.2
|
, natural-arithmetic >=0.1 && <0.2
|
||||||
, primitive-offset >=0.2 && <0.3
|
, primitive-offset >=0.2 && <0.3
|
||||||
|
|
|
@ -1,112 +0,0 @@
|
||||||
{-# language BangPatterns #-}
|
|
||||||
{-# language DerivingStrategies #-}
|
|
||||||
{-# language DuplicateRecordFields #-}
|
|
||||||
{-# language TypeFamilies #-}
|
|
||||||
{-# language MagicHash #-}
|
|
||||||
{-# language UnboxedTuples #-}
|
|
||||||
{-# language NamedFieldPuns #-}
|
|
||||||
|
|
||||||
module Data.Bytes.Chunks
|
|
||||||
( Chunks(..)
|
|
||||||
, concat
|
|
||||||
, reverse
|
|
||||||
, reverseOnto
|
|
||||||
, length
|
|
||||||
) where
|
|
||||||
|
|
||||||
import Prelude hiding (length,concat,reverse)
|
|
||||||
|
|
||||||
import GHC.ST (ST(..))
|
|
||||||
import Data.Bytes.Types (Bytes(Bytes))
|
|
||||||
import Data.Primitive (ByteArray(..),MutableByteArray(..))
|
|
||||||
import GHC.Exts (ByteArray#,MutableByteArray#)
|
|
||||||
import GHC.Exts (Int#,State#,Int(I#),(+#))
|
|
||||||
import Control.Monad.ST.Run (runByteArrayST)
|
|
||||||
|
|
||||||
import qualified GHC.Exts as Exts
|
|
||||||
import qualified Data.Primitive as PM
|
|
||||||
import qualified Data.Bytes.Types as B
|
|
||||||
|
|
||||||
data Chunks
|
|
||||||
= ChunksCons {-# UNPACK #-} !Bytes !Chunks
|
|
||||||
| ChunksNil
|
|
||||||
deriving stock (Show)
|
|
||||||
|
|
||||||
instance Semigroup Chunks where
|
|
||||||
ChunksNil <> a = a
|
|
||||||
cs@(ChunksCons _ _) <> ChunksNil = cs
|
|
||||||
as@(ChunksCons _ _) <> bs@(ChunksCons _ _) =
|
|
||||||
reverseOnto bs (reverse as)
|
|
||||||
|
|
||||||
instance Monoid Chunks where
|
|
||||||
mempty = ChunksNil
|
|
||||||
|
|
||||||
instance Eq Chunks where
|
|
||||||
-- TODO: There is a more efficient way to do this, but
|
|
||||||
-- it is tedious.
|
|
||||||
a == b = concat a == concat b
|
|
||||||
|
|
||||||
concat :: Chunks -> ByteArray
|
|
||||||
concat x = ByteArray (concat# x)
|
|
||||||
|
|
||||||
concat# :: Chunks -> ByteArray#
|
|
||||||
{-# noinline concat# #-}
|
|
||||||
concat# ChunksNil = case mempty of {ByteArray x -> x}
|
|
||||||
concat# (ChunksCons (Bytes{array=c,offset=coff,length=szc}) cs) = case cs of
|
|
||||||
ChunksNil -> case c of {ByteArray x -> x}
|
|
||||||
ChunksCons (Bytes{array=d,offset=doff,length=szd}) ds ->
|
|
||||||
unBa $ runByteArrayST $ do
|
|
||||||
let szboth = szc + szd
|
|
||||||
len = chunksLengthGo szboth ds
|
|
||||||
dst <- PM.newByteArray len
|
|
||||||
PM.copyByteArray dst 0 c coff szc
|
|
||||||
PM.copyByteArray dst szc d doff szd
|
|
||||||
_ <- copy dst szboth ds
|
|
||||||
PM.unsafeFreezeByteArray dst
|
|
||||||
|
|
||||||
length :: Chunks -> Int
|
|
||||||
length = chunksLengthGo 0
|
|
||||||
|
|
||||||
chunksLengthGo :: Int -> Chunks -> Int
|
|
||||||
chunksLengthGo !n ChunksNil = n
|
|
||||||
chunksLengthGo !n (ChunksCons (Bytes{B.length=len}) cs) =
|
|
||||||
chunksLengthGo (n + len) cs
|
|
||||||
|
|
||||||
-- | Copy the contents of the chunks into a mutable array.
|
|
||||||
-- Precondition: The destination must have enough space to
|
|
||||||
-- house the contents. This is not checked.
|
|
||||||
copy ::
|
|
||||||
MutableByteArray s -- ^ Destination
|
|
||||||
-> Int -- ^ Destination offset
|
|
||||||
-> Chunks -- ^ Source
|
|
||||||
-> ST s Int -- ^ Returns the next index into the destination after the payload
|
|
||||||
{-# inline copy #-}
|
|
||||||
copy (MutableByteArray dst) (I# off) cs = ST
|
|
||||||
(\s0 -> case copy# dst off cs s0 of
|
|
||||||
(# s1, nextOff #) -> (# s1, I# nextOff #)
|
|
||||||
)
|
|
||||||
|
|
||||||
copy# :: MutableByteArray# s -> Int# -> Chunks -> State# s -> (# State# s, Int# #)
|
|
||||||
copy# _ off ChunksNil s0 = (# s0, off #)
|
|
||||||
copy# marr off (ChunksCons (Bytes{B.array,B.offset,B.length=len}) cs) s0 =
|
|
||||||
case Exts.copyByteArray# (unBa array) (unI offset) marr off (unI len) s0 of
|
|
||||||
s1 -> copy# marr (off +# unI len) cs s1
|
|
||||||
|
|
||||||
|
|
||||||
-- | Reverse chunks but not the bytes within each chunk.
|
|
||||||
reverse :: Chunks -> Chunks
|
|
||||||
reverse = reverseOnto ChunksNil
|
|
||||||
|
|
||||||
-- | Variant of 'reverse' that allows the caller to provide
|
|
||||||
-- an initial list of chunks that the reversed chunks will
|
|
||||||
-- be pushed onto.
|
|
||||||
reverseOnto :: Chunks -> Chunks -> Chunks
|
|
||||||
reverseOnto !x ChunksNil = x
|
|
||||||
reverseOnto !x (ChunksCons y ys) =
|
|
||||||
reverseOnto (ChunksCons y x) ys
|
|
||||||
|
|
||||||
unI :: Int -> Int#
|
|
||||||
unI (I# i) = i
|
|
||||||
|
|
||||||
unBa :: ByteArray -> ByteArray#
|
|
||||||
unBa (ByteArray x) = x
|
|
25
test/Main.hs
25
test/Main.hs
|
@ -8,14 +8,12 @@
|
||||||
import Control.Applicative (liftA2)
|
import Control.Applicative (liftA2)
|
||||||
import Control.Monad.ST (runST)
|
import Control.Monad.ST (runST)
|
||||||
import Data.ByteArray.Builder
|
import Data.ByteArray.Builder
|
||||||
import Data.Bytes.Types (Bytes(Bytes),MutableBytes(MutableBytes))
|
import Data.Bytes.Types (MutableBytes(MutableBytes))
|
||||||
import Data.Bytes.Chunks (Chunks(ChunksNil,ChunksCons))
|
|
||||||
import Data.Primitive (PrimArray)
|
import Data.Primitive (PrimArray)
|
||||||
import Data.Word
|
import Data.Word
|
||||||
import Data.Char (ord,chr)
|
import Data.Char (ord,chr)
|
||||||
import Data.IORef (IORef,newIORef,readIORef,writeIORef)
|
import Data.IORef (IORef,newIORef,readIORef,writeIORef)
|
||||||
import Data.Primitive (ByteArray)
|
import Data.Primitive (ByteArray)
|
||||||
import Data.Proxy (Proxy(..))
|
|
||||||
import Data.WideWord (Word128(Word128))
|
import Data.WideWord (Word128(Word128))
|
||||||
import Test.Tasty (defaultMain,testGroup,TestTree)
|
import Test.Tasty (defaultMain,testGroup,TestTree)
|
||||||
import Test.QuickCheck ((===),Arbitrary)
|
import Test.QuickCheck ((===),Arbitrary)
|
||||||
|
@ -33,7 +31,6 @@ import qualified Data.Primitive as PM
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text.Encoding as TE
|
import qualified Data.Text.Encoding as TE
|
||||||
import qualified GHC.Exts as Exts
|
import qualified GHC.Exts as Exts
|
||||||
import qualified Test.QuickCheck.Classes as QCC
|
|
||||||
import qualified Test.Tasty.HUnit as THU
|
import qualified Test.Tasty.HUnit as THU
|
||||||
import qualified Test.Tasty.QuickCheck as TQC
|
import qualified Test.Tasty.QuickCheck as TQC
|
||||||
|
|
||||||
|
@ -206,11 +203,6 @@ tests = testGroup "Tests"
|
||||||
===
|
===
|
||||||
pack (showWord64PaddedUpperHex x <> showWord64PaddedUpperHex y)
|
pack (showWord64PaddedUpperHex x <> showWord64PaddedUpperHex y)
|
||||||
]
|
]
|
||||||
, testGroup "Chunks"
|
|
||||||
[ lawsToTest (QCC.eqLaws (Proxy :: Proxy Chunks))
|
|
||||||
, lawsToTest (QCC.semigroupLaws (Proxy :: Proxy Chunks))
|
|
||||||
, lawsToTest (QCC.monoidLaws (Proxy :: Proxy Chunks))
|
|
||||||
]
|
|
||||||
, testGroup "putMany"
|
, testGroup "putMany"
|
||||||
[ THU.testCase "A" $ do
|
[ THU.testCase "A" $ do
|
||||||
ref <- newIORef []
|
ref <- newIORef []
|
||||||
|
@ -252,21 +244,6 @@ bytesOntoRef !ref (MutableBytes buf off len) = do
|
||||||
dst' <- PM.unsafeFreezeByteArray dst
|
dst' <- PM.unsafeFreezeByteArray dst
|
||||||
writeIORef ref (rs ++ [dst'])
|
writeIORef ref (rs ++ [dst'])
|
||||||
|
|
||||||
instance Arbitrary Chunks where
|
|
||||||
arbitrary = do
|
|
||||||
xs :: [[Word8]] <- TQC.arbitrary
|
|
||||||
let ys = map
|
|
||||||
(\x -> Exts.fromList ([255] ++ x ++ [255]))
|
|
||||||
xs
|
|
||||||
zs = foldr
|
|
||||||
(\b cs ->
|
|
||||||
ChunksCons (Bytes b 1 (PM.sizeofByteArray b - 2)) cs
|
|
||||||
) ChunksNil ys
|
|
||||||
pure zs
|
|
||||||
|
|
||||||
lawsToTest :: QCC.Laws -> TestTree
|
|
||||||
lawsToTest (QCC.Laws name pairs) = testGroup name (map (uncurry TQC.testProperty) pairs)
|
|
||||||
|
|
||||||
replicateByte :: Int -> Word8 -> ByteArray
|
replicateByte :: Int -> Word8 -> ByteArray
|
||||||
replicateByte n w = runST $ do
|
replicateByte n w = runST $ do
|
||||||
m <- PM.newByteArray n
|
m <- PM.newByteArray n
|
||||||
|
|
Loading…
Reference in a new issue