bytesmith 0.3.0.0 → 0.3.1.0

raw patch · 9 files changed

+755/−17 lines, 9 filesdep +byte-orderdep +wide-worddep ~byteslicedep ~text-shortPVP ok

version bump matches the API change (PVP)

Dependencies added: byte-order, wide-word

Dependency ranges changed: byteslice, text-short

API changes (from Hackage documentation)

Files

• CHANGELOG.md +13/−1
• bytesmith.cabal +6/−1
• src/Data/Bytes/Parser.hs +1/−1
• src/Data/Bytes/Parser/Ascii.hs +41/−0
• src/Data/Bytes/Parser/BigEndian.hs +81/−0
• src/Data/Bytes/Parser/Internal.hs +109/−1
• src/Data/Bytes/Parser/Latin.hs +157/−9
• src/Data/Bytes/Parser/LittleEndian.hs +211/−0
• test/Main.hs +136/−4

@@ -1,6 +1,18 @@ # Revision history for bytesmith -## 0.3.0.0 -- 2019-??-??+## 0.3.1.0 -- 2019-11-12++* Add big-endian and little-endian parsers for `Word128`.+* Add a module for little-endian word parsers. This compliments the+  existing big-endian module.+* Add functions for parsing arrays of big/little endian words of+  various sizes.+* Add `skipUntil` to `Latin`.+* Add `char5`, `char6`, `char7`, `char8`, `char9`, `char10`, and+  `char11` to `Latin`.+* Correct the implementation of `takeTrailedBy`.++## 0.3.0.0 -- 2019-09-30  * Include the offset into the byte sequence in `Result`. Breaking change. * Rename `hexWord16` to `hexFixedWord16`. Breaking change.

@@ -1,6 +1,6 @@ cabal-version: 2.2 name: bytesmith-version: 0.3.0.0+version: 0.3.1.0 synopsis: Nonresumable byte parser description:   Parse bytes as fast as possible. This is a nonresumable parser@@ -20,6 +20,7 @@   exposed-modules:     Data.Bytes.Parser     Data.Bytes.Parser.BigEndian+    Data.Bytes.Parser.LittleEndian     Data.Bytes.Parser.Ascii     Data.Bytes.Parser.Latin     Data.Bytes.Parser.Unsafe@@ -35,6 +36,7 @@     , primitive >=0.7 && <0.8     , text-short >=0.1.3 && <0.2     , run-st >=0.1 && <0.2+    , wide-word >=0.1.0.9 && <0.2   hs-source-dirs: src   ghc-options: -O2 -Wall   default-language: Haskell2010@@ -53,6 +55,9 @@     , tasty-hunit     , tasty     , tasty-quickcheck+    , byte-order+    , text-short+    , wide-word  benchmark bench   type: exitcode-stdio-1.0

@@ -201,7 +201,7 @@   skipTrailedBy e w   !end <- cursor   !arr <- expose-  pure (Bytes arr start (end - start))+  pure (Bytes arr start (end - (start + 1)))  -- | Skip all characters until the character from the is encountered -- and then consume the matching byte as well.

