byteslice 0.2.2.0 → 0.2.3.0

raw patch · 12 files changed

+554/−234 lines, 12 filesdep +tuplesdep +vectorPVP ok

version bump matches the API change (PVP)

Dependencies added: tuples, vector

API changes (from Hackage documentation)

Files

• CHANGELOG.md +14/−0
• byteslice.cabal +12/−1
• src-no-unlifted-newtypes/UnliftedBytes.hs +14/−0
• src-unlifted-newtypes/UnliftedBytes.hs +15/−0
• src/Data/Bytes.hs +46/−221
• src/Data/Bytes/Byte.hs +118/−1
• src/Data/Bytes/Chunks.hs +130/−11
• src/Data/Bytes/Compat.hs +16/−0
• src/Data/Bytes/IO.hs +55/−0
• src/Data/Bytes/Pure.hs +120/−0
• src/Data/Bytes/Types.hs +2/−0
• test/Main.hs +12/−0

@@ -1,5 +1,19 @@ # Revision history for byteslice +## 0.2.3.0 -- 2020-04-30++* Add `fnv1a32` and `fnv1a64`, implementations of the 32-bit and+  64-bit variants of the FNV-1a hash algorithm, to both `Data.Bytes`+  and `Data.Bytes.Chunks`.+* Add `Data.Bytes.Chunks.null`.+* Add `readFile` to both `Data.Bytes` and `Data.Bytes.Chunks`.+* Add `foldl'` to `Data.Bytes.Chunks`.+* Add `split` to `Data.Bytes.Chunks`.+* Add `splitStream` for splitting as a good stream-fusion producer.+* Add `hPut` and `writeFile` to `Data.Bytes.Chunks`.+* Add `fromCString#`.+* Add `Bytes#` newtype on GHC 8.10 and up.+ ## 0.2.2.0 -- 2020-02-27  * Add `split4`.

@@ -1,6 +1,6 @@ cabal-version: 2.2 name: byteslice-version: 0.2.2.0+version: 0.2.3.0 synopsis: Slicing managed and unmanaged memory description:   This library provides types that allow the user to talk about a slice of@@ -24,15 +24,26 @@     Data.Bytes.Mutable     Data.Bytes.Types   other-modules:+    Data.Bytes.Compat     Data.Bytes.Byte+    Data.Bytes.Pure+    Data.Bytes.IO+    UnliftedBytes   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.1 && <0.2+    , tuples >=0.1 && <0.2+    , vector >=0.12 && <0.13   hs-source-dirs: src   ghc-options: -Wall -O2+  if impl(ghc>=8.10)+    hs-source-dirs: src-unlifted-newtypes+  else+    hs-source-dirs: src-no-unlifted-newtypes+    ghc-options: -fno-warn-dodgy-imports -fno-warn-dodgy-exports   default-language: Haskell2010   include-dirs: include   includes: bs_custom.h

@@ -0,0 +1,14 @@+{-# language MagicHash #-}+{-# language TypeFamilies #-}+{-# language TypeInType #-}+{-# language UndecidableInstances #-}++module UnliftedBytes+  ( Bytes#+  ) where++import GHC.TypeLits+import GHC.Exts (RuntimeRep(..),TYPE)++type family Bytes# :: TYPE ('TupleRep '[ 'UnliftedRep,'IntRep,'IntRep]) where+  Bytes# = TypeError ('Text "Bytes# not available before GHC 8.10")

@@ -0,0 +1,15 @@+{-# language GADTSyntax #-}+{-# language KindSignatures #-}+{-# language MagicHash #-}+{-# language TypeInType #-}+{-# language UnboxedTuples #-}+{-# language UnliftedNewtypes #-}++module UnliftedBytes+  ( Bytes#(..)+  ) where++import GHC.Exts (ByteArray#,Int#,RuntimeRep(..),TYPE)++newtype Bytes# :: TYPE ('TupleRep '[ 'UnliftedRep,'IntRep,'IntRep]) where+  Bytes# :: (# ByteArray#, Int#, Int# #) -> Bytes#

@@ -9,11 +9,11 @@   ( -- * Types     Bytes     -- * Constants-  , empty-  , emptyPinned+  , Pure.empty+  , Pure.emptyPinned     -- * Properties   , null-  , length+  , Pure.length     -- * Decompose   , uncons   , unsnoc@@ -38,7 +38,7 @@   , dropWhileEnd     -- * Folds   , foldl-  , foldl'+  , Pure.foldl'   , foldr   , foldr'     -- * Folds with Indices@@ -51,10 +51,11 @@   , Byte.splitInit   , Byte.splitInitU   , Byte.splitNonEmpty-  , split1-  , split2-  , split3-  , split4+  , Byte.splitStream+  , Byte.split1+  , Byte.split2+  , Byte.split3+  , Byte.split4     -- * Combining   , intercalate     -- * Counting@@ -85,59 +86,62 @@   , equalsLatin8     -- ** C Strings   , equalsCString+    -- * Hashing+  , Pure.fnv1a32+  , Pure.fnv1a64     -- * Unsafe Slicing   , unsafeTake   , unsafeDrop   , unsafeIndex     -- * Copying-  , unsafeCopy+  , Pure.unsafeCopy     -- * Pointers-  , pin-  , contents+  , Pure.pin+  , Pure.contents   , touch     -- * Conversion-  , toByteArray-  , toByteArrayClone+  , Pure.toByteArray+  , Pure.toByteArrayClone   , fromAsciiString   , fromLatinString-  , fromByteArray+  , Pure.fromByteArray   , toLatinString+  , fromCString#     -- * I\/O with Handles-  , hGet-  , hPut+  , BIO.hGet+  , readFile+  , BIO.hPut   ) where -import Prelude hiding (length,takeWhile,dropWhile,null,foldl,foldr,elem,replicate,any,all)+import Prelude hiding (length,takeWhile,dropWhile,null,foldl,foldr,elem,replicate,any,all,readFile) -import Control.Monad.Primitive (PrimMonad,PrimState,primitive_,unsafeIOToPrim)+import Control.Monad.Primitive (PrimMonad,primitive_,unsafeIOToPrim) import Control.Monad.ST.Run (runByteArrayST)+import Data.Bytes.Compat (cstringLength#)+import Data.Bytes.Pure (length,fromByteArray) import Data.Bytes.Types (Bytes(Bytes,array,offset)) import Data.Char (ord)-import Data.Primitive (ByteArray(ByteArray),MutableByteArray)+import Data.Primitive (ByteArray(ByteArray)) import Foreign.C.String (CString) import Foreign.Ptr (Ptr,plusPtr,castPtr)-import GHC.Exts (Int(I#),Char(C#),word2Int#,chr#)-import GHC.Exts (Word#,Int#)-import GHC.IO (IO(IO))+import GHC.Exts (Int(I#),Char(C#),Ptr(Ptr),word2Int#,chr#)+import GHC.Exts (Addr#,Word#,Int#) import GHC.Word (Word8(W8#))-import System.IO (Handle)  import qualified Data.Bytes.Byte as Byte+import qualified Data.Bytes.Chunks as Chunks+import qualified Data.Bytes.IO as BIO+import qualified Data.Bytes.Pure as Pure import qualified Data.Foldable as F import qualified Data.List as List import qualified Data.Primitive as PM import qualified Data.Primitive.Ptr as PM import qualified GHC.Exts as Exts-import qualified System.IO as IO  -- | Is the byte sequence empty? null :: Bytes -> Bool null (Bytes _ _ len) = len == 0 --- | The length of a slice of bytes.-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)@@ -280,98 +284,6 @@   then Bytes (array str) (offset str) (length str - length suf)   else str --- | Split a byte sequence on the first occurrence of the target--- byte. The target is removed from the result. For example:------ >>> split1 0xA [0x1,0x2,0xA,0xB]--- Just ([0x1,0x2],[0xB])-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))-            )---- | Split a byte sequence on the first, second, third, and fourth--- occurrences of the target byte. The target is removed from the result.--- For example:------ >>> split4 0xA [0x1,0x2,0xA,0xB,0xA,0xA,0xA]--- Just ([0x1,0x2],[0xB],[],[],[])-split4 :: Word8 -> Bytes -> Maybe (Bytes,Bytes,Bytes,Bytes,Bytes)-{-# inline split4 #-}-split4 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-            case elemIndexLoop# w (Bytes arr (k + 1) (len - (1 + k - off))) of-              (-1#) -> Nothing-              m# -> let m = I# m# 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) (m - (k + 1))-                , Bytes arr (m + 1) (len - (1 + m - 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.-elemIndexLoop# :: Word8 -> Bytes -> Int#-elemIndexLoop# !w (Bytes arr off@(I# off# ) len) = case len of-  0 -> (-1#)-  _ -> if PM.indexByteArray arr off == w-    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@@ -467,14 +379,6 @@     0 -> a0     _ -> f (PM.indexByteArray arr off) (go (off + 1) (len - 1)) --- | Left fold over bytes, strict in the accumulator.-foldl' :: (a -> Word8 -> a) -> a -> Bytes -> a-{-# inline foldl' #-}-foldl' f a0 (Bytes arr off0 len0) = go a0 off0 len0 where-  go !a !off !len = case len of-    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@@ -494,23 +398,6 @@     (-1) -> a     _ -> go (f (PM.indexByteArray arr off) a) (off - 1) (ix - 1) --- | Convert the sliced 'Bytes' to an unsliced 'ByteArray'. This--- reuses the array backing the sliced 'Bytes' if the slicing metadata--- implies that all of the bytes are used. Otherwise, it makes a copy.-toByteArray :: Bytes -> ByteArray-toByteArray b@(Bytes arr off len)-  | 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--- could be reused. Prefer 'toByteArray'.-toByteArrayClone :: Bytes -> ByteArray-toByteArrayClone (Bytes arr off len) = runByteArrayST $ do-  m <- PM.newByteArray len-  PM.copyByteArray m 0 arr off len-  PM.unsafeFreezeByteArray m- -- | 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@.@@ -530,9 +417,17 @@ toLatinString :: Bytes -> String toLatinString = foldr (\(W8# w) xs -> C# (chr# (word2Int# w)) : xs) [] --- | Create a slice of 'Bytes' that spans the entire argument array.-fromByteArray :: ByteArray -> Bytes-fromByteArray b = Bytes b 0 (PM.sizeofByteArray b)+-- | Copy a primitive string literal into managed memory.+fromCString# :: Addr# -> Bytes+fromCString# a = Bytes+  ( runByteArrayST $ do+      dst@(PM.MutableByteArray dst# ) <- PM.newByteArray len+      PM.copyPtrToMutablePrimArray+        (PM.MutablePrimArray dst# ) 0 (Ptr a :: Ptr Word8) len+      PM.unsafeFreezeByteArray dst+  ) 0 len+  where+  len = I# (cstringLength# a)  compareByteArrays :: ByteArray -> Int -> ByteArray -> Int -> Int -> Ordering {-# INLINE compareByteArrays #-}@@ -647,37 +542,6 @@         True -> go (plusPtr ptr 1) (off + 1) (len - 1)         False -> Nothing --- | 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.-unsafeCopy :: PrimMonad m-  => MutableByteArray (PrimState m) -- ^ Destination-  -> Int -- ^ Destination Offset-  -> Bytes -- ^ Source-  -> m ()-{-# 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--- of the original byte sequence. If the @ByteArray@ backing the argument--- was already pinned, this simply aliases the argument and does not perform--- any copying.-pin :: Bytes -> Bytes-pin b@(Bytes arr _ len) = case PM.isByteArrayPinned arr of-  True -> b-  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@.-contents :: Bytes -> Ptr Word8-contents (Bytes arr off _) = plusPtr (PM.byteArrayContents arr) off- -- | Touch the byte array backing the byte sequence. This sometimes needed -- after calling 'contents' so that the @ByteArray@ does not get garbage -- collected.@@ -688,48 +552,9 @@ 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---- | The empty byte sequence.-emptyPinned :: Bytes-emptyPinned = Bytes-  ( runByteArrayST-    (PM.newPinnedByteArray 0 >>= PM.unsafeFreezeByteArray)-  ) 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)-  touchMutableByteArrayIO 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, () #))--touchMutableByteArrayIO :: MutableByteArray s -> IO ()-touchMutableByteArrayIO (PM.MutableByteArray x) =-  IO (\s -> (# Exts.touch# x s, () #))+-- | Read an entire file strictly into a 'Bytes'.+readFile :: FilePath -> IO Bytes+readFile f = Chunks.concat <$> Chunks.readFile f  -- | /O(n)/ The intercalate function takes a separator 'Bytes' and a list of -- 'Bytes' and concatenates the list elements by interspersing the separator

@@ -15,8 +15,13 @@   , split   , splitU   , splitNonEmpty+  , splitStream   , splitInit   , splitInitU+  , split1+  , split2+  , split3+  , split4   ) where  import Prelude hiding (length)@@ -27,8 +32,10 @@ import Data.List.NonEmpty (NonEmpty((:|))) import Data.Primitive (PrimArray(..),MutablePrimArray(..),ByteArray(..)) import Data.Primitive.Unlifted.Array (UnliftedArray)+import Data.Tuple.Types (IntPair(IntPair))+import Data.Vector.Fusion.Stream.Monadic (Stream(Stream),Step(Yield,Done)) import Data.Word (Word8)-import GHC.Exts (ByteArray#,MutableByteArray#)+import GHC.Exts (ByteArray#,MutableByteArray#,Int#,Int(I#)) import GHC.IO (unsafeIOToST)  import qualified Data.Primitive as PM@@ -104,6 +111,24 @@   !lens = splitLengthsAlt w bs   !lensSz = PM.sizeofPrimArray lens +-- | Variant of 'split' that intended for use with stream fusion rather+-- than @build@-@foldr@ fusion.+splitStream :: forall m. Applicative m => Word8 -> Bytes -> Stream m Bytes+{-# inline [1] splitStream #-}+splitStream !w !bs@Bytes{array,offset=arrIx0} = Stream step (IntPair 0 arrIx0)+  where+  !lens = splitLengthsAlt w bs+  !lensSz = PM.sizeofPrimArray lens+  {-# inline [0] step #-}+  step :: IntPair -> m (Step IntPair Bytes)+  step (IntPair lenIx arrIx) = if lenIx < lensSz+    then do+      let !len = PM.indexPrimArray lens lenIx+          !element = Bytes array arrIx len+          !acc = IntPair (lenIx + 1) (arrIx + len + 1)+      pure (Yield element acc)+    else pure Done+ -- | Variant of 'split' that returns the result as a 'NonEmpty' -- instead of @[]@. This is also eligible for stream fusion. splitNonEmpty :: Word8 -> Bytes -> NonEmpty Bytes@@ -162,3 +187,95 @@  foreign import ccall unsafe "bs_custom.h count_ba" count_ba   :: ByteArray# -> Int -> Int -> Word8 -> Int++-- | Split a byte sequence on the first occurrence of the target+-- byte. The target is removed from the result. For example:+--+-- >>> split1 0xA [0x1,0x2,0xA,0xB]+-- Just ([0x1,0x2],[0xB])+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))+            )++-- | Split a byte sequence on the first, second, third, and fourth+-- occurrences of the target byte. The target is removed from the result.+-- For example:+--+-- >>> split4 0xA [0x1,0x2,0xA,0xB,0xA,0xA,0xA]+-- Just ([0x1,0x2],[0xB],[],[],[])+split4 :: Word8 -> Bytes -> Maybe (Bytes,Bytes,Bytes,Bytes,Bytes)+{-# inline split4 #-}+split4 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+            case elemIndexLoop# w (Bytes arr (k + 1) (len - (1 + k - off))) of+              (-1#) -> Nothing+              m# -> let m = I# m# 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) (m - (k + 1))+                , Bytes arr (m + 1) (len - (1 + m - 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.+elemIndexLoop# :: Word8 -> Bytes -> Int#+elemIndexLoop# !w (Bytes arr off@(I# off# ) len) = case len of+  0 -> (-1#)+  _ -> if PM.indexByteArray arr off == w+    then off#+    else elemIndexLoop# w (Bytes arr (off + 1) (len - 1))+

@@ -1,11 +1,12 @@ {-# language BangPatterns #-} {-# language DerivingStrategies #-} {-# language DuplicateRecordFields #-}-{-# language TypeFamilies #-} {-# language MagicHash #-}-{-# language UnboxedTuples #-} {-# language NamedFieldPuns #-} {-# language RankNTypes #-}+{-# language TypeApplications #-}+{-# language TypeFamilies #-}+{-# language UnboxedTuples #-}  -- | 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@@ -18,12 +19,20 @@     Chunks(..)     -- * Properties   , length+  , null     -- * Manipulate   , concat   , concatPinned   , concatU   , reverse   , reverseOnto+    -- * Folds+  , foldl'+    -- * Splitting+  , split+    -- * Hashing+  , fnv1a32+  , fnv1a64     -- * Create   , fromBytes   , fromByteArray@@ -31,22 +40,30 @@   , unsafeCopy     -- * I\/O with Handles   , hGetContents+  , readFile+  , hPut+  , writeFile   ) where -import Prelude hiding (length,concat,reverse)+import Prelude hiding (length,concat,reverse,readFile,writeFile,null) +import Control.Exception (IOException,catch) import Control.Monad.ST.Run (runIntByteArrayST)+import Data.Bits (xor) import Data.Bytes.Types (Bytes(Bytes))+import Data.Word (Word8,Word32,Word64) 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 System.IO (Handle,hFileSize,IOMode(ReadMode,WriteMode),withBinaryFile)  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+import qualified Data.Bytes.Pure as Bytes+import qualified Data.Bytes.Byte as Byte+import qualified Data.Bytes.IO as IO  -- | A cons-list of byte sequences. data Chunks@@ -69,6 +86,14 @@   -- it is tedious.   a == b = concat a == concat b +-- | Are there any bytes in the chunked byte sequences?+null :: Chunks -> Bool+null = go where+  go ChunksNil = True+  go (ChunksCons (Bytes _ _ len) xs) = case len of+    0 -> go xs+    _ -> False+ -- | Variant of 'concat' that ensure that the resulting byte -- sequence is pinned memory. concatPinned :: Chunks -> Bytes@@ -174,17 +199,48 @@  -- | Read a handle's entire contents strictly into chunks. hGetContents :: Handle -> IO Chunks-hGetContents !h = do-  result <- go ChunksNil-  pure $! reverse result-  where+hGetContents !h = hGetContentsCommon ChunksNil h++-- | Read a handle's entire contents strictly into chunks.+hGetContentsHint :: Int -> Handle -> IO Chunks+hGetContentsHint !hint !h = do+  c <- IO.hGet h hint+  let !r = ChunksCons c ChunksNil+  if Bytes.length c == hint+    then pure r+    else hGetContentsCommon r h++hGetContentsCommon ::+     Chunks -- reversed chunks+  -> Handle+  -> IO Chunks+hGetContentsCommon !acc0 !h = go acc0 where   go !acc = do-    c <- Bytes.hGet h chunkSize+    c <- IO.hGet h chunkSize     let !r = ChunksCons c acc     if Bytes.length c == chunkSize       then go r-      else pure r+      else pure $! reverse r +-- | Read an entire file strictly into chunks. If reading from a+-- regular file, this makes an effort read the file into a single+-- chunk.+readFile :: FilePath -> IO Chunks+readFile f = withBinaryFile f ReadMode $ \h -> do+  -- Implementation copied from bytestring.+  -- hFileSize fails if file is not regular file (like+  -- /dev/null). Catch exception and try reading anyway.+  filesz <- catch (hFileSize h) useZeroIfNotRegularFile+  let hint = (fromIntegral filesz `max` 255) + 1+  hGetContentsHint hint h+  -- Our initial size is one bigger than the file size so that in the+  -- typical case we will read the whole file in one go and not have+  -- to allocate any more chunks. We'll still do the right thing if the+  -- file size is 0 or is changed before we do the read.+  where+    useZeroIfNotRegularFile :: IOException -> IO Integer+    useZeroIfNotRegularFile _ = return 0+ chunkSize :: Int chunkSize = 16384 - 16 @@ -195,3 +251,66 @@ -- | Variant of 'fromBytes' where the single chunk is unsliced. fromByteArray :: ByteArray -> Chunks fromByteArray !b = fromBytes (Bytes.fromByteArray b)++-- | Left fold over all bytes in the chunks, strict in the accumulator.+foldl' :: (a -> Word8 -> a) -> a -> Chunks -> a+{-# inline foldl' #-}+foldl' g = go where+  go !a ChunksNil = a+  go !a (ChunksCons c cs) = go (Bytes.foldl' g a c) cs++-- | Hash byte sequence with 32-bit variant of FNV-1a.+fnv1a32 :: Chunks -> Word32+fnv1a32 = foldl'+  (\acc w -> (fromIntegral @Word8 @Word32 w `xor` acc) * 0x01000193+  ) 0x811c9dc5++-- | Hash byte sequence with 64-bit variant of FNV-1a.+fnv1a64 :: Chunks -> Word64+fnv1a64 = foldl'+  (\acc w -> (fromIntegral @Word8 @Word64 w `xor` acc) * 0x00000100000001B3+  ) 0xcbf29ce484222325++-- | Outputs 'Chunks' to the specified 'Handle'. This is implemented+-- with 'hPutBuf'.+hPut :: Handle -> Chunks -> IO ()+hPut h = go where+  go ChunksNil = pure ()+  go (ChunksCons c cs) = IO.hPut h c *> go cs++-- | Write 'Chunks' to a file, replacing the previous contents of+-- the file.+writeFile :: FilePath -> Chunks -> IO ()+writeFile path cs = withBinaryFile path WriteMode (\h -> hPut h cs)++-- | Break chunks of bytes into contiguous pieces separated by the+-- byte argument. This is a good producer for list fusion. For this+-- function to perform well, each chunk should contain multiple separators.+-- Any piece that spans multiple chunks must be copied.+split :: Word8 -> Chunks -> [Bytes]+{-# inline split #-}+split !w !cs0 = Exts.build+  (\g x0 ->+    -- It is possible to optimize for the common case where a+    -- piece does not span multiple chunks. However, such an+    -- optimization would actually cause this to tail call in+    -- two places rather than one and may actually adversely+    -- affect performance. It hasn't been benchmarked.+    let go !cs = case splitOnto ChunksNil w cs of+          (hd,tl) -> let !x = concat (reverse hd) in+            case tl of+              ChunksNil -> x0+              _ -> g x (go tl)+     in go cs0+  )++splitOnto :: Chunks -> Word8 -> Chunks -> (Chunks,Chunks)+{-# inline splitOnto #-}+splitOnto !acc0 !w !cs0 = go acc0 cs0 where+  go !acc ChunksNil = (acc,ChunksNil)+  go !acc (ChunksCons b bs) = case Byte.split1 w b of+    Nothing -> go (ChunksCons b acc) bs+    Just (hd,tl) ->+      let !r1 = ChunksCons hd acc+          !r2 = ChunksCons tl bs+       in (r1,r2)

@@ -0,0 +1,16 @@+{-# language MagicHash #-}+{-# language UnliftedFFITypes #-}++module Data.Bytes.Compat+  ( cstringLength#+  ) where++import GHC.Exts++-- GHC 8.12 comes with a known-key implementation of strlen that supports+-- constant folding. Here we define a shim for older GHCs.++foreign import ccall unsafe "strlen" c_strlen :: Addr# -> Int#++cstringLength# :: Addr# -> Int#+cstringLength# = c_strlen

@@ -0,0 +1,55 @@+{-# language BangPatterns #-}+{-# language BlockArguments #-}+{-# language MagicHash #-}+{-# language NamedFieldPuns #-}+{-# language TypeApplications #-}+{-# language UnboxedTuples #-}++module Data.Bytes.IO+  ( hGet+  , hPut+  ) where++import Data.Primitive (MutableByteArray,ByteArray(..))+import Data.Word (Word8)+import Data.Bytes.Types (Bytes(Bytes))+import Data.Bytes.Pure (pin,contents)+import System.IO (Handle)+import Foreign.Ptr (Ptr)+import GHC.IO (IO(IO))+import qualified System.IO as IO+import qualified GHC.Exts as Exts+import qualified Data.Primitive as PM++-- | 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)+  touchMutableByteArrayIO arr+  PM.shrinkMutablePrimArray (PM.MutablePrimArray @Exts.RealWorld @Word8 arr#) sz+  r <- PM.unsafeFreezeByteArray arr+  pure (Bytes r 0 sz)++touchMutableByteArrayIO :: MutableByteArray s -> IO ()+touchMutableByteArrayIO (PM.MutableByteArray x) =+  IO (\s -> (# Exts.touch# x s, () #))++touchByteArrayIO :: ByteArray -> IO ()+touchByteArrayIO (ByteArray x) =+  IO (\s -> (# Exts.touch# x s, () #))+

@@ -0,0 +1,120 @@+{-# language BangPatterns #-}+{-# language BlockArguments #-}+{-# language MagicHash #-}+{-# language NamedFieldPuns #-}+{-# language TypeApplications #-}+{-# language UnboxedTuples #-}++module Data.Bytes.Pure+  ( empty+  , emptyPinned+  , pin+  , contents+  , unsafeCopy+  , toByteArray+  , toByteArrayClone+  , fromByteArray+  , length+  , foldl'+  , fnv1a32+  , fnv1a64+  ) where++import Prelude hiding (length)++import Control.Monad.Primitive (PrimState,PrimMonad)+import Control.Monad.ST.Run (runByteArrayST)+import Data.Bits (xor)+import Data.Bytes.Types (Bytes(Bytes))+import Data.Primitive (ByteArray,MutableByteArray)+import Data.Word (Word64,Word32,Word8)+import Foreign.Ptr (Ptr,plusPtr)++import qualified Data.Primitive as PM++-- | The empty byte sequence.+empty :: Bytes+empty = Bytes mempty 0 0++-- | The empty byte sequence.+emptyPinned :: Bytes+emptyPinned = Bytes+  ( runByteArrayST+    (PM.newPinnedByteArray 0 >>= PM.unsafeFreezeByteArray)+  ) 0 0++-- | Yields a pinned byte sequence whose contents are identical to those+-- of the original byte sequence. If the @ByteArray@ backing the argument+-- was already pinned, this simply aliases the argument and does not perform+-- any copying.+pin :: Bytes -> Bytes+pin b@(Bytes arr _ len) = case PM.isByteArrayPinned arr of+  True -> b+  False -> Bytes+    ( runByteArrayST do+        dst <- PM.newPinnedByteArray len+        unsafeCopy dst 0 b+        PM.unsafeFreezeByteArray dst+    ) 0 len++-- | Convert the sliced 'Bytes' to an unsliced 'ByteArray'. This+-- reuses the array backing the sliced 'Bytes' if the slicing metadata+-- implies that all of the bytes are used. Otherwise, it makes a copy.+toByteArray :: Bytes -> ByteArray+toByteArray b@(Bytes arr off len)+  | 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+-- could be reused. Prefer 'toByteArray'.+toByteArrayClone :: Bytes -> ByteArray+toByteArrayClone (Bytes arr off len) = runByteArrayST $ do+  m <- PM.newByteArray len+  PM.copyByteArray m 0 arr off len+  PM.unsafeFreezeByteArray m++-- | 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.+unsafeCopy :: PrimMonad m+  => MutableByteArray (PrimState m) -- ^ Destination+  -> Int -- ^ Destination Offset+  -> Bytes -- ^ Source+  -> m ()+{-# inline unsafeCopy #-}+unsafeCopy dst dstIx (Bytes src srcIx len) =+  PM.copyByteArray dst dstIx src srcIx len++-- | Create a slice of 'Bytes' that spans the entire argument array.+fromByteArray :: ByteArray -> Bytes+fromByteArray b = Bytes b 0 (PM.sizeofByteArray b)++-- | The length of a slice of bytes.+length :: Bytes -> Int+length (Bytes _ _ len) = len++-- | Hash byte sequence with 32-bit variant of FNV-1a.+fnv1a32 :: Bytes -> Word32+fnv1a32 = foldl'+  (\acc w -> (fromIntegral @Word8 @Word32 w `xor` acc) * 0x01000193+  ) 0x811c9dc5++-- | Hash byte sequence with 64-bit variant of FNV-1a.+fnv1a64 :: Bytes -> Word64+fnv1a64 = foldl'+  (\acc w -> (fromIntegral @Word8 @Word64 w `xor` acc) * 0x00000100000001B3+  ) 0xcbf29ce484222325++-- | Left fold over bytes, strict in the accumulator.+foldl' :: (a -> Word8 -> a) -> a -> Bytes -> a+{-# inline foldl' #-}+foldl' f a0 (Bytes arr off0 len0) = go a0 off0 len0 where+  go !a !off !len = case len of+    0 -> a+    _ -> go (f a (PM.indexByteArray arr off)) (off + 1) (len - 1)++-- | 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@.+contents :: Bytes -> Ptr Word8+contents (Bytes arr off _) = plusPtr (PM.byteArrayContents arr) off

@@ -5,6 +5,7 @@  module Data.Bytes.Types   ( Bytes(..)+  , Bytes#(..)   , MutableBytes(..)   , UnmanagedBytes(..)   ) where@@ -19,6 +20,7 @@ import GHC.Base (unsafeChr) import GHC.Exts (Int(I#),unsafeCoerce#,sameMutableByteArray#) import GHC.Exts (isTrue#,compareByteArrays#,IsList(..))+import UnliftedBytes (Bytes#(..))  import qualified Data.List as L import qualified Data.Foldable as F

@@ -174,6 +174,18 @@       case Bytes.split4 0xEF (slicedPack (ws ++ [0xEF] ++ xs ++ [0xEF] ++ ys ++ [0xEF] ++ zs ++ [0xEF] ++ ps)) of         Just r -> r === (slicedPack ws, slicedPack xs, slicedPack ys, slicedPack zs, slicedPack ps)         Nothing -> property False+  , testGroup "FNV-1a"+    [ testGroup "32-bit"+      [ testCase "empty" (Bytes.fnv1a32 Bytes.empty @=? 0x811c9dc5)+      , testCase "a" (Bytes.fnv1a32 (bytes "a") @=? 0xe40c292c)+      , testCase "foobar" (Bytes.fnv1a32 (bytes "foobar") @=? 0xbf9cf968)+      ]+    , testGroup "64-bit"+      [ testCase "empty" (Bytes.fnv1a64 Bytes.empty @=? 0xcbf29ce484222325)+      , testCase "a" (Bytes.fnv1a64 (bytes "a") @=? 0xaf63dc4c8601ec8c)+      , testCase "foobar" (Bytes.fnv1a64 (bytes "foobar") @=? 0x85944171f73967e8)+      ]+    ]   , testGroup "Chunks"     [ lawsToTest (QCC.eqLaws (Proxy :: Proxy Chunks))     , lawsToTest (QCC.semigroupLaws (Proxy :: Proxy Chunks))