byteslice 0.1.4.0 → 0.2.0.0

raw patch · 9 files changed

+703/−75 lines, 9 filesdep +primitive-unlifteddep +quickcheck-classesdep ~basedep ~run-stPVP ok

version bump matches the API change (PVP)

Dependencies added: primitive-unlifted, quickcheck-classes

Dependency ranges changed: base, run-st

API changes (from Hackage documentation)

Files

• CHANGELOG.md +31/−0
• byteslice.cabal +6/−3
• cbits/bs_custom.c +14/−3
• include/bs_custom.h +1/−1
• src/Data/Bytes.hs +314/−24
• src/Data/Bytes/Byte.hs +84/−37
• src/Data/Bytes/Chunks.hs +173/−0
• src/Data/Bytes/Types.hs +3/−0
• test/Main.hs +77/−7

@@ -1,5 +1,36 @@ # Revision history for byteslice +## 0.2.0.0 -- 2020-01-20++* Change behavior of `split`. This function previously had a special case+  for zero-length byte sequences to mirror the behavior `bytestring`'s+  behavior. Now, `split` returns a singleton list with the empty byte+  sequence in this case.+* Add `splitNonEmpty` so that users who need to take advantage of the+  non-null guarantee `split` provides can do so.+* Add `splitU` and `splitInitU` for users who are going to split a+  byte sequence without and consume the results more than once.+* Make the C code compile on platforms that do not have `rawmemchr`.+* Rename `splitOnce` to `split1`.+* Add `split2` and `split3`.+* Add `equalsLatin{1,2,3,4,5,6,7}`+* Add `ifoldl'`.+* Add `hGet` and `hPut`.+* Move `Data.Bytes.Chunks` from `small-bytearray-builder` to `byteslice`.+* Rename `Data.Bytes.Chunks.concat` to `concatU` (the U means unsliced),+  and add a new `concat` that returns `Bytes`.+* Add `fromBytes`, `fromByteArray`, and `unsafeCopy` to `Data.Bytes.Chunks`.+* Add `hGetContents` to `Data.Bytes.Chunks`.+* Add `isBytePrefixOf` and `isByteSuffixOf`.+* Add `replicate` and `replicateU`.+* Add `Monoid` instance for `Bytes`.+* Add `singleton`, `doubleton`, `tripleton`, and their unsliced variants.+* Rename `copy` to `unsafeCopy`.+* Add `fromLatinString`.+* Change the behavior of `fromAsciiString` to replace out-of-bounds codepoints+  with NUL.+* Add `unsnoc` and `uncons`.+ ## 0.1.4.0 -- 2019-11-12  * Add `toLatinString`.

@@ -1,6 +1,6 @@ cabal-version: 2.2 name: byteslice-version: 0.1.4.0+version: 0.2.0.0 synopsis: Slicing managed and unmanaged memory description:   This library provides types that allow the user to talk about a slice of@@ -20,6 +20,7 @@ library   exposed-modules:     Data.Bytes+    Data.Bytes.Chunks     Data.Bytes.Mutable     Data.Bytes.Types   other-modules:@@ -27,8 +28,9 @@   build-depends:     , base >=4.11.1 && <5     , primitive >=0.7 && <0.8+    , primitive-unlifted >=0.1.2 && <0.2     , primitive-addr >=0.1 && <0.2-    , run-st >=0.1 && <0.2+    , run-st >=0.1.1 && <0.2   hs-source-dirs: src   ghc-options: -Wall -O2   default-language: Haskell2010@@ -48,6 +50,7 @@     , byteslice     , bytestring     , primitive-    , tasty-hunit+    , quickcheck-classes >=0.6.4     , tasty+    , tasty-hunit     , tasty-quickcheck

@@ -8,14 +8,25 @@ // to the sizes buffer. This uses rawmemchr, so the total number of // occurrences of the delimiter must be computed in advance. This // returns the total length of all pieces processed.-HsInt memchr_ba_many(unsigned char *p, HsInt off, HsInt *sizes, HsInt sizesLen, unsigned char w) {+//+// Portability: On Linux, this uses rawmemchr. On all other platforms,+// it uses memchr. On Linux, the length of the byte sequence is not+// used. On other platforms, this is repeatedly decremented to provide+// an appropriate third argument for memchr.+HsInt memchr_ba_many(unsigned char *p, HsInt off, HsInt len, HsInt *sizes, HsInt sizesLen, unsigned char w) {   HsInt szIx, delta, total;   unsigned char* pos;   p = p + off;   total = 0;   for (szIx = 0; szIx < sizesLen; ++szIx) {-    pos = (unsigned char*)(rawmemchr((void*)p,w));-    delta = pos - p;+#ifdef __linux__+    pos = (unsigned char*)(rawmemchr((void*)p,(int)w));+    delta = (HsInt)(pos - p);+#else+    pos = (unsigned char*)(memchr((void*)p,(int)w,(size_t)len));+    delta = (HsInt)(pos - p);+    len = len - (delta + 1);+#endif     sizes[szIx] = delta;     total = total + delta + 1;     p = pos + 1;

@@ -3,5 +3,5 @@ #include <string.h> #include "Rts.h" -HsInt memchr_ba_many(unsigned char *p, HsInt off, HsInt *sizes, HsInt sizesLen, unsigned char w);+HsInt memchr_ba_many(unsigned char *p, HsInt off, HsInt len, HsInt *sizes, HsInt sizesLen, unsigned char w); HsInt count_ba(unsigned char *p, HsInt off, HsInt len, unsigned char w);

@@ -1,4 +1,5 @@ {-# language BangPatterns #-}+{-# language BlockArguments #-} {-# language MagicHash #-} {-# language NamedFieldPuns #-} {-# language TypeApplications #-}@@ -7,9 +8,25 @@ module Data.Bytes   ( -- * Types     Bytes+    -- * Constants+  , empty     -- * Properties   , null   , length+    -- * Decompose+  , uncons+  , unsnoc+    -- * Create+    -- ** Sliced+  , singleton+  , doubleton+  , tripleton+  , replicate+    -- ** Unsliced+  , singletonU+  , doubletonU+  , tripletonU+  , replicateU     -- * Filtering   , takeWhile   , dropWhile@@ -20,27 +37,46 @@   , foldl'   , foldr   , foldr'+    -- * Folds with Indices+  , ifoldl'     -- * Common Folds   , elem     -- * Splitting   , Byte.split+  , Byte.splitU   , Byte.splitInit-  , splitFirst+  , Byte.splitInitU+  , Byte.splitNonEmpty+  , split1+  , split2+  , split3     -- * Counting   , Byte.count     -- * Prefix and Suffix+    -- ** Byte Sequence   , isPrefixOf   , isSuffixOf   , stripPrefix   , stripOptionalPrefix   , stripSuffix   , stripOptionalSuffix+    -- ** Single Byte+  , isBytePrefixOf+  , isByteSuffixOf+    -- * Equality+  , equalsLatin1+  , equalsLatin2+  , equalsLatin3+  , equalsLatin4+  , equalsLatin5+  , equalsLatin6+  , equalsLatin7     -- * Unsafe Slicing   , unsafeTake   , unsafeDrop   , unsafeIndex     -- * Copying-  , copy+  , unsafeCopy     -- * Pointers   , pin   , contents@@ -49,26 +85,32 @@   , toByteArray   , toByteArrayClone   , fromAsciiString+  , fromLatinString   , fromByteArray   , toLatinString+    -- * I\/O with Handles+  , hGet+  , hPut   ) where -import Prelude hiding (length,takeWhile,dropWhile,null,foldl,foldr,elem)+import Prelude hiding (length,takeWhile,dropWhile,null,foldl,foldr,elem,replicate)  import Control.Monad.Primitive (PrimMonad,PrimState,primitive_,unsafeIOToPrim) import Control.Monad.ST.Run (runByteArrayST)-import Control.Monad.ST (runST) import Data.Bytes.Types (Bytes(Bytes,array,offset)) import Data.Char (ord) import Data.Primitive (ByteArray(ByteArray),MutableByteArray)+import Foreign.Ptr (Ptr,plusPtr) import GHC.Exts (Int(I#),Char(C#),word2Int#,chr#) import GHC.Exts (Word#,Int#)+import GHC.IO (IO(IO)) import GHC.Word (Word8(W8#))-import Foreign.Ptr (Ptr,plusPtr)+import System.IO (Handle) -import qualified Data.Primitive as PM import qualified Data.Bytes.Byte as Byte+import qualified Data.Primitive as PM import qualified GHC.Exts as Exts+import qualified System.IO as IO  -- | Is the byte sequence empty? null :: Bytes -> Bool@@ -78,6 +120,37 @@ length :: Bytes -> Int length (Bytes _ _ len) = len +-- | Extract the head and tail of the 'Bytes', returning 'Nothing' if+-- it is empty.+uncons :: Bytes -> Maybe (Word8, Bytes)+uncons b = case length b of+  0 -> Nothing+  _ -> Just (unsafeIndex b 0, unsafeDrop 1 b)++-- | Extract the @init@ and @last@ of the 'Bytes', returning 'Nothing' if+-- it is empty.+unsnoc :: Bytes -> Maybe (Bytes, Word8)+unsnoc b@(Bytes arr off len) = case len of+  0 -> Nothing+  _ -> let !len' = len - 1 in+    Just (Bytes arr off len', unsafeIndex b len')++-- | Does the byte sequence begin with the given byte? False if the+-- byte sequence is empty.+isBytePrefixOf :: Word8 -> Bytes -> Bool+isBytePrefixOf w b = case length b of+  0 -> False+  _ -> unsafeIndex b 0 == w++-- | Does the byte sequence end with the given byte? False if the+-- byte sequence is empty.+isByteSuffixOf :: Word8 -> Bytes -> Bool+isByteSuffixOf w b = case len of+  0 -> False+  _ -> unsafeIndex b (len - 1) == w+  where+  len = length b+ -- | Is the first argument a prefix of the second argument? isPrefixOf :: Bytes -> Bytes -> Bool isPrefixOf (Bytes a aOff aLen) (Bytes b bOff bLen) =@@ -97,6 +170,56 @@     then compareByteArrays a aOff b (bOff + bLen - aLen) aLen == EQ     else False +-- | Create a byte sequence with one byte.+singleton :: Word8 -> Bytes+singleton !a = Bytes (singletonU a) 0 1++-- | Create a byte sequence with two bytes.+doubleton :: Word8 -> Word8 -> Bytes+doubleton !a !b = Bytes (doubletonU a b) 0 2++-- | Create a byte sequence with three bytes.+tripleton :: Word8 -> Word8 -> Word8 -> Bytes+tripleton !a !b !c = Bytes (tripletonU a b c) 0 3++-- | Create an unsliced byte sequence with one byte.+singletonU :: Word8 -> ByteArray+singletonU !a = runByteArrayST do+  arr <- PM.newByteArray 1+  PM.writeByteArray arr 0 a+  PM.unsafeFreezeByteArray arr++-- | Create an unsliced byte sequence with two bytes.+doubletonU :: Word8 -> Word8 -> ByteArray+doubletonU !a !b = runByteArrayST do+  arr <- PM.newByteArray 2+  PM.writeByteArray arr 0 a+  PM.writeByteArray arr 1 b+  PM.unsafeFreezeByteArray arr++-- | Create an unsliced byte sequence with three bytes.+tripletonU :: Word8 -> Word8 -> Word8 -> ByteArray+tripletonU !a !b !c = runByteArrayST do+  arr <- PM.newByteArray 3+  PM.writeByteArray arr 0 a+  PM.writeByteArray arr 1 b+  PM.writeByteArray arr 2 c+  PM.unsafeFreezeByteArray arr++-- | Replicate a byte @n@ times.+replicate ::+     Int -- ^ Desired length @n@+  -> Word8 -- ^ Byte to replicate+  -> Bytes+replicate !n !w = Bytes (replicateU n w) 0 n++-- | Variant of 'replicate' that returns a unsliced byte array.+replicateU :: Int -> Word8 -> ByteArray+replicateU !n !w = runByteArrayST do+  arr <- PM.newByteArray n+  PM.setByteArray arr 0 n w+  PM.unsafeFreezeByteArray arr+ -- | /O(n)/ Return the suffix of the second string if its prefix -- matches the entire first string. stripPrefix :: Bytes -> Bytes -> Maybe Bytes@@ -130,15 +253,57 @@ -- | Split a byte sequence on the first occurrence of the target -- byte. The target is removed from the result. For example: ----- >>> splitOnce 0xA [0x1,0x2,0xA,0xB]+-- >>> split1 0xA [0x1,0x2,0xA,0xB] -- Just ([0x1,0x2],[0xB])-splitFirst :: Word8 -> Bytes -> Maybe (Bytes,Bytes)-{-# inline splitFirst #-}-splitFirst w b@(Bytes arr off len) = case elemIndexLoop# w b of+split1 :: Word8 -> Bytes -> Maybe (Bytes,Bytes)+{-# inline split1 #-}+split1 w b@(Bytes arr off len) = case elemIndexLoop# w b of   (-1#) -> Nothing   i# -> let i = I# i# in     Just (Bytes arr off (i - off), Bytes arr (i + 1) (len - (1 + i - off))) +-- | Split a byte sequence on the first and second occurrences+-- of the target byte. The target is removed from the result.+-- For example:+--+-- >>> split2 0xA [0x1,0x2,0xA,0xB,0xA,0xA,0xA]+-- Just ([0x1,0x2],[0xB],[0xA,0xA])+split2 :: Word8 -> Bytes -> Maybe (Bytes,Bytes,Bytes)+{-# inline split2 #-}+split2 w b@(Bytes arr off len) = case elemIndexLoop# w b of+  (-1#) -> Nothing+  i# -> let i = I# i# in+    case elemIndexLoop# w (Bytes arr (i + 1) (len - (1 + i - off))) of+      (-1#) -> Nothing+      j# -> let j = I# j# in Just+        ( Bytes arr off (i - off)+        , Bytes arr (i + 1) (j - (i + 1))+        , Bytes arr (j + 1) (len - (1 + j - off))+        )++-- | Split a byte sequence on the first, second, and third occurrences+-- of the target byte. The target is removed from the result.+-- For example:+--+-- >>> split3 0xA [0x1,0x2,0xA,0xB,0xA,0xA,0xA]+-- Just ([0x1,0x2],[0xB],[],[0xA])+split3 :: Word8 -> Bytes -> Maybe (Bytes,Bytes,Bytes,Bytes)+{-# inline split3 #-}+split3 w b@(Bytes arr off len) = case elemIndexLoop# w b of+  (-1#) -> Nothing+  i# -> let i = I# i# in+    case elemIndexLoop# w (Bytes arr (i + 1) (len - (1 + i - off))) of+      (-1#) -> Nothing+      j# -> let j = I# j# in+        case elemIndexLoop# w (Bytes arr (j + 1) (len - (1 + j - off))) of+          (-1#) -> Nothing+          k# -> let k = I# k# in Just+            ( Bytes arr off (i - off)+            , Bytes arr (i + 1) (j - (i + 1))+            , Bytes arr (j + 1) (k - (j + 1))+            , Bytes arr (k + 1) (len - (1 + k - off))+            )+ -- This returns the offset into the byte array. This is not an index -- that will mean anything to the end user, so it cannot be returned -- to them.@@ -149,6 +314,8 @@     then off#     else elemIndexLoop# w (Bytes arr (off + 1) (len - 1)) ++-- | Is the byte a member of the byte sequence? elem :: Word8 -> Bytes -> Bool elem (W8# w) b = case elemLoop 0# w b of   1# -> True@@ -251,6 +418,15 @@     0 -> a     _ -> go (f a (PM.indexByteArray arr off)) (off + 1) (len - 1) +-- | Left fold over bytes, strict in the accumulator. The reduction function+-- is applied to each element along with its index.+ifoldl' :: (a -> Int -> Word8 -> a) -> a -> Bytes -> a+{-# inline ifoldl' #-}+ifoldl' f a0 (Bytes arr off0 len0) = go a0 0 off0 len0 where+  go !a !ix !off !len = case len of+    0 -> a+    _ -> go (f a ix (PM.indexByteArray arr off)) (ix + 1) (off + 1) (len - 1)+ -- | Right fold over bytes, strict in the accumulator. foldr' :: (Word8 -> a -> a) -> a -> Bytes -> a {-# inline foldr' #-}@@ -266,9 +442,8 @@ -- implies that all of the bytes are used. Otherwise, it makes a copy. toByteArray :: Bytes -> ByteArray toByteArray b@(Bytes arr off len)-  | off /= 0 = toByteArrayClone b-  | PM.sizeofByteArray arr /= len = toByteArrayClone b-  | otherwise = arr+  | off == 0, PM.sizeofByteArray arr == len = arr+  | otherwise = toByteArrayClone b  -- | Variant of 'toByteArray' that unconditionally makes a copy of -- the array backing the sliced 'Bytes' even if the original array@@ -279,11 +454,21 @@   PM.copyByteArray m 0 arr off len   PM.unsafeFreezeByteArray m --- | Convert a 'String' consisting of only characters---   in the ASCII block.+-- | Convert a 'String' consisting of only characters in the ASCII block+-- to a byte sequence. Any character with a codepoint above @U+007F@ is+-- replaced by @U+0000@. fromAsciiString :: String -> Bytes-fromAsciiString = fromByteArray . Exts.fromList . map (fromIntegral @Int @Word8 . ord)+fromAsciiString = fromByteArray+  . Exts.fromList+  . map (\c -> let i = ord c in if i < 128 then fromIntegral @Int @Word8 i else 0) +-- | Convert a 'String' consisting of only characters representable+-- by ISO-8859-1. These are encoded with ISO-8859-1. Any character+-- with a codepoint above @U+00FF@ is replace an unspecified byte.+fromLatinString :: String -> Bytes+fromLatinString =+  fromByteArray . Exts.fromList . map (fromIntegral @Int @Word8 . ord)+ -- | Interpret a byte sequence as text encoded by ISO-8859-1. toLatinString :: Bytes -> String toLatinString = foldr (\(W8# w) xs -> C# (chr# (word2Int# w)) : xs) []@@ -297,16 +482,86 @@ compareByteArrays (ByteArray ba1#) (I# off1#) (ByteArray ba2#) (I# off2#) (I# n#) =   compare (I# (Exts.compareByteArrays# ba1# off1# ba2# off2# n#)) 0 +-- | Is the byte sequence, when interpreted as ISO-8859-1-encoded text,+-- a singleton whose element matches the character?+equalsLatin1 :: Char -> Bytes -> Bool+equalsLatin1 !c0 (Bytes arr off len) = case len of+  1 -> c0 == indexCharArray arr off+  _ -> False++-- | Is the byte sequence, when interpreted as ISO-8859-1-encoded text,+-- a doubleton whose elements match the characters?+equalsLatin2 :: Char -> Char -> Bytes -> Bool+equalsLatin2 !c0 !c1 (Bytes arr off len) = case len of+  2 -> c0 == indexCharArray arr off &&+       c1 == indexCharArray arr (off + 1)+  _ -> False++-- | Is the byte sequence, when interpreted as ISO-8859-1-encoded text,+-- a tripleton whose elements match the characters?+equalsLatin3 :: Char -> Char -> Char -> Bytes -> Bool+equalsLatin3 !c0 !c1 !c2 (Bytes arr off len) = case len of+  3 -> c0 == indexCharArray arr off &&+       c1 == indexCharArray arr (off + 1) &&+       c2 == indexCharArray arr (off + 2)+  _ -> False++-- | Is the byte sequence, when interpreted as ISO-8859-1-encoded text,+-- a quadrupleton whose elements match the characters?+equalsLatin4 :: Char -> Char -> Char -> Char -> Bytes -> Bool+equalsLatin4 !c0 !c1 !c2 !c3 (Bytes arr off len) = case len of+  4 -> c0 == indexCharArray arr off &&+       c1 == indexCharArray arr (off + 1) &&+       c2 == indexCharArray arr (off + 2) &&+       c3 == indexCharArray arr (off + 3)+  _ -> False++-- | Is the byte sequence, when interpreted as ISO-8859-1-encoded text,+-- a quintupleton whose elements match the characters?+equalsLatin5 :: Char -> Char -> Char -> Char -> Char -> Bytes -> Bool+equalsLatin5 !c0 !c1 !c2 !c3 !c4 (Bytes arr off len) = case len of+  5 -> c0 == indexCharArray arr off &&+       c1 == indexCharArray arr (off + 1) &&+       c2 == indexCharArray arr (off + 2) &&+       c3 == indexCharArray arr (off + 3) &&+       c4 == indexCharArray arr (off + 4)+  _ -> False++-- | Is the byte sequence, when interpreted as ISO-8859-1-encoded text,+-- a sextupleton whose elements match the characters?+equalsLatin6 :: Char -> Char -> Char -> Char -> Char -> Char -> Bytes -> Bool+equalsLatin6 !c0 !c1 !c2 !c3 !c4 !c5 (Bytes arr off len) = case len of+  6 -> c0 == indexCharArray arr off &&+       c1 == indexCharArray arr (off + 1) &&+       c2 == indexCharArray arr (off + 2) &&+       c3 == indexCharArray arr (off + 3) &&+       c4 == indexCharArray arr (off + 4) &&+       c5 == indexCharArray arr (off + 5)+  _ -> False++-- | Is the byte sequence, when interpreted as ISO-8859-1-encoded text,+-- a septupleton whose elements match the characters?+equalsLatin7 :: Char -> Char -> Char -> Char -> Char -> Char -> Char -> Bytes -> Bool+equalsLatin7 !c0 !c1 !c2 !c3 !c4 !c5 !c6 (Bytes arr off len) = case len of+  7 -> c0 == indexCharArray arr off &&+       c1 == indexCharArray arr (off + 1) &&+       c2 == indexCharArray arr (off + 2) &&+       c3 == indexCharArray arr (off + 3) &&+       c4 == indexCharArray arr (off + 4) &&+       c5 == indexCharArray arr (off + 5) &&+       c6 == indexCharArray arr (off + 6)+  _ -> False+ -- | Copy the byte sequence into a mutable buffer. The buffer must have -- enough space to accomodate the byte sequence, but this this is not -- checked.-copy :: PrimMonad m+unsafeCopy :: PrimMonad m   => MutableByteArray (PrimState m) -- ^ Destination   -> Int -- ^ Destination Offset   -> Bytes -- ^ Source   -> m ()-{-# inline copy #-}-copy dst dstIx (Bytes src srcIx len) =+{-# inline unsafeCopy #-}+unsafeCopy dst dstIx (Bytes src srcIx len) =   PM.copyByteArray dst dstIx src srcIx len  -- | Yields a pinned byte sequence whose contents are identical to those@@ -316,11 +571,12 @@ pin :: Bytes -> Bytes pin b@(Bytes arr _ len) = case PM.isByteArrayPinned arr of   True -> b-  False -> runST $ do-    dst <- PM.newPinnedByteArray len-    copy dst 0 b-    r <- PM.unsafeFreezeByteArray dst-    pure (Bytes r 0 len)+  False -> Bytes+    ( runByteArrayST do+        dst <- PM.newPinnedByteArray len+        unsafeCopy dst 0 b+        PM.unsafeFreezeByteArray dst+    ) 0 len  -- | Yields a pointer to the beginning of the byte sequence. It is only safe -- to call this on a 'Bytes' backed by a pinned @ByteArray@.@@ -333,3 +589,37 @@ touch :: PrimMonad m => Bytes -> m () touch (Bytes (ByteArray arr) _ _) = unsafeIOToPrim   (primitive_ (\s -> Exts.touch# arr s))++indexCharArray :: ByteArray -> Int -> Char+indexCharArray (ByteArray arr) (I# off) = C# (Exts.indexCharArray# arr off)++-- | The empty byte sequence.+empty :: Bytes+empty = Bytes mempty 0 0++-- | Read 'Bytes' directly from the specified 'Handle'. The resulting+-- 'Bytes' are pinned. This is implemented with 'hGetBuf'.+hGet :: Handle -> Int -> IO Bytes+hGet h i = createPinnedAndTrim i (\p -> IO.hGetBuf h p i)++-- | Outputs 'Bytes' to the specified 'Handle'. This is implemented+-- with 'hPutBuf'.+hPut :: Handle -> Bytes -> IO ()+hPut h b0 = do+  let b1@(Bytes arr _ len) = pin b0+  IO.hPutBuf h (contents b1) len+  touchByteArrayIO arr++-- Only used internally.+createPinnedAndTrim :: Int -> (Ptr Word8 -> IO Int) -> IO Bytes+{-# inline createPinnedAndTrim #-}+createPinnedAndTrim maxSz f = do+  arr@(PM.MutableByteArray arr#) <- PM.newPinnedByteArray maxSz+  sz <- f (PM.mutableByteArrayContents arr)+  PM.shrinkMutablePrimArray (PM.MutablePrimArray @Exts.RealWorld @Word8 arr#) sz+  r <- PM.unsafeFreezeByteArray arr+  pure (Bytes r 0 sz)++touchByteArrayIO :: ByteArray -> IO ()+touchByteArrayIO (ByteArray x) =+  IO (\s -> (# Exts.touch# x s, () #))

@@ -13,20 +13,26 @@ module Data.Bytes.Byte   ( count   , split+  , splitU+  , splitNonEmpty   , splitInit+  , splitInitU   ) where  import Prelude hiding (length) -import GHC.IO (unsafeIOToST)+import Control.Monad.ST (runST)+import Control.Monad.ST.Run (runPrimArrayST)+import Data.Bytes.Types (Bytes(..))+import Data.List.NonEmpty (NonEmpty((:|))) import Data.Primitive (PrimArray(..),MutablePrimArray(..),ByteArray(..))+import Data.Primitive.Unlifted.Array (UnliftedArray) import Data.Word (Word8)-import GHC.Exts (Int(I#),ByteArray#,MutableByteArray#,Int#,Word#)-import GHC.Word (Word8(W8#))-import Data.Bytes.Types (Bytes(..))-import Control.Monad.ST.Run (runPrimArrayST)+import GHC.Exts (ByteArray#,MutableByteArray#)+import GHC.IO (unsafeIOToST)  import qualified Data.Primitive as PM+import qualified Data.Primitive.Unlifted.Array as PM import qualified GHC.Exts as Exts  -- | Count the number of times the byte appears in the sequence.@@ -34,11 +40,56 @@ count !b (Bytes{array=ByteArray arr,offset,length}) =   count_ba arr offset length b +-- | Variant of 'split' that returns an array of unsliced byte sequences.+-- Unlike 'split', this is not a good producer for list fusion. (It does+-- not return a list, so it could not be.) Prefer 'split' if the result+-- is going to be consumed exactly once by a good consumer. Prefer 'splitU'+-- if the result of the split is going to be around for a while and+-- inspected multiple times.+splitU :: Word8 -> Bytes -> UnliftedArray ByteArray+splitU !w !bs =+  let !lens = splitLengthsAlt w bs+      !lensSz = PM.sizeofPrimArray lens+   in splitCommonU lens lensSz bs++-- | Variant of 'splitU' that drops the trailing element. See 'splitInit'+-- for an explanation of why this may be useful.+splitInitU :: Word8 -> Bytes -> UnliftedArray ByteArray+splitInitU !w !bs =+  let !lens = splitLengthsAlt w bs+      !lensSz = PM.sizeofPrimArray lens+   in splitCommonU lens (lensSz - 1) bs++-- Internal function+splitCommonU ::+     PrimArray Int -- array of segment lengths+  -> Int -- number of lengths to consider+  -> Bytes+  -> UnliftedArray ByteArray+splitCommonU !lens !lensSz Bytes{array,offset=arrIx0} = runST do+  dst <- PM.unsafeNewUnliftedArray lensSz+  let go !lenIx !arrIx = if lenIx < lensSz+        then do+          let !len = PM.indexPrimArray lens lenIx+          buf <- PM.newByteArray len+          PM.copyByteArray buf 0 array arrIx len+          buf' <- PM.unsafeFreezeByteArray buf+          PM.writeUnliftedArray dst lenIx buf'+          go (lenIx + 1) (arrIx + len + 1)+        else pure ()+  go 0 arrIx0+  PM.unsafeFreezeUnliftedArray dst+  + -- | Break a byte sequence into pieces separated by the byte argument, -- consuming the delimiter. This function is a good producer for list -- fusion. It is common to immidiately consume the results of @split@ -- with @foldl'@, @traverse_@, @foldlM@, and being a good producer helps -- in this situation.+--+-- Note: this function differs from its counterpart in @bytestring@.+-- If the byte sequence is empty, this returns a singleton list with+-- the empty byte sequence. split :: Word8 -> Bytes -> [Bytes] {-# inline split #-} split !w !bs@Bytes{array,offset=arrIx0} = Exts.build@@ -50,11 +101,35 @@      in go 0 arrIx0   )   where-  !lens = splitLengths w bs+  !lens = splitLengthsAlt w bs   !lensSz = PM.sizeofPrimArray lens +-- | Variant of 'split' that returns the result as a 'NonEmpty'+-- instead of @[]@. This is also eligible for stream fusion.+splitNonEmpty :: Word8 -> Bytes -> NonEmpty Bytes+{-# inline splitNonEmpty #-}+splitNonEmpty !w !bs@Bytes{array,offset=arrIx0} =+  Bytes array arrIx0 len0 :| Exts.build+  (\g x0 ->+    let go !lenIx !arrIx = if lenIx < lensSz+          then let !len = PM.indexPrimArray lens lenIx in +            g (Bytes array arrIx len) (go (lenIx + 1) (arrIx + len + 1))+          else x0+     in go 1 (1 + (arrIx0 + len0))+  )+  where+  !lens = splitLengthsAlt w bs+  !lensSz = PM.sizeofPrimArray lens+  !len0 = PM.indexPrimArray lens 0 :: Int+ -- | Variant of 'split' that drops the trailing element. This behaves--- correctly even if the byte sequence is empty.+-- correctly even if the byte sequence is empty. This is a good producer+-- for list fusion. This is useful when splitting a text file+-- into lines.+-- <https://pubs.opengroup.org/onlinepubs/009695399/basedefs/xbd_chap03.html#tag_03_392 POSIX>+-- mandates that text files end with a newline, so the list resulting+-- from 'split' always has an empty byte sequence as its last element.+-- With 'splitInit', that unwanted element is discarded. splitInit :: Word8 -> Bytes -> [Bytes] {-# inline splitInit #-} splitInit !w !bs@Bytes{array,offset=arrIx0} = Exts.build@@ -71,11 +146,6 @@   !lens = splitLengthsAlt w bs   !lensSz = PM.sizeofPrimArray lens - 1 -splitLengths :: Word8 -> Bytes -> PrimArray Int-{-# inline splitLengths #-}-splitLengths (W8# b) Bytes{array=ByteArray arr,offset=I# off,length=I# len} =-  PrimArray (splitLengths# b arr off len)- -- Internal function. This is just like splitLengths except that -- it does not treat the empty byte sequences specially. The result -- for that byte sequence is a singleton array with the element zero.@@ -83,35 +153,12 @@ splitLengthsAlt b Bytes{array=ByteArray arr#,offset=off,length=len} = runPrimArrayST do   let !n = count_ba arr# off len b   dst@(MutablePrimArray dst# ) :: MutablePrimArray s Int <- PM.newPrimArray (n + 1)-  total <- unsafeIOToST (memchr_ba_many arr# off dst# n b)+  total <- unsafeIOToST (memchr_ba_many arr# off len dst# n b)   PM.writePrimArray dst n (len - total)   PM.unsafeFreezePrimArray dst --- Internal function. When the argument is the empty byte sequence, this--- returns an empty array of offsets.-splitLengths# :: Word# -> ByteArray# -> Int# -> Int# -> ByteArray#-{-# noinline splitLengths# #-}-splitLengths# b# arr# off# len# = result-  where-  b = W8# b#-  off = I# off#-  len = I# len#-  -- We make 0 a special case for compatibility with the behavior-  -- that the bytestring library provides.-  !(PrimArray result) = runPrimArrayST $ case len of-    0 -> do-      marr <- PM.newByteArray 0 -      ByteArray res# <- PM.unsafeFreezeByteArray marr-      pure (PrimArray res# )-    _ -> do-      let !n = count_ba arr# off len b-      dst@(MutablePrimArray dst# ) :: MutablePrimArray s Int <- PM.newPrimArray (n + 1)-      total <- unsafeIOToST (memchr_ba_many arr# off dst# n b)-      PM.writePrimArray dst n (len - total)-      PM.unsafeFreezePrimArray dst- foreign import ccall unsafe "bs_custom.h memchr_ba_many" memchr_ba_many-  :: ByteArray# -> Int -> MutableByteArray# s -> Int -> Word8 -> IO Int+  :: ByteArray# -> Int -> Int -> MutableByteArray# s -> Int -> Word8 -> IO Int  foreign import ccall unsafe "bs_custom.h count_ba" count_ba   :: ByteArray# -> Int -> Int -> Word8 -> Int

@@ -0,0 +1,173 @@+{-# language BangPatterns #-}+{-# language DerivingStrategies #-}+{-# language DuplicateRecordFields #-}+{-# language TypeFamilies #-}+{-# language MagicHash #-}+{-# language UnboxedTuples #-}+{-# language NamedFieldPuns #-}++-- | Chunks of bytes. This is useful as a target for a builder+-- or as a way to read a large amount of whose size is unknown+-- in advance. Structurally, this type is similar to+-- @Data.ByteString.Lazy.ByteString@. However, the type in this+-- module is strict in its spine. Additionally, none of the+-- @Handle@ functions perform lazy I\/O.+module Data.Bytes.Chunks+  ( -- * Types+    Chunks(..)+    -- * Properties+  , length+    -- * Manipulate+  , concat+  , concatU+  , reverse+  , reverseOnto+    -- * Create+  , fromBytes+  , fromByteArray+    -- * Copy to buffer+  , unsafeCopy+    -- * I\/O with Handles+  , hGetContents+  ) where++import Prelude hiding (length,concat,reverse)++import Control.Monad.ST.Run (runIntByteArrayST)+import Data.Bytes.Types (Bytes(Bytes))+import Data.Primitive (ByteArray(..),MutableByteArray(..))+import GHC.Exts (ByteArray#,MutableByteArray#)+import GHC.Exts (Int#,State#,Int(I#),(+#))+import GHC.ST (ST(..))+import System.IO (Handle)++import qualified GHC.Exts as Exts+import qualified Data.Primitive as PM+import qualified Data.Bytes.Types as B+import qualified Data.Bytes as Bytes++-- | A cons-list of byte sequences.+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++-- | This uses @concat@ to form an equivalence class.+instance Eq Chunks where+  -- TODO: There is a more efficient way to do this, but+  -- it is tedious.+  a == b = concat a == concat b++-- | Concatenate chunks into a single contiguous byte sequence.+concat :: Chunks -> Bytes+concat x = case x of+  ChunksNil -> Bytes.empty+  ChunksCons b y -> case y of+    ChunksNil -> b+    ChunksCons c z -> case concatFollowing2 b c z of+      (# len, r #) -> Bytes (ByteArray r) 0 (I# len)++-- | Variant of 'concat' that returns an unsliced byte sequence.+concatU :: Chunks -> ByteArray+concatU x = case x of+  ChunksNil -> mempty+  ChunksCons b y -> case y of+    ChunksNil -> Bytes.toByteArray b+    ChunksCons c z -> case concatFollowing2 b c z of+      (# _, r #) -> ByteArray r++concatFollowing2 :: Bytes -> Bytes -> Chunks -> (# Int#, ByteArray# #)+concatFollowing2+  (Bytes{array=c,offset=coff,length=szc}) +  (Bytes{array=d,offset=doff,length=szd}) ds =+    let !(I# x, ByteArray y) = runIntByteArrayST $ 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+          -- Note: len2 will always be the same as len.+          !len2 <- unsafeCopy dst szboth ds+          result <- PM.unsafeFreezeByteArray dst+          pure (len2,result)+     in (# x, y #)++-- | The total number of bytes in all the chunks.+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.+unsafeCopy ::+     MutableByteArray s -- ^ Destination+  -> Int -- ^ Destination offset+  -> Chunks -- ^ Source+  -> ST s Int -- ^ Returns the next index into the destination after the payload+{-# inline unsafeCopy #-}+unsafeCopy (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++-- | Read a handle's entire contents strictly into chunks.+hGetContents :: Handle -> IO Chunks+hGetContents !h = do+  result <- go ChunksNil+  pure $! reverse result+  where+  go !acc = do+    c <- Bytes.hGet h chunkSize+    let !r = ChunksCons c acc+    if Bytes.length c == chunkSize+      then go r+      else pure r++chunkSize :: Int+chunkSize = 16384 - 16++-- | Create a list of chunks with a single chunk.+fromBytes :: Bytes -> Chunks+fromBytes !b = ChunksCons b ChunksNil++-- | Variant of 'fromBytes' where the single chunk is unsliced.+fromByteArray :: ByteArray -> Chunks+fromByteArray !b = fromBytes (Bytes.fromByteArray b)

@@ -96,6 +96,9 @@     r <- PM.unsafeFreezeByteArray marr     pure (Bytes r 0 (lenA + lenB)) +instance Monoid Bytes where+  mempty = Bytes mempty 0 0+ compareByteArrays :: ByteArray -> Int -> ByteArray -> Int -> Int -> Ordering {-# INLINE compareByteArrays #-} compareByteArrays (ByteArray ba1#) (I# off1#) (ByteArray ba2#) (I# off2#) (I# n#) =

@@ -5,21 +5,29 @@ {-# language ScopedTypeVariables #-} {-# language TypeApplications #-} +{-# OPTIONS_GHC -fno-warn-orphans #-}++import Data.Bytes.Chunks (Chunks(ChunksNil,ChunksCons))+import Data.Bytes.Types (Bytes(Bytes))+import Data.Char (ord) import Data.Primitive (ByteArray)+import Data.Proxy (Proxy(..)) import Data.Word (Word8)-import Data.Char (ord)-import Data.Bytes.Types (Bytes(Bytes)) import Test.Tasty (defaultMain,testGroup,TestTree) import Test.Tasty.HUnit ((@=?),testCase) import Test.Tasty.QuickCheck ((===),testProperty,property,Discard(Discard))+import Test.Tasty.QuickCheck ((==>),Arbitrary) -import qualified Data.Bytes as Bytes import qualified Data.ByteString as ByteString+import qualified Data.Bytes as Bytes+import qualified Data.Bytes.Chunks as Chunks import qualified Data.Foldable as Foldable import qualified Data.List as List import qualified Data.Primitive as PM import qualified GHC.Exts as Exts+import qualified Test.QuickCheck.Classes as QCC import qualified Test.Tasty.HUnit as THU+import qualified Test.Tasty.QuickCheck as TQC  main :: IO () main = defaultMain tests@@ -93,15 +101,27 @@       ===       Bytes.count x (slicedPack xs)   , testProperty "split" $ \(x :: Word8) (xs :: [Word8]) ->+      not (List.null xs)+      ==>       ByteString.split x (ByteString.pack xs)       ===       map bytesToByteString (Bytes.split x (slicedPack xs))+  , testProperty "splitNonEmpty" $ \(x :: Word8) (xs :: [Word8]) ->+      Bytes.split x (slicedPack xs)+      ===+      Foldable.toList (Bytes.splitNonEmpty x (slicedPack xs))   , testProperty "splitInit" $ \(x :: Word8) (xs :: [Word8]) -> case xs of       [] -> Bytes.splitInit x (slicedPack xs) === []       _ ->          List.init (ByteString.split x (ByteString.pack xs))         ===         map bytesToByteString (Bytes.splitInit x (slicedPack xs))+  , testProperty "splitU" $ \(x :: Word8) (xs :: [Word8]) ->+      not (List.null xs)+      ==>+      Bytes.split x (slicedPack xs)+      ===+      map Bytes.fromByteArray (Exts.toList (Bytes.splitU x (slicedPack xs)))   , testCase "splitInit-A" $       [Bytes.fromAsciiString "hello", Bytes.fromAsciiString "world"]       @=?@@ -110,14 +130,39 @@       [Bytes.fromAsciiString "hello", Bytes.fromAsciiString "world"]       @=?       (Bytes.splitInit 0x0A (Bytes.fromAsciiString "hello\nworld\nthere"))-  , testProperty "splitFirst" $ \(x :: Word8) (xs :: [Word8]) ->+  , testProperty "split1" $ \(x :: Word8) (xs :: [Word8]) ->       case ByteString.split x (ByteString.pack xs) of-        [] -> Bytes.splitFirst x (slicedPack xs) === Nothing-        [_] -> Bytes.splitFirst x (slicedPack xs) === Nothing-        [y1,z1] -> case Bytes.splitFirst x (slicedPack xs) of+        [] -> Bytes.split1 x (slicedPack xs) === Nothing+        [_] -> Bytes.split1 x (slicedPack xs) === Nothing+        [y1,z1] -> case Bytes.split1 x (slicedPack xs) of           Nothing -> property False           Just (y2,z2) -> (y1,z1) === (bytesToByteString y2, bytesToByteString z2)         _ -> property Discard+  , testProperty "split2" $ \(xs :: [Word8]) (ys :: [Word8]) (zs :: [Word8]) ->+      (all (/=0xEF) xs && all (/=0xEF) ys && all (/=0xEF) zs)+      ==>+      case Bytes.split2 0xEF (slicedPack (xs ++ [0xEF] ++ ys ++ [0xEF] ++ zs)) of+        Just r -> r === (slicedPack xs, slicedPack ys, slicedPack zs)+        Nothing -> property False+  , testProperty "split3" $ \(ws :: [Word8]) (xs :: [Word8]) (ys :: [Word8]) (zs :: [Word8])->+      (all (/=0xEF) ws && all (/=0xEF) xs && all (/=0xEF) ys && all (/=0xEF) zs)+      ==>+      case Bytes.split3 0xEF (slicedPack (ws ++ [0xEF] ++ xs ++ [0xEF] ++ ys ++ [0xEF] ++ zs)) of+        Just r -> r === (slicedPack ws, slicedPack xs, slicedPack ys, slicedPack zs)+        Nothing -> property False+  , testGroup "Chunks"+    [ lawsToTest (QCC.eqLaws (Proxy :: Proxy Chunks))+    , lawsToTest (QCC.semigroupLaws (Proxy :: Proxy Chunks))+    , lawsToTest (QCC.monoidLaws (Proxy :: Proxy Chunks))+    , testGroup "concatenation"+      [ testProperty "concat=concatU" $ \(c :: Chunks) ->+          Chunks.concat c === Bytes.fromByteArray (Chunks.concatU c)+      , testProperty "concat-singleton" $ \(b :: Bytes) ->+          Chunks.concat (ChunksCons b ChunksNil) === b+      , testProperty "concatU-singleton" $ \(b :: Bytes) ->+          Chunks.concatU (ChunksCons b ChunksNil) === Bytes.toByteArray b+      ]+    ]   ]  bytes :: String -> Bytes@@ -136,3 +181,28 @@  bytesToByteString :: Bytes -> ByteString.ByteString bytesToByteString = ByteString.pack . Bytes.foldr (:) []++instance Arbitrary Bytes where+  arbitrary = do+    xs :: [Word8] <- TQC.arbitrary+    front <- TQC.choose (0,2)+    back <- TQC.choose (0,2)+    let frontPad = replicate front (254 :: Word8)+    let backPad = replicate back (254 :: Word8)+    let raw = Exts.fromList (frontPad ++ xs ++ backPad)+    pure (Bytes raw front (length xs))++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)