@@ -33,6 +33,7 @@   , opt     -- * Match Many   , shortTrailedBy+  , takeShortWhile     -- * Skip   , Latin.skipDigits   , Latin.skipDigits1@@ -41,6 +42,7 @@   , skipAlpha   , skipAlpha1   , skipTrailedBy+  , skipWhile     -- * Numbers   , Latin.decWord   , Latin.decWord8@@ -57,6 +59,7 @@ import Data.Text.Short (ShortText) import Control.Monad.ST.Run (runByteArrayST) import GHC.Exts (Int(I#),Char(C#),Int#,Char#,(-#),(+#),(<#),ord#,indexCharArray#,chr#)+import GHC.Exts (gtChar#)  import qualified Data.ByteString.Short.Internal as BSS import qualified Data.Text.Short.Unsafe as TS@@ -77,6 +80,26 @@           else go   go +-- | Consume characters matching the predicate. The stops when it+-- encounters a non-matching character or when it encounters a byte+-- above @0x7F@. This never fails.+takeShortWhile :: (Char -> Bool) -> Parser e s ShortText+{-# inline takeShortWhile #-}+takeShortWhile p = do+  !start <- Unsafe.cursor+  skipWhile p+  end <- Unsafe.cursor+  src <- Unsafe.expose+  let len = end - start+      !r = runByteArrayST $ do+        marr <- PM.newByteArray len+        PM.copyByteArray marr 0 src start len+        PM.unsafeFreezeByteArray marr+  pure+    $ TS.fromShortByteStringUnsafe+    $ byteArrayToShortByteString+    $ r+ -- | Consume input through the next occurrence of the target -- character and return the consumed input, excluding the -- target character, as a 'ShortText'. This fails if it@@ -154,6 +177,24 @@                  (length chunk - 1)           else InternalFailure e   else InternalSuccess Nothing (offset chunk) (length chunk)++-- | Consume characters matching the predicate. The stops when it+-- encounters a non-matching character or when it encounters a byte+-- above @0x7F@. This never fails.+skipWhile :: (Char -> Bool) -> Parser e s ()+{-# inline skipWhile #-}+skipWhile p = Parser+  ( \(# arr, off0, len0 #) s0 ->+    let go off len = case len of+          0# -> (# (), off, 0# #)+          _ -> let c = indexCharArray# arr off in+            case p (C# c) of+              True -> case gtChar# c '\x7F'# of+                1# -> (# (), off, len #)+                _ -> go (off +# 1# ) (len -# 1# )+              False -> (# (), off, len #)+     in (# s0, (# | go off0 len0 #) #)+  )  -- | Skip uppercase and lowercase letters until a non-alpha -- character is encountered.

@@ -23,22 +23,36 @@   , word16   , word32   , word64+  , word128     -- * Signed   , int8   , int16   , int32   , int64+    -- * Many+    -- ** Unsigned+  , word16Array+  , word32Array+  , word64Array+  , word128Array   ) where  import Prelude hiding (length,any,fail,takeWhile) +import Control.Applicative (liftA2) import Data.Bits ((.|.),unsafeShiftL) import Data.Bytes.Types (Bytes(..)) import Data.Bytes.Parser.Internal (Parser,uneffectful) import Data.Bytes.Parser.Internal (InternalResult(..))+import Data.Bytes.Parser.Internal (swapArray16,swapArray32,swapArray64)+import Data.Bytes.Parser.Internal (swapArray128) import Data.Word (Word8,Word16,Word32,Word64) import Data.Int (Int8,Int16,Int32,Int64)+import Data.Primitive (ByteArray(..),PrimArray(..))+import Data.WideWord (Word128(Word128))+import GHC.ByteOrder (ByteOrder(LittleEndian,BigEndian),targetByteOrder) +import qualified Data.Bytes as Bytes import qualified Data.Bytes.Parser as P import qualified Data.Primitive as PM @@ -46,6 +60,69 @@ word8 :: e -> Parser e s Word8 word8 = P.any +-- | Parse an array of big-endian unsigned 16-bit words. If the host is+-- big-endian, the implementation is optimized to simply @memcpy@ bytes+-- into the result array. The result array always has elements in+-- native-endian byte order.+word16Array ::+     e -- ^ Error message if not enough bytes are present+  -> Int -- ^ Number of big-endian 16-bit words to expect+  -> Parser e s (PrimArray Word16) -- ^ Native-endian elements+word16Array e !n = case targetByteOrder of+  BigEndian -> fmap (asWord16s . Bytes.toByteArrayClone) (P.take e (n * 2))+  LittleEndian -> do+    bs <- P.take e (n * 2)+    let r = swapArray16 bs+    pure (asWord16s r)++-- | Parse an array of big-endian unsigned 32-bit words.+word32Array ::+     e -- ^ Error message if not enough bytes are present+  -> Int -- ^ Number of big-endian 32-bit words to expect+  -> Parser e s (PrimArray Word32) -- ^ Native-endian elements+word32Array e !n = case targetByteOrder of+  BigEndian -> fmap (asWord32s . Bytes.toByteArrayClone) (P.take e (n * 4))+  LittleEndian -> do+    bs <- P.take e (n * 4)+    let r = swapArray32 bs+    pure (asWord32s r)++-- | Parse an array of big-endian unsigned 64-bit words.+word64Array ::+     e -- ^ Error message if not enough bytes are present+  -> Int -- ^ Number of big-endian 64-bit words to consume+  -> Parser e s (PrimArray Word64) -- ^ Native-endian elements+word64Array e !n = case targetByteOrder of+  BigEndian -> fmap (asWord64s . Bytes.toByteArrayClone) (P.take e (n * 8))+  LittleEndian -> do+    bs <- P.take e (n * 8)+    let r = swapArray64 bs+    pure (asWord64s r)++-- | Parse an array of big-endian unsigned 128-bit words.+word128Array ::+     e -- ^ Error message if not enough bytes are present+  -> Int -- ^ Number of big-endian 128-bit words to consume+  -> Parser e s (PrimArray Word128) -- ^ Native-endian elements+word128Array e !n = case targetByteOrder of+  BigEndian -> fmap (asWord128s . Bytes.toByteArrayClone) (P.take e (n * 16))+  LittleEndian -> do+    bs <- P.take e (n * 16)+    let r = swapArray128 bs+    pure (asWord128s r)++asWord16s :: ByteArray -> PrimArray Word16+asWord16s (ByteArray x) = PrimArray x++asWord32s :: ByteArray -> PrimArray Word32+asWord32s (ByteArray x) = PrimArray x++asWord64s :: ByteArray -> PrimArray Word64+asWord64s (ByteArray x) = PrimArray x++asWord128s :: ByteArray -> PrimArray Word128+asWord128s (ByteArray x) = PrimArray x+ -- | Unsigned 16-bit word. word16 :: e -> Parser e s Word16 word16 e = uneffectful $ \chunk -> if length chunk >= 2@@ -100,6 +177,10 @@           )           (offset chunk + 8) (length chunk - 8)   else InternalFailure e++-- | Unsigned 128-bit word.+word128 :: e -> Parser e s Word128+word128 e = liftA2 Word128 (word64 e) (word64 e)  -- | Signed 8-bit integer. int8 :: e -> Parser e s Int8

@@ -8,6 +8,7 @@ {-# language LambdaCase #-} {-# language MagicHash #-} {-# language MultiWayIf #-}+{-# language NamedFieldPuns #-} {-# language PolyKinds #-} {-# language RankNTypes #-} {-# language ScopedTypeVariables #-}@@ -32,18 +33,26 @@   , fail   , indexLatinCharArray   , upcastUnitSuccess+    -- Swapping+  , swapArray16+  , swapArray32+  , swapArray64+  , swapArray128   ) where  import Prelude hiding (length,any,fail,takeWhile)  import Control.Applicative (Alternative)+import Control.Monad.ST.Run (runByteArrayST) import Data.Primitive (ByteArray(ByteArray))-import Data.Bytes.Types (Bytes(Bytes))+import Data.Bytes.Types (Bytes(..)) import Data.Kind (Type)+import Data.Word (Word8) import GHC.Exts (TYPE,RuntimeRep,Int(I#),Int#,State#,ByteArray#,Char(C#))  import qualified Control.Applicative import qualified Control.Monad+import qualified Data.Primitive as PM import qualified GHC.Exts as Exts  -- | A non-resumable parser.@@ -157,3 +166,102 @@ {-# inline upcastUnitSuccess #-} upcastUnitSuccess (# b, c #) = (# | (# (), b, c #) #) +swapArray16 :: Bytes -> ByteArray+swapArray16 (Bytes{array,offset,length}) = runByteArrayST $ do+  dst <- PM.newByteArray length+  let go !ixSrc !ixDst !len = if len > 0+        then do+          let v0 = PM.indexByteArray array ixSrc :: Word8+              v1 = PM.indexByteArray array (ixSrc + 1) :: Word8+          PM.writeByteArray dst ixDst v1+          PM.writeByteArray dst (ixDst + 1) v0+          go (ixSrc + 2) (ixDst + 2) (len - 2)+        else pure ()+  go offset 0 length+  PM.unsafeFreezeByteArray dst++swapArray32 :: Bytes -> ByteArray+swapArray32 (Bytes{array,offset,length}) = runByteArrayST $ do+  dst <- PM.newByteArray length+  let go !ixSrc !ixDst !len = if len > 0+        then do+          let v0 = PM.indexByteArray array ixSrc :: Word8+              v1 = PM.indexByteArray array (ixSrc + 1) :: Word8+              v2 = PM.indexByteArray array (ixSrc + 2) :: Word8+              v3 = PM.indexByteArray array (ixSrc + 3) :: Word8+          PM.writeByteArray dst ixDst v3+          PM.writeByteArray dst (ixDst + 1) v2+          PM.writeByteArray dst (ixDst + 2) v1+          PM.writeByteArray dst (ixDst + 3) v0+          go (ixSrc + 4) (ixDst + 4) (len - 4)+        else pure ()+  go offset 0 length+  PM.unsafeFreezeByteArray dst++swapArray64 :: Bytes -> ByteArray+swapArray64 (Bytes{array,offset,length}) = runByteArrayST $ do+  dst <- PM.newByteArray length+  let go !ixSrc !ixDst !len = if len > 0+        then do+          let v0 = PM.indexByteArray array ixSrc :: Word8+              v1 = PM.indexByteArray array (ixSrc + 1) :: Word8+              v2 = PM.indexByteArray array (ixSrc + 2) :: Word8+              v3 = PM.indexByteArray array (ixSrc + 3) :: Word8+              v4 = PM.indexByteArray array (ixSrc + 4) :: Word8+              v5 = PM.indexByteArray array (ixSrc + 5) :: Word8+              v6 = PM.indexByteArray array (ixSrc + 6) :: Word8+              v7 = PM.indexByteArray array (ixSrc + 7) :: Word8+          PM.writeByteArray dst ixDst v7+          PM.writeByteArray dst (ixDst + 1) v6+          PM.writeByteArray dst (ixDst + 2) v5+          PM.writeByteArray dst (ixDst + 3) v4+          PM.writeByteArray dst (ixDst + 4) v3+          PM.writeByteArray dst (ixDst + 5) v2+          PM.writeByteArray dst (ixDst + 6) v1+          PM.writeByteArray dst (ixDst + 7) v0+          go (ixSrc + 8) (ixDst + 8) (len - 8)+        else pure ()+  go offset 0 length+  PM.unsafeFreezeByteArray dst++swapArray128 :: Bytes -> ByteArray+swapArray128 (Bytes{array,offset,length}) = runByteArrayST $ do+  dst <- PM.newByteArray length+  let go !ixSrc !ixDst !len = if len > 0+        then do+          let v0 = PM.indexByteArray array ixSrc :: Word8+              v1 = PM.indexByteArray array (ixSrc + 1) :: Word8+              v2 = PM.indexByteArray array (ixSrc + 2) :: Word8+              v3 = PM.indexByteArray array (ixSrc + 3) :: Word8+              v4 = PM.indexByteArray array (ixSrc + 4) :: Word8+              v5 = PM.indexByteArray array (ixSrc + 5) :: Word8+              v6 = PM.indexByteArray array (ixSrc + 6) :: Word8+              v7 = PM.indexByteArray array (ixSrc + 7) :: Word8+              v8 = PM.indexByteArray array (ixSrc + 8) :: Word8+              v9 = PM.indexByteArray array (ixSrc + 9) :: Word8+              v10 = PM.indexByteArray array (ixSrc + 10) :: Word8+              v11 = PM.indexByteArray array (ixSrc + 11) :: Word8+              v12 = PM.indexByteArray array (ixSrc + 12) :: Word8+              v13 = PM.indexByteArray array (ixSrc + 13) :: Word8+              v14 = PM.indexByteArray array (ixSrc + 14) :: Word8+              v15 = PM.indexByteArray array (ixSrc + 15) :: Word8+          PM.writeByteArray dst ixDst v15+          PM.writeByteArray dst (ixDst + 1) v14+          PM.writeByteArray dst (ixDst + 2) v13+          PM.writeByteArray dst (ixDst + 3) v12+          PM.writeByteArray dst (ixDst + 4) v11+          PM.writeByteArray dst (ixDst + 5) v10+          PM.writeByteArray dst (ixDst + 6) v9+          PM.writeByteArray dst (ixDst + 7) v8+          PM.writeByteArray dst (ixDst + 8) v7+          PM.writeByteArray dst (ixDst + 9) v6+          PM.writeByteArray dst (ixDst + 10) v5+          PM.writeByteArray dst (ixDst + 11) v4+          PM.writeByteArray dst (ixDst + 12) v3+          PM.writeByteArray dst (ixDst + 13) v2+          PM.writeByteArray dst (ixDst + 14) v1+          PM.writeByteArray dst (ixDst + 15) v0+          go (ixSrc + 16) (ixDst + 16) (len - 16)+        else pure ()+  go offset 0 length+  PM.unsafeFreezeByteArray dst

@@ -26,6 +26,13 @@   , char2   , char3   , char4+  , char5+  , char6+  , char7+  , char8+  , char9+  , char10+  , char11     -- ** Try   , trySatisfy   , trySatisfyThen@@ -39,6 +46,7 @@   , skipChar   , skipChar1   , skipTrailedBy+  , skipUntil     -- * Numbers     -- ** Decimal     -- *** Unsigned@@ -128,7 +136,7 @@   else InternalFailure e  -- | Consume the next two characters, failing if they do--- not match they expected values.+-- not match the expected values. -- -- > char2 e a b === char e a *> char e b char2 :: e -> Char -> Char -> Parser e s ()@@ -140,8 +148,8 @@          -> InternalSuccess () (offset chunk + 2) (length chunk - 2)      | otherwise -> InternalFailure e --- | Consume the three characters, failing if they do--- not match they expected values.+-- | Consume three characters, failing if they do+-- not match the expected values. -- -- > char3 e a b c === char e a *> char e b *> char e c char3 :: e -> Char -> Char -> Char -> Parser e s ()@@ -154,8 +162,8 @@          -> InternalSuccess () (offset chunk + 3) (length chunk - 3)      | otherwise -> InternalFailure e --- | Consume the four characters, failing if they do--- not match they expected values.+-- | Consume four characters, failing if they do+-- not match the expected values. -- -- > char4 e a b c d === char e a *> char e b *> char e c *> char e d char4 :: e -> Char -> Char -> Char -> Char -> Parser e s ()@@ -169,6 +177,121 @@          -> InternalSuccess () (offset chunk + 4) (length chunk - 4)      | otherwise -> InternalFailure e +-- | Consume five characters, failing if they do+-- not match the expected values.+char5 :: e -> Char -> Char -> Char -> Char -> Char -> Parser e s ()+char5 e !c0 !c1 !c2 !c3 !c4 = uneffectful $ \chunk ->+  if | length chunk > 4+     , indexLatinCharArray (array chunk) (offset chunk) == c0+     , indexLatinCharArray (array chunk) (offset chunk + 1) == c1+     , indexLatinCharArray (array chunk) (offset chunk + 2) == c2+     , indexLatinCharArray (array chunk) (offset chunk + 3) == c3+     , indexLatinCharArray (array chunk) (offset chunk + 4) == c4+         -> InternalSuccess () (offset chunk + 5) (length chunk - 5)+     | otherwise -> InternalFailure e++-- | Consume six characters, failing if they do+-- not match the expected values.+char6 :: e -> Char -> Char -> Char -> Char -> Char -> Char -> Parser e s ()+char6 e !c0 !c1 !c2 !c3 !c4 !c5 = uneffectful $ \chunk ->+  if | length chunk > 5+     , indexLatinCharArray (array chunk) (offset chunk) == c0+     , indexLatinCharArray (array chunk) (offset chunk + 1) == c1+     , indexLatinCharArray (array chunk) (offset chunk + 2) == c2+     , indexLatinCharArray (array chunk) (offset chunk + 3) == c3+     , indexLatinCharArray (array chunk) (offset chunk + 4) == c4+     , indexLatinCharArray (array chunk) (offset chunk + 5) == c5+         -> InternalSuccess () (offset chunk + 6) (length chunk - 6)+     | otherwise -> InternalFailure e++-- | Consume seven characters, failing if they do+-- not match the expected values.+char7 :: e -> Char -> Char -> Char -> Char -> Char -> Char -> Char -> Parser e s ()+char7 e !c0 !c1 !c2 !c3 !c4 !c5 !c6 = uneffectful $ \chunk ->+  if | length chunk > 6+     , indexLatinCharArray (array chunk) (offset chunk) == c0+     , indexLatinCharArray (array chunk) (offset chunk + 1) == c1+     , indexLatinCharArray (array chunk) (offset chunk + 2) == c2+     , indexLatinCharArray (array chunk) (offset chunk + 3) == c3+     , indexLatinCharArray (array chunk) (offset chunk + 4) == c4+     , indexLatinCharArray (array chunk) (offset chunk + 5) == c5+     , indexLatinCharArray (array chunk) (offset chunk + 6) == c6+         -> InternalSuccess () (offset chunk + 7) (length chunk - 7)+     | otherwise -> InternalFailure e++-- | Consume eight characters, failing if they do+-- not match the expected values.+char8 :: e -> Char -> Char -> Char -> Char -> Char -> Char -> Char -> Char -> Parser e s ()+char8 e !c0 !c1 !c2 !c3 !c4 !c5 !c6 !c7 = uneffectful $ \chunk ->+  if | length chunk > 7+     , indexLatinCharArray (array chunk) (offset chunk) == c0+     , indexLatinCharArray (array chunk) (offset chunk + 1) == c1+     , indexLatinCharArray (array chunk) (offset chunk + 2) == c2+     , indexLatinCharArray (array chunk) (offset chunk + 3) == c3+     , indexLatinCharArray (array chunk) (offset chunk + 4) == c4+     , indexLatinCharArray (array chunk) (offset chunk + 5) == c5+     , indexLatinCharArray (array chunk) (offset chunk + 6) == c6+     , indexLatinCharArray (array chunk) (offset chunk + 7) == c7+         -> InternalSuccess () (offset chunk + 8) (length chunk - 8)+     | otherwise -> InternalFailure e++-- | Consume nine characters, failing if they do+-- not match the expected values.+char9 :: e -> Char -> Char -> Char -> Char+  -> Char -> Char -> Char -> Char -> Char -> Parser e s ()+char9 e !c0 !c1 !c2 !c3 !c4 !c5 !c6 !c7 !c8 = uneffectful $ \chunk ->+  if | length chunk > 8+     , indexLatinCharArray (array chunk) (offset chunk) == c0+     , indexLatinCharArray (array chunk) (offset chunk + 1) == c1+     , indexLatinCharArray (array chunk) (offset chunk + 2) == c2+     , indexLatinCharArray (array chunk) (offset chunk + 3) == c3+     , indexLatinCharArray (array chunk) (offset chunk + 4) == c4+     , indexLatinCharArray (array chunk) (offset chunk + 5) == c5+     , indexLatinCharArray (array chunk) (offset chunk + 6) == c6+     , indexLatinCharArray (array chunk) (offset chunk + 7) == c7+     , indexLatinCharArray (array chunk) (offset chunk + 8) == c8+         -> InternalSuccess () (offset chunk + 9) (length chunk - 9)+     | otherwise -> InternalFailure e++-- | Consume ten characters, failing if they do+-- not match the expected values.+char10 :: e -> Char -> Char -> Char -> Char -> Char+  -> Char -> Char -> Char -> Char -> Char -> Parser e s ()+char10 e !c0 !c1 !c2 !c3 !c4 !c5 !c6 !c7 !c8 !c9 = uneffectful $ \chunk ->+  if | length chunk > 9+     , indexLatinCharArray (array chunk) (offset chunk) == c0+     , indexLatinCharArray (array chunk) (offset chunk + 1) == c1+     , indexLatinCharArray (array chunk) (offset chunk + 2) == c2+     , indexLatinCharArray (array chunk) (offset chunk + 3) == c3+     , indexLatinCharArray (array chunk) (offset chunk + 4) == c4+     , indexLatinCharArray (array chunk) (offset chunk + 5) == c5+     , indexLatinCharArray (array chunk) (offset chunk + 6) == c6+     , indexLatinCharArray (array chunk) (offset chunk + 7) == c7+     , indexLatinCharArray (array chunk) (offset chunk + 8) == c8+     , indexLatinCharArray (array chunk) (offset chunk + 9) == c9+         -> InternalSuccess () (offset chunk + 10) (length chunk - 10)+     | otherwise -> InternalFailure e++-- | Consume ten characters, failing if they do+-- not match the expected values.+char11 :: e -> Char -> Char -> Char -> Char -> Char -> Char+  -> Char -> Char -> Char -> Char -> Char -> Parser e s ()+char11 e !c0 !c1 !c2 !c3 !c4 !c5 !c6 !c7 !c8 !c9 !c10 = uneffectful $ \chunk ->+  if | length chunk > 10+     , indexLatinCharArray (array chunk) (offset chunk) == c0+     , indexLatinCharArray (array chunk) (offset chunk + 1) == c1+     , indexLatinCharArray (array chunk) (offset chunk + 2) == c2+     , indexLatinCharArray (array chunk) (offset chunk + 3) == c3+     , indexLatinCharArray (array chunk) (offset chunk + 4) == c4+     , indexLatinCharArray (array chunk) (offset chunk + 5) == c5+     , indexLatinCharArray (array chunk) (offset chunk + 6) == c6+     , indexLatinCharArray (array chunk) (offset chunk + 7) == c7+     , indexLatinCharArray (array chunk) (offset chunk + 8) == c8+     , indexLatinCharArray (array chunk) (offset chunk + 9) == c9+     , indexLatinCharArray (array chunk) (offset chunk + 10) == c10+         -> InternalSuccess () (offset chunk + 11) (length chunk - 11)+     | otherwise -> InternalFailure e+ -- | Consumes and returns the next character in the input. any :: e -> Parser e s Char any e = uneffectful $ \chunk -> if length chunk > 0@@ -672,26 +795,51 @@ char2Word :: Char -> Word char2Word = fromIntegral . ord --- | Skip all characters until the character from the is encountered+-- | Skip all characters until the terminator is encountered -- and then consume the matching character as well. Visually, -- @skipTrailedBy \'C\'@ advances the cursor like this: --  -- >  A Z B Y C X C W -- > |->->->->-|+--+-- This fails if it reaches the end of input without encountering+-- the character. skipTrailedBy :: e -> Char -> Parser e s () skipTrailedBy e !w = uneffectful# $ \c ->   skipUntilConsumeLoop e w c +-- | Skip all characters until the terminator is encountered.+-- This does not consume the terminator. Visually, @skipUntil \'C\'@+-- advances the cursor like this:+-- +-- >  A Z B Y C X C W+-- > |->->->-|+--+-- This succeeds if it reaches the end of the input without+-- encountering the terminator. It never fails.+skipUntil :: Char -> Parser e s ()+skipUntil !w = uneffectful# $ \c -> skipUntilLoop w c++skipUntilLoop ::+     Char -- byte to match+  -> Bytes -- Chunk+  -> Result# e ()+skipUntilLoop !w !c = case length c of+  0 -> (# | (# (), unI (offset c), 0# #) #)+  _ -> if indexLatinCharArray (array c) (offset c) /= w+    then skipUntilLoop w (Bytes.unsafeDrop 1 c)+    else (# | (# (), unI (offset c), unI (length c) #) #)+ skipUntilConsumeLoop ::      e -- Error message   -> Char -- byte to match   -> Bytes -- Chunk   -> Result# e ()-skipUntilConsumeLoop e !w !c = if length c > 0-  then if indexLatinCharArray (array c) (offset c) /= w+skipUntilConsumeLoop e !w !c = case length c of+  0 -> (# e | #)+  _ -> if indexLatinCharArray (array c) (offset c) /= w     then skipUntilConsumeLoop e w (Bytes.unsafeDrop 1 c)     else (# | (# (), unI (offset c + 1), unI (length c - 1) #) #)-  else (# e | #)  -- | Parse exactly four ASCII-encoded characters, interpretting -- them as the hexadecimal encoding of a 32-bit number. Note that

@@ -0,0 +1,211 @@+{-# language BangPatterns #-}+{-# language BinaryLiterals #-}+{-# language DataKinds #-}+{-# language DeriveFunctor #-}+{-# language DerivingStrategies #-}+{-# language GADTSyntax #-}+{-# language KindSignatures #-}+{-# language LambdaCase #-}+{-# language MagicHash #-}+{-# language MultiWayIf #-}+{-# language PolyKinds #-}+{-# language RankNTypes #-}+{-# language ScopedTypeVariables #-}+{-# language StandaloneDeriving #-}+{-# language TypeApplications #-}+{-# language UnboxedSums #-}+{-# language UnboxedTuples #-}++-- | Little-endian fixed-width numbers.+module Data.Bytes.Parser.LittleEndian+  ( -- * One+    -- ** Unsigned+    word8+  , word16+  , word32+  , word64+  , word128+    -- ** Signed+  , int8+  , int16+  , int32+  , int64+    -- * Many+    -- ** Unsigned+  , word16Array+  , word32Array+  , word64Array+  , word128Array+    -- ** Unsigned+  , int64Array+  ) where++import Prelude hiding (length,any,fail,takeWhile)++import Control.Applicative (liftA2)+import Data.Bits ((.|.),unsafeShiftL)+import Data.Primitive (ByteArray(..),PrimArray(..))+import Data.Bytes.Types (Bytes(..))+import Data.Bytes.Parser.Internal (Parser,uneffectful)+import Data.Bytes.Parser.Internal (InternalResult(..))+import Data.Bytes.Parser.Internal (swapArray16,swapArray32)+import Data.Bytes.Parser.Internal (swapArray64,swapArray128)+import Data.Word (Word8,Word16,Word32,Word64)+import Data.Int (Int8,Int16,Int32,Int64)+import Data.WideWord (Word128(Word128))+import GHC.ByteOrder (ByteOrder(LittleEndian,BigEndian),targetByteOrder)++import qualified Data.Bytes as Bytes+import qualified Data.Bytes.Parser as P+import qualified Data.Primitive as PM++-- | Unsigned 8-bit word.+word8 :: e -> Parser e s Word8+word8 = P.any++-- | Array of little-endian unsigned 16-bit words. If the host is+-- little-endian, the implementation is optimized to simply @memcpy@+-- bytes into the result array. The result array always has elements+-- in native-endian byte order.+word16Array ::+     e -- ^ Error message if not enough bytes are present+  -> Int -- ^ Number of little-endian 16-bit words to expect+  -> Parser e s (PrimArray Word16) -- ^ Native-endian elements+word16Array e !n = case targetByteOrder of+  LittleEndian -> fmap (asWord16s . Bytes.toByteArrayClone) (P.take e (n * 2))+  BigEndian -> do+    bs <- P.take e (n * 2)+    let r = swapArray16 bs+    pure (asWord16s r)++-- | Parse an array of little-endian unsigned 32-bit words.+word32Array ::+     e -- ^ Error message if not enough bytes are present+  -> Int -- ^ Number of little-endian 32-bit words to consume+  -> Parser e s (PrimArray Word32) -- ^ Native-endian elements+word32Array e !n = case targetByteOrder of+  LittleEndian -> fmap (asWord32s . Bytes.toByteArrayClone) (P.take e (n * 4))+  BigEndian -> do+    bs <- P.take e (n * 4)+    let r = swapArray32 bs+    pure (asWord32s r)++-- | Parse an array of little-endian unsigned 64-bit words.+word64Array ::+     e -- ^ Error message if not enough bytes are present+  -> Int -- ^ Number of little-endian 64-bit words to consume+  -> Parser e s (PrimArray Word64) -- ^ Native-endian elements+word64Array e !n = case targetByteOrder of+  LittleEndian -> fmap (asWord64s . Bytes.toByteArrayClone) (P.take e (n * 8))+  BigEndian -> do+    bs <- P.take e (n * 8)+    let r = swapArray64 bs+    pure (asWord64s r)++-- | Parse an array of little-endian unsigned 128-bit words.+word128Array ::+     e -- ^ Error message if not enough bytes are present+  -> Int -- ^ Number of little-endian 128-bit words to consume+  -> Parser e s (PrimArray Word128) -- ^ Native-endian elements+word128Array e !n = case targetByteOrder of+  LittleEndian -> fmap (asWord128s . Bytes.toByteArrayClone) (P.take e (n * 16))+  BigEndian -> do+    bs <- P.take e (n * 16)+    let r = swapArray128 bs+    pure (asWord128s r)++-- | Parse an array of little-endian signed 64-bit words.+int64Array ::+     e -- ^ Error message if not enough bytes are present+  -> Int -- ^ Number of little-endian 64-bit words to expect+  -> Parser e s (PrimArray Int64) -- ^ Native-endian elements+int64Array e !n = do+  PrimArray x <- word64Array e n+  pure (PrimArray x)++asWord16s :: ByteArray -> PrimArray Word16+asWord16s (ByteArray x) = PrimArray x++asWord32s :: ByteArray -> PrimArray Word32+asWord32s (ByteArray x) = PrimArray x++asWord64s :: ByteArray -> PrimArray Word64+asWord64s (ByteArray x) = PrimArray x++asWord128s :: ByteArray -> PrimArray Word128+asWord128s (ByteArray x) = PrimArray x++-- | Unsigned 16-bit word.+word16 :: e -> Parser e s Word16+word16 e = uneffectful $ \chunk -> if length chunk >= 2+  then+    let wa = PM.indexByteArray (array chunk) (offset chunk) :: Word8+        wb = PM.indexByteArray (array chunk) (offset chunk + 1) :: Word8+     in InternalSuccess+          (fromIntegral @Word @Word16 (unsafeShiftL (fromIntegral wb) 8 .|. fromIntegral wa))+          (offset chunk + 2) (length chunk - 2)+  else InternalFailure e++-- | Unsigned 32-bit word.+word32 :: e -> Parser e s Word32+word32 e = uneffectful $ \chunk -> if length chunk >= 4+  then+    let wa = PM.indexByteArray (array chunk) (offset chunk) :: Word8+        wb = PM.indexByteArray (array chunk) (offset chunk + 1) :: Word8+        wc = PM.indexByteArray (array chunk) (offset chunk + 2) :: Word8+        wd = PM.indexByteArray (array chunk) (offset chunk + 3) :: Word8+     in InternalSuccess+          (fromIntegral @Word @Word32+            ( unsafeShiftL (fromIntegral wd) 24 .|.+              unsafeShiftL (fromIntegral wc) 16 .|.+              unsafeShiftL (fromIntegral wb) 8 .|.+              fromIntegral wa+            )+          )+          (offset chunk + 4) (length chunk - 4)+  else InternalFailure e++-- | Unsigned 64-bit word.+word64 :: e -> Parser e s Word64+word64 e = uneffectful $ \chunk -> if length chunk >= 8+  then+    let wa = PM.indexByteArray (array chunk) (offset chunk) :: Word8+        wb = PM.indexByteArray (array chunk) (offset chunk + 1) :: Word8+        wc = PM.indexByteArray (array chunk) (offset chunk + 2) :: Word8+        wd = PM.indexByteArray (array chunk) (offset chunk + 3) :: Word8+        we = PM.indexByteArray (array chunk) (offset chunk + 4) :: Word8+        wf = PM.indexByteArray (array chunk) (offset chunk + 5) :: Word8+        wg = PM.indexByteArray (array chunk) (offset chunk + 6) :: Word8+        wh = PM.indexByteArray (array chunk) (offset chunk + 7) :: Word8+     in InternalSuccess+          ( unsafeShiftL (fromIntegral wh) 56 .|.+            unsafeShiftL (fromIntegral wg) 48 .|.+            unsafeShiftL (fromIntegral wf) 40 .|.+            unsafeShiftL (fromIntegral we) 32 .|.+            unsafeShiftL (fromIntegral wd) 24 .|.+            unsafeShiftL (fromIntegral wc) 16 .|.+            unsafeShiftL (fromIntegral wb) 8 .|.+            fromIntegral wa+          )+          (offset chunk + 8) (length chunk - 8)+  else InternalFailure e++-- | Unsigned 128-bit word.+word128 :: e -> Parser e s Word128+word128 e = liftA2 (flip Word128) (word64 e) (word64 e)++-- | Signed 8-bit integer.+int8 :: e -> Parser e s Int8+int8 = fmap fromIntegral . word8++-- | Signed 16-bit integer.+int16 :: e -> Parser e s Int16+int16 = fmap fromIntegral . word16++-- | Signed 32-bit integer.+int32 :: e -> Parser e s Int32+int32 = fmap fromIntegral . word32++-- | Signed 64-bit integer.+int64 :: e -> Parser e s Int64+int64 = fmap fromIntegral . word64

@@ -1,17 +1,25 @@ {-# language BangPatterns #-}+{-# language DataKinds #-} {-# language MultiWayIf #-} {-# language NumDecimals #-} {-# language OverloadedStrings #-} {-# language ScopedTypeVariables #-} {-# language TypeApplications #-} +{-# OPTIONS_GHC -fno-warn-orphans #-}++import Control.Applicative (liftA2) import Control.Monad (replicateM) import Control.Monad.ST (runST)-import Data.Primitive (ByteArray,PrimArray)-import Data.Word (Word8,Word64)-import Data.Char (ord)-import Data.Bytes.Types (Bytes(Bytes)) import Data.Bytes.Parser (Slice(Slice))+import Data.Bytes.Types (Bytes(Bytes))+import Data.Char (ord)+import Data.Coerce (coerce)+import Data.Primitive (ByteArray(..),PrimArray(..))+import Data.Text.Short (ShortText)+import Data.WideWord (Word128(Word128))+import Data.Word (Word8,Word64,Word16,Word32)+import System.ByteOrder (Fixed(..),ByteOrder(BigEndian,LittleEndian)) import Test.Tasty (defaultMain,testGroup,TestTree) import Test.Tasty.HUnit ((@=?),testCase) import Test.Tasty.QuickCheck ((===),testProperty)@@ -21,6 +29,7 @@ import qualified Data.Bytes.Parser.Ascii as Ascii import qualified Data.Bytes.Parser.Latin as Latin import qualified Data.Bytes.Parser.BigEndian as BigEndian+import qualified Data.Bytes.Parser.LittleEndian as LittleEndian import qualified Data.Primitive as PM import qualified GHC.Exts as Exts import qualified Test.Tasty.QuickCheck as QC@@ -35,7 +44,70 @@         P.parseBytes (Latin.decStandardInt ()) str         ===         P.Success (Slice len 0 i)+  , testProperty "big-endian-word16-array" $ \(xs :: [Word16]) ->+      let src = Exts.fromList (coerce xs :: [Fixed 'BigEndian Word16])+          res = Exts.fromList xs :: PrimArray Word16+          sz = length xs * 2+          bs = Bytes (Exts.fromList [0x42 :: Word8] <> untype src) 1 sz+       in+      P.Success (Slice (sz + 1) 0 res)+      ===+      P.parseBytes (BigEndian.word16Array () (length xs)) bs+  , testProperty "big-endian-word32-array" $ \(xs :: [Word32]) ->+      let src = Exts.fromList (coerce xs :: [Fixed 'BigEndian Word32])+          res = Exts.fromList xs :: PrimArray Word32+          sz = length xs * 4+          bs = Bytes (Exts.fromList [0x42 :: Word8] <> untype src) 1 sz+       in+      P.Success (Slice (sz + 1) 0 res)+      ===+      P.parseBytes (BigEndian.word32Array () (length xs)) bs+  , testProperty "little-endian-word32-array" $ \(xs :: [Word32]) ->+      let src = Exts.fromList (coerce xs :: [Fixed 'LittleEndian Word32])+          res = Exts.fromList xs :: PrimArray Word32+          sz = length xs * 4+          bs = Bytes (Exts.fromList [0x42 :: Word8] <> untype src) 1 sz+       in+      P.Success (Slice (sz + 1) 0 res)+      ===+      P.parseBytes (LittleEndian.word32Array () (length xs)) bs+  , testProperty "big-endian-word64-array" $ \(xs :: [Word64]) ->+      let src = Exts.fromList (coerce xs :: [Fixed 'BigEndian Word64])+          res = Exts.fromList xs :: PrimArray Word64+          sz = length xs * 8+          bs = Bytes (Exts.fromList [0x42 :: Word8] <> untype src) 1 sz+       in+      P.Success (Slice (sz + 1) 0 res)+      ===+      P.parseBytes (BigEndian.word64Array () (length xs)) bs+  , testProperty "little-endian-word64-array" $ \(xs :: [Word64]) ->+      let src = Exts.fromList (coerce xs :: [Fixed 'LittleEndian Word64])+          res = Exts.fromList xs :: PrimArray Word64+          sz = length xs * 8+          bs = Bytes (Exts.fromList [0x42 :: Word8] <> untype src) 1 sz+       in+      P.Success (Slice (sz + 1) 0 res)+      ===+      P.parseBytes (LittleEndian.word64Array () (length xs)) bs+  , testProperty "little-endian-word128-array" $ \(xs :: [Word128]) ->+      let src = Exts.fromList xs+          sz = length xs * 16+          bs = Bytes (Exts.fromList [0x42 :: Word8] <> untype src) 1 sz+       in+      P.parseBytes (replicateM (length xs) (LittleEndian.word128 ())) bs+      ===+      P.parseBytes (fmap Exts.toList (LittleEndian.word128Array () (length xs))) bs+  , testProperty "big-endian-word128-array" $ \(xs :: [Word128]) ->+      let src = Exts.fromList xs+          sz = length xs * 16+          bs = Bytes (Exts.fromList [0x42 :: Word8] <> untype src) 1 sz+       in+      P.parseBytes (replicateM (length xs) (BigEndian.word128 ())) bs+      ===+      P.parseBytes (fmap Exts.toList (BigEndian.word128Array () (length xs))) bs   , testProperty "big-endian-word64" bigEndianWord64+  , testProperty "big-endian-word32" bigEndianWord32+  , testProperty "little-endian-word32" littleEndianWord32   , testCase "delimit" $       P.Success (Slice 13 0 (167,14625))       @=?@@ -231,6 +303,12 @@       P.parseBytes         (P.replicate 2 (Ascii.decWord () <* Ascii.char () '.'))         (bytes "42.93.")+  , testCase "ascii-takeShortWhile" $+      P.Success (Slice 11 0 (Exts.fromList ["the","world"] :: PM.Array ShortText))+      @=?+      P.parseBytes+        (P.replicate 2 (Ascii.takeShortWhile (/=',') <* Ascii.char () ','))+        (bytes "the,world,")   ]  bytes :: String -> Bytes@@ -271,11 +349,60 @@       ===       P.Success (Slice 10 1 expected) +bigEndianWord32 ::+     Word8 -> Word8 -> Word8 -> Word8+  -> QC.Property+bigEndianWord32 a b c d =+  let arr = runST $ do+        m <- PM.newByteArray 7+        PM.writeByteArray m 0 (0xFF :: Word8)+        PM.writeByteArray m 1 (0xFF :: Word8)+        PM.writeByteArray m 2 (a :: Word8)+        PM.writeByteArray m 3 (b :: Word8)+        PM.writeByteArray m 4 (c :: Word8)+        PM.writeByteArray m 5 (d :: Word8)+        PM.writeByteArray m 6 (0xEE :: Word8)+        PM.unsafeFreezeByteArray m+      expected = (0 :: Word32)+        + fromIntegral a * 256 ^ (3 :: Integer)+        + fromIntegral b * 256 ^ (2 :: Integer)+        + fromIntegral c * 256 ^ (1 :: Integer)+        + fromIntegral d * 256 ^ (0 :: Integer)+   in P.parseBytes (BigEndian.word32 ()) (Bytes arr 2 5)+      ===+      P.Success (Slice 6 1 expected)++littleEndianWord32 ::+     Word8 -> Word8 -> Word8 -> Word8+  -> QC.Property+littleEndianWord32 a b c d =+  let arr = runST $ do+        m <- PM.newByteArray 7+        PM.writeByteArray m 0 (0xFF :: Word8)+        PM.writeByteArray m 1 (0xFF :: Word8)+        PM.writeByteArray m 2 (a :: Word8)+        PM.writeByteArray m 3 (b :: Word8)+        PM.writeByteArray m 4 (c :: Word8)+        PM.writeByteArray m 5 (d :: Word8)+        PM.writeByteArray m 6 (0xEE :: Word8)+        PM.unsafeFreezeByteArray m+      expected = (0 :: Word32)+        + fromIntegral a * 256 ^ (0 :: Integer)+        + fromIntegral b * 256 ^ (1 :: Integer)+        + fromIntegral c * 256 ^ (2 :: Integer)+        + fromIntegral d * 256 ^ (3 :: Integer)+   in P.parseBytes (LittleEndian.word32 ()) (Bytes arr 2 5)+      ===+      P.Success (Slice 6 1 expected)+ -- The Arbitrary instance for Integer that comes with -- QuickCheck only generates small numbers. newtype LargeInteger = LargeInteger Integer   deriving (Eq,Show) +instance QC.Arbitrary Word128 where+  arbitrary = liftA2 Word128 QC.arbitrary QC.arbitrary+ instance QC.Arbitrary LargeInteger where   arbitrary = do       n <- QC.choose (1, 27)@@ -291,3 +418,8 @@ -- starts at that offset. withSz :: String -> (Bytes -> Int -> a) -> a withSz str f = f (bytes str) (length str + 1)++untype :: PrimArray a -> ByteArray+untype (PrimArray x) = ByteArray x++