packages feed

bytesmith 0.3.6.0 → 0.3.7.0

raw patch · 9 files changed

+451/−6 lines, 9 filesdep ~contiguousPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: contiguous

API changes (from Hackage documentation)

+ Data.Bytes.Parser.Ascii: charInsensitive :: e -> Char -> Parser e s ()
+ Data.Bytes.Parser.Base128: word16 :: e -> Parser e s Word16
+ Data.Bytes.Parser.Base128: word32 :: e -> Parser e s Word32
+ Data.Bytes.Parser.Base128: word64 :: e -> Parser e s Word64
+ Data.Bytes.Parser.Latin: endOfInput :: e -> Parser e s ()
+ Data.Bytes.Parser.Latin: isEndOfInput :: Parser e s Bool
+ Data.Bytes.Parser.Latin: skipWhile :: (Char -> Bool) -> Parser e s ()
+ Data.Bytes.Parser.Leb128: int16 :: e -> Parser e s Int16
+ Data.Bytes.Parser.Leb128: int32 :: e -> Parser e s Int32
+ Data.Bytes.Parser.Leb128: int64 :: e -> Parser e s Int64
+ Data.Bytes.Parser.Leb128: word16 :: e -> Parser e s Word16
+ Data.Bytes.Parser.Leb128: word32 :: e -> Parser e s Word32
+ Data.Bytes.Parser.Leb128: word64 :: e -> Parser e s Word64
+ Data.Bytes.Parser.Rebindable: instance Data.Bytes.Parser.Rebindable.Bind 'GHC.Types.IntRep ('GHC.Types.TupleRep '[ 'GHC.Types.IntRep, 'GHC.Types.IntRep, 'GHC.Types.IntRep, 'GHC.Types.IntRep, 'GHC.Types.IntRep])
+ Data.Bytes.Parser.Rebindable: instance Data.Bytes.Parser.Rebindable.Bind 'GHC.Types.LiftedRep ('GHC.Types.TupleRep '[ 'GHC.Types.IntRep, 'GHC.Types.IntRep, 'GHC.Types.IntRep, 'GHC.Types.IntRep, 'GHC.Types.IntRep])
+ Data.Bytes.Parser.Rebindable: instance Data.Bytes.Parser.Rebindable.Bind ('GHC.Types.TupleRep '[ 'GHC.Types.IntRep, 'GHC.Types.IntRep, 'GHC.Types.IntRep, 'GHC.Types.IntRep, 'GHC.Types.IntRep]) 'GHC.Types.LiftedRep
+ Data.Bytes.Parser.Rebindable: instance Data.Bytes.Parser.Rebindable.Bind ('GHC.Types.TupleRep '[ 'GHC.Types.IntRep, 'GHC.Types.IntRep]) ('GHC.Types.TupleRep '[ 'GHC.Types.IntRep, 'GHC.Types.IntRep, 'GHC.Types.IntRep, 'GHC.Types.IntRep, 'GHC.Types.IntRep])
+ Data.Bytes.Parser.Rebindable: instance Data.Bytes.Parser.Rebindable.Pure ('GHC.Types.TupleRep '[ 'GHC.Types.IntRep, 'GHC.Types.IntRep, 'GHC.Types.IntRep, 'GHC.Types.IntRep, 'GHC.Types.IntRep])

Files

CHANGELOG.md view
@@ -1,5 +1,15 @@ # Revision history for bytesmith +## 0.3.7.0 -- 2020-07-27++* Add `Data.Bytes.Parser.Base128` module for Base-128 encoding.+* Add `Data.Bytes.Parser.Leb128` module for LEB-128 encoding.+  Supports signed integers with zig-zag encoding.+* Add `skipWhile` to `Data.Bytes.Parser.Latin`.+* Reexport `endOfInput` and `isEndOfInput` from `Latin`.+* Add `charInsensitive` to ASCII module.+* Correct implementation of `peek` and `peek'`.+ ## 0.3.6.0 -- 2020-03-04  * Add `char12`
bytesmith.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 name: bytesmith-version: 0.3.6.0+version: 0.3.7.0 synopsis: Nonresumable byte parser description:   Parse bytes as fast as possible. This is a nonresumable parser@@ -22,7 +22,9 @@     Data.Bytes.Parser.BigEndian     Data.Bytes.Parser.LittleEndian     Data.Bytes.Parser.Ascii+    Data.Bytes.Parser.Base128     Data.Bytes.Parser.Latin+    Data.Bytes.Parser.Leb128     Data.Bytes.Parser.Rebindable     Data.Bytes.Parser.Unsafe     Data.Bytes.Parser.Utf8
src/Data/Bytes/Parser.hs view
@@ -248,7 +248,7 @@ peek :: Parser e s (Maybe Word8) peek = uneffectful $ \chunk ->   let v = if length chunk > 0-        then Just (B.unsafeIndex chunk 1)+        then Just (B.unsafeIndex chunk 0)         else Nothing   in InternalSuccess v (offset chunk) (length chunk) @@ -256,7 +256,7 @@ --   input, but will fail if end of input has been reached. peek' :: e -> Parser e s Word8 peek' e = uneffectful $ \chunk -> if length chunk > 0-  then InternalSuccess (B.unsafeIndex chunk 1) (offset chunk) (length chunk)+  then InternalSuccess (B.unsafeIndex chunk 0) (offset chunk) (length chunk)   else InternalFailure e  -- | A stateful scanner. The predicate consumes and transforms a
src/Data/Bytes/Parser/Ascii.hs view
@@ -26,6 +26,8 @@   , Latin.char2   , Latin.char3   , Latin.char4+    -- * Case-Insensitive Matching+  , charInsensitive     -- * Get Character   , any   , any#@@ -52,9 +54,11 @@  import Prelude hiding (length,any,fail,takeWhile) +import Data.Bits (clearBit) import Data.Bytes.Types (Bytes(..)) import Data.Bytes.Parser.Internal (Parser(..),uneffectful,Result#,uneffectful#) import Data.Bytes.Parser.Internal (InternalResult(..),indexLatinCharArray,upcastUnitSuccess)+import Data.Char (ord) import Data.Word (Word8) import Data.Text.Short (ShortText) import Control.Monad.ST.Run (runByteArrayST)@@ -67,6 +71,21 @@ import qualified Data.Bytes.Parser.Latin as Latin import qualified Data.Bytes.Parser.Unsafe as Unsafe import qualified Data.Primitive as PM++-- | Consume the next character, failing if it does not match the expected+-- value or if there is no more input. This check for equality is case+-- insensitive.+--+-- Precondition: The argument must be a letter (@[a-zA-Z]@). Behavior is+-- undefined if it is not.+charInsensitive :: e -> Char -> Parser e s ()+charInsensitive e !c = uneffectful $ \chunk -> if length chunk > 0+  then if clearBit (PM.indexByteArray (array chunk) (offset chunk) :: Word8) 5 == w+    then InternalSuccess () (offset chunk + 1) (length chunk - 1)+    else InternalFailure e+  else InternalFailure e+  where+  w = clearBit (fromIntegral @Int @Word8 (ord c)) 5  -- | Consume input until the trailer is found. Then, consume -- the trailer as well. This fails if the trailer is not
+ src/Data/Bytes/Parser/Base128.hs view
@@ -0,0 +1,35 @@+{-# language BangPatterns #-}+{-# language TypeApplications #-}++module Data.Bytes.Parser.Base128+  ( -- * Unsigned+    word16+  , word32+  , word64+  ) where++import Control.Monad (when)+import Data.Bits (testBit,unsafeShiftL,(.|.),bit,clearBit)+import Data.Bytes.Parser (Parser)+import Data.Word (Word8,Word16,Word32,Word64)++import qualified Data.Bytes.Parser as P++word16 :: e -> Parser e s Word16+word16 e = fromIntegral @Word64 @Word16 <$> stepBoundedWord e 16 0++word32 :: e -> Parser e s Word32+word32 e = fromIntegral @Word64 @Word32 <$> stepBoundedWord e 32 0++word64 :: e -> Parser e s Word64+word64 e = fromIntegral @Word64 @Word64 <$> stepBoundedWord e 64 0++stepBoundedWord :: e -> Int -> Word64 -> Parser e s Word64+stepBoundedWord e !bitLimit !acc = do+  when (acc >= bit (bitLimit - 7)) $ P.fail e+  raw <- P.any e+  let content = clearBit raw 7+      acc' = unsafeShiftL acc 7 .|. fromIntegral @Word8 @Word64 content+  if testBit raw 7+    then stepBoundedWord e bitLimit acc'+    else pure acc'
src/Data/Bytes/Parser/Latin.hs view
@@ -50,6 +50,10 @@   , skipChar1   , skipTrailedBy   , skipUntil+  , skipWhile+    -- * End of Input+  , endOfInput+  , isEndOfInput     -- * Numbers     -- ** Decimal     -- *** Unsigned@@ -92,8 +96,8 @@ import Data.Bytes.Parser.Internal (Parser(..),ST#,uneffectful,Result#,uneffectful#) import Data.Bytes.Parser.Internal (InternalResult(..),indexLatinCharArray,upcastUnitSuccess) import Data.Bytes.Parser.Internal (boxBytes)-import Data.Bytes.Parser (bindFromLiftedToInt)-import Data.Bytes.Parser.Unsafe (expose,cursor)+import Data.Bytes.Parser (bindFromLiftedToInt,isEndOfInput,endOfInput)+import Data.Bytes.Parser.Unsafe (expose,cursor,unconsume) import Data.Word (Word8) import Data.Char (ord) import Data.Kind (Type)@@ -1160,3 +1164,28 @@       !cb = int2Word# (ltWord# r1 r0)       !c = ca `or#` cb    in (case c of { 0## -> False; _ -> True }, W# r1)++-- | Skip while the predicate is matched. This is always inlined.+skipWhile :: (Char -> Bool) -> Parser e s ()+{-# inline skipWhile #-}+skipWhile f = go where+  go = isEndOfInput >>= \case+    True -> pure ()+    False -> do+      w <- anyUnsafe+      if f w+        then go+        else unconsume 1++-- Interpret the next byte as an Latin1-encoded character.+-- Does not check to see if any characters are left. This+-- is not exported.+anyUnsafe :: Parser e s Char+{-# inline anyUnsafe #-}+anyUnsafe = uneffectful $ \chunk ->+  let w = indexCharArray (array chunk) (offset chunk) :: Char+   in InternalSuccess w (offset chunk + 1) (length chunk - 1)++-- Reads one byte and interprets it as Latin1-encoded character.+indexCharArray :: PM.ByteArray -> Int -> Char+indexCharArray (PM.ByteArray x) (I# i) = C# (indexCharArray# x i)
+ src/Data/Bytes/Parser/Leb128.hs view
@@ -0,0 +1,103 @@+{-# language BangPatterns #-}+{-# language BinaryLiterals #-}+{-# language TypeApplications #-}++-- | Parse numbers that have been encoded with <https://en.wikipedia.org/wiki/LEB128 LEB-128>.+-- LEB-128 allows arbitrarily large numbers to be encoded. Parsers in this+-- module will fail if the number they attempt to parse is outside the+-- range of what their target type can handle. The parsers for signed+-- numbers assume that the numbers have been+-- <https://developers.google.com/protocol-buffers/docs/encoding zigzig encoded>.+module Data.Bytes.Parser.Leb128+  ( -- * Unsigned+    word16+  , word32+  , word64+    -- * Signed (Zig-zag)+  , int16+  , int32+  , int64+  ) where++import Data.Bits (testBit,(.&.),unsafeShiftR,xor,complement)+import Data.Bits (unsafeShiftL,(.|.))+import Data.Bytes.Parser (Parser)+import Data.Int (Int16,Int32,Int64)+import Data.Word (Word8,Word16,Word32,Word64)++import qualified Data.Bytes.Parser as P++-- | Parse a LEB-128-encoded number. If the number is larger+-- than @0xFFFF@, fails with the provided error.+word16 :: e -> Parser e s Word16+word16 e = do+  w <- stepBoundedWord e 16 0 0+  pure (fromIntegral @Word64 @Word16 w)++-- | Parse a LEB-128-encoded number. If the number is larger+-- than @0xFFFFFFFF@, fails with the provided error.+word32 :: e -> Parser e s Word32+word32 e = do+  w <- stepBoundedWord e 32 0 0+  pure (fromIntegral @Word64 @Word32 w)++-- | Parse a LEB-128-encoded number. If the number is larger+-- than @0xFFFFFFFFFFFFFFFF@, fails with the provided error.+word64 :: e -> Parser e s Word64+word64 e = stepBoundedWord e 64 0 0++-- | Parse a LEB-128-zigzag-encoded signed number. If the encoded+-- number is outside the range @[-32768,32767]@, this fails with+-- the provided error.+int16 :: e -> Parser e s Int16+int16 = fmap zigzagDecode16 . word16++-- | Parse a LEB-128-zigzag-encoded signed number. If the encoded+-- number is outside the range @[-2147483648,2147483647]@, this+-- fails with the provided error.+int32 :: e -> Parser e s Int32+int32 = fmap zigzagDecode32 . word32++-- | Parse a LEB-128-zigzag-encoded signed number. If the encoded+-- number is outside the range @[-9223372036854775808,9223372036854775807]@,+-- this fails with the provided error.+int64 :: e -> Parser e s Int64+int64 = fmap zigzagDecode64 . word64++-- What these parameters are:+--+-- bitLimit: number of bits in the target word size+-- accShift: shift amount, increases by 7 at a time+stepBoundedWord :: e -> Int -> Word64 -> Int -> Parser e s Word64+stepBoundedWord e !bitLimit !acc0 !accShift = do+  raw <- P.any e+  let number = raw .&. 0x7F+      acc1 = acc0 .|.+        unsafeShiftL (fromIntegral @Word8 @Word64 number) accShift+      accShift' = accShift + 7+  if accShift' <= bitLimit+    then if testBit raw 7+      then stepBoundedWord e bitLimit acc1 accShift'+      else pure acc1+    else if fromIntegral @Word8 @Word raw < twoExp (bitLimit - accShift)+      then pure acc1 -- TODO: no need to mask upper bit in number+      else P.fail e++twoExp :: Int -> Word+twoExp x = unsafeShiftL 1 x++-- Zigzag decode strategy taken from https://stackoverflow.com/a/2211086/1405768+-- The accepted answer is a little bit, so an answer further down was used:+--+-- > zigzag_decode(value) = ( value >> 1 ) ^ ( ~( value & 1 ) + 1 )+zigzagDecode16 :: Word16 -> Int16+zigzagDecode16 n =+  fromIntegral ((unsafeShiftR n 1) `xor` (complement (n .&. 1) + 1))++zigzagDecode32 :: Word32 -> Int32+zigzagDecode32 n =+  fromIntegral ((unsafeShiftR n 1) `xor` (complement (n .&. 1) + 1))++zigzagDecode64 :: Word64 -> Int64+zigzagDecode64 n =+  fromIntegral ((unsafeShiftR n 1) `xor` (complement (n .&. 1) + 1))
src/Data/Bytes/Parser/Rebindable.hs view
@@ -102,6 +102,33 @@         runParser (g y) (# arr, b, c #) s1   ) +pureInt5Parser :: forall (a :: TYPE ('TupleRep '[ 'IntRep, 'IntRep, 'IntRep, 'IntRep, 'IntRep])) e s.+  a -> Parser e s a+{-# inline pureInt5Parser #-}+pureInt5Parser a = Parser+  (\(# _, b, c #) s -> (# s, (# | (# a, b, c #) #) #))++bindInt5Parser :: forall (a :: TYPE ('TupleRep '[ 'IntRep, 'IntRep, 'IntRep, 'IntRep, 'IntRep])) e s b.+  Parser e s a -> (a -> Parser e s b) -> Parser e s b+{-# inline bindInt5Parser #-}+bindInt5Parser (Parser f) g = Parser+  (\x@(# arr, _, _ #) s0 -> case f x s0 of+    (# s1, r0 #) -> case r0 of+      (# e | #) -> (# s1, (# e | #) #)+      (# | (# y, b, c #) #) ->+        runParser (g y) (# arr, b, c #) s1+  )++sequenceInt5Parser :: forall (a :: TYPE ('TupleRep '[ 'IntRep, 'IntRep, 'IntRep, 'IntRep, 'IntRep])) e s b.+  Parser e s a -> Parser e s b -> Parser e s b+{-# inline sequenceInt5Parser #-}+sequenceInt5Parser (Parser f) (Parser g) = Parser+  (\x@(# arr, _, _ #) s0 -> case f x s0 of+    (# s1, r0 #) -> case r0 of+      (# e | #) -> (# s1, (# e | #) #)+      (# | (# _, b, c #) #) -> g (# arr, b, c #) s1+  )+ sequenceIntPairParser :: forall (a :: TYPE ('TupleRep '[ 'IntRep, 'IntRep])) e s b.   Parser e s a -> Parser e s b -> Parser e s b {-# inline sequenceIntPairParser #-}@@ -112,6 +139,33 @@       (# | (# _, b, c #) #) -> g (# arr, b, c #) s1   ) +bindInt2to5Parser :: forall +  (a :: TYPE ('TupleRep '[ 'IntRep, 'IntRep])) +  (b :: TYPE ('TupleRep '[ 'IntRep, 'IntRep, 'IntRep, 'IntRep, 'IntRep]))+  e s.+  Parser e s a -> (a -> Parser e s b) -> Parser e s b+{-# inline bindInt2to5Parser #-}+bindInt2to5Parser (Parser f) g = Parser+  (\x@(# arr, _, _ #) s0 -> case f x s0 of+    (# s1, r0 #) -> case r0 of+      (# e | #) -> (# s1, (# e | #) #)+      (# | (# y, b, c #) #) ->+        runParser (g y) (# arr, b, c #) s1+  )++sequenceInt2to5Parser :: forall +  (a :: TYPE ('TupleRep '[ 'IntRep, 'IntRep]))+  (b :: TYPE ('TupleRep '[ 'IntRep, 'IntRep, 'IntRep, 'IntRep, 'IntRep]))+  e s.+  Parser e s a -> Parser e s b -> Parser e s b+{-# inline sequenceInt2to5Parser #-}+sequenceInt2to5Parser (Parser f) (Parser g) = Parser+  (\x@(# arr, _, _ #) s0 -> case f x s0 of+    (# s1, r0 #) -> case r0 of+      (# e | #) -> (# s1, (# e | #) #)+      (# | (# _, b, c #) #) -> g (# arr, b, c #) s1+  )+ instance Bind 'LiftedRep 'LiftedRep where   {-# inline (>>=) #-}   {-# inline (>>) #-}@@ -130,12 +184,46 @@   (>>=) = bindIntPairParser   (>>) = sequenceIntPairParser ++instance Bind ('TupleRep '[ 'IntRep, 'IntRep])+              ('TupleRep '[ 'IntRep, 'IntRep, 'IntRep, 'IntRep, 'IntRep]) +  where+  {-# inline (>>=) #-}+  {-# inline (>>) #-}+  (>>=) = bindInt2to5Parser+  (>>) = sequenceInt2to5Parser++instance Bind ('TupleRep '[ 'IntRep, 'IntRep, 'IntRep, 'IntRep, 'IntRep]) +              'LiftedRep+  where+  {-# inline (>>=) #-}+  {-# inline (>>) #-}+  (>>=) = bindInt5Parser+  (>>) = sequenceInt5Parser+++instance Bind 'IntRep+              ('TupleRep '[ 'IntRep, 'IntRep, 'IntRep, 'IntRep, 'IntRep]) +  where+  {-# inline (>>=) #-}+  {-# inline (>>) #-}+  (>>=) = bindFromIntToInt5+  (>>) = sequenceIntToInt5+ instance Bind 'LiftedRep ('TupleRep '[ 'IntRep, 'IntRep]) where   {-# inline (>>=) #-}   {-# inline (>>) #-}   (>>=) = bindFromLiftedToIntPair   (>>) = sequenceLiftedToIntPair +instance Bind 'LiftedRep+              ('TupleRep '[ 'IntRep, 'IntRep, 'IntRep, 'IntRep, 'IntRep]) +  where+  {-# inline (>>=) #-}+  {-# inline (>>) #-}+  (>>=) = bindFromLiftedToInt5+  (>>) = sequenceLiftedToInt5+ instance Bind 'IntRep ('TupleRep '[ 'IntRep, 'IntRep]) where   {-# inline (>>=) #-}   {-# inline (>>) #-}@@ -160,6 +248,10 @@   {-# inline pure #-}   pure = pureIntPairParser +instance Pure ('TupleRep '[ 'IntRep, 'IntRep, 'IntRep, 'IntRep, 'IntRep]) where+  {-# inline pure #-}+  pure = pureInt5Parser+ bindFromIntToIntPair ::      forall s e        (a :: TYPE 'IntRep)@@ -191,6 +283,37 @@       (# | (# _, b, c #) #) -> g (# arr, b, c #) s1   ) +bindFromIntToInt5 ::+     forall s e+       (a :: TYPE 'IntRep)+       (b :: TYPE ('TupleRep '[ 'IntRep, 'IntRep, 'IntRep, 'IntRep, 'IntRep ])).+     Parser s e a+  -> (a -> Parser s e b)+  -> Parser s e b+{-# inline bindFromIntToInt5 #-}+bindFromIntToInt5 (Parser f) g = Parser+  (\x@(# arr, _, _ #) s0 -> case f x s0 of+    (# s1, r0 #) -> case r0 of+      (# e | #) -> (# s1, (# e | #) #)+      (# | (# y, b, c #) #) ->+        runParser (g y) (# arr, b, c #) s1+  )++sequenceIntToInt5 ::+     forall s e+       (a :: TYPE 'IntRep)+       (b :: TYPE ('TupleRep '[ 'IntRep, 'IntRep, 'IntRep, 'IntRep, 'IntRep ])).+     Parser s e a+  -> Parser s e b+  -> Parser s e b+{-# inline sequenceIntToInt5 #-}+sequenceIntToInt5 (Parser f) (Parser g) = Parser+  (\x@(# arr, _, _ #) s0 -> case f x s0 of+    (# s1, r0 #) -> case r0 of+      (# e | #) -> (# s1, (# e | #) #)+      (# | (# _, b, c #) #) -> g (# arr, b, c #) s1+  )+ bindFromLiftedToIntPair ::      forall s e        (a :: TYPE 'LiftedRep)@@ -216,6 +339,38 @@   -> Parser s e b {-# inline sequenceLiftedToIntPair #-} sequenceLiftedToIntPair (Parser f) (Parser g) = Parser+  (\x@(# arr, _, _ #) s0 -> case f x s0 of+    (# s1, r0 #) -> case r0 of+      (# e | #) -> (# s1, (# e | #) #)+      (# | (# _, b, c #) #) -> g (# arr, b, c #) s1+  )+++bindFromLiftedToInt5 ::+     forall s e+       (a :: TYPE 'LiftedRep)+       (b :: TYPE ('TupleRep '[ 'IntRep, 'IntRep, 'IntRep, 'IntRep, 'IntRep])).+     Parser s e a+  -> (a -> Parser s e b)+  -> Parser s e b+{-# inline bindFromLiftedToInt5 #-}+bindFromLiftedToInt5 (Parser f) g = Parser+  (\x@(# arr, _, _ #) s0 -> case f x s0 of+    (# s1, r0 #) -> case r0 of+      (# e | #) -> (# s1, (# e | #) #)+      (# | (# y, b, c #) #) ->+        runParser (g y) (# arr, b, c #) s1+  )++sequenceLiftedToInt5 ::+     forall s e+       (a :: TYPE 'LiftedRep)+       (b :: TYPE ('TupleRep '[ 'IntRep, 'IntRep, 'IntRep, 'IntRep, 'IntRep ])).+     Parser s e a+  -> Parser s e b+  -> Parser s e b+{-# inline sequenceLiftedToInt5 #-}+sequenceLiftedToInt5 (Parser f) (Parser g) = Parser   (\x@(# arr, _, _ #) s0 -> case f x s0 of     (# s1, r0 #) -> case r0 of       (# e | #) -> (# s1, (# e | #) #)
test/Main.hs view
@@ -15,21 +15,27 @@ import Data.Bytes.Types (Bytes(Bytes)) import Data.Char (ord) import Data.Coerce (coerce)+import Data.Int (Int16,Int32) import Data.Primitive (ByteArray(..),PrimArray(..)) import Data.Text.Short (ShortText) import Data.WideWord (Word128(Word128)) import Data.Word (Word8,Word64,Word16,Word32)+import Numeric.Natural (Natural) import System.ByteOrder (Fixed(..),ByteOrder(BigEndian,LittleEndian)) import Test.Tasty (defaultMain,testGroup,TestTree) import Test.Tasty.HUnit ((@=?),testCase) import Test.Tasty.QuickCheck ((===),testProperty)  import qualified Data.Bits as Bits+import qualified Data.Bytes as Bytes import qualified Data.Bytes.Parser as P import qualified Data.Bytes.Parser.Ascii as Ascii-import qualified Data.Bytes.Parser.Latin as Latin+import qualified Data.Bytes.Parser.Base128 as Base128 import qualified Data.Bytes.Parser.BigEndian as BigEndian+import qualified Data.Bytes.Parser.Latin as Latin+import qualified Data.Bytes.Parser.Leb128 as Leb128 import qualified Data.Bytes.Parser.LittleEndian as LittleEndian+import qualified Data.List as List import qualified Data.Primitive as PM import qualified GHC.Exts as Exts import qualified Test.Tasty.QuickCheck as QC@@ -358,6 +364,70 @@         @=? P.Success         (Slice 17 0 0xABCD01235678BCDE)     ]+  , testGroup "base128-w32"+    [ testCase "A" $+        P.Success (Slice 2 0 0x7E)+        @=?+        P.parseBytes (Base128.word32 ()) (bytes "\x7E")+    , testCase "B" $+        P.Success (Slice 5 0 0x200000)+        @=?+        P.parseBytes (Base128.word32 ()) (bytes "\x81\x80\x80\x00")+    , testCase "C" $+        P.Success (Slice 4 0 1656614)+        @=?+        P.parseBytes (Base128.word32 ()) (bytes "\xE5\x8E\x26")+    -- , testProperty "iso" $ \w -> -- TODO+    --     P.parseBytesMaybe (Base.word32 ()) (encodeBase128 (fromIntegral w))+    --     ===+    --     Just w+    ]+  , testGroup "leb128-w32"+    [ testCase "A" $+        P.Success (Slice 2 0 0x7E)+        @=?+        P.parseBytes (Leb128.word32 ()) (bytes "\x7E")+    , testCase "B" $+        P.Success (Slice 5 0 0x200000)+        @=?+        P.parseBytes (Leb128.word32 ()) (bytes "\x80\x80\x80\x01")+    , testCase "C" $+        P.Success (Slice 4 0 624485)+        @=?+        P.parseBytes (Leb128.word32 ()) (bytes "\xE5\x8E\x26")+    , testProperty "iso" $ \w -> +        P.parseBytesMaybe (Leb128.word32 ()) (encodeLeb128 (fromIntegral w))+        ===+        Just w+    ]+  , testGroup "leb128-w16"+    [ testCase "A" $+        P.Failure ()+        @=?+        P.parseBytes (Leb128.word16 ()) (bytes "\x80\x80\x04")+    , testCase "B" $+        P.Success (Slice 4 0 0xFFFF)+        @=?+        P.parseBytes (Leb128.word16 ()) (bytes "\xFF\xFF\x03")+    , testProperty "iso" $ \w -> +        P.parseBytesMaybe (Leb128.word16 ()) (encodeLeb128 (fromIntegral w))+        ===+        Just w+    ]+  , testGroup "leb128-i16"+    [ testProperty "iso" $ \(w :: Int16) -> +        P.parseBytesMaybe (Leb128.int16 ())+          (encodeLeb128 (fromIntegral @Word16 @Natural (zigzag16 w)))+        ===+        Just w+    ]+  , testGroup "leb128-i32"+    [ testProperty "iso" $ \(w :: Int32) -> +        P.parseBytesMaybe (Leb128.int32 ())+          (encodeLeb128 (fromIntegral @Word32 @Natural (zigzag32 w)))+        ===+        Just w+    ]   ]  bytes :: String -> Bytes@@ -471,4 +541,26 @@ untype :: PrimArray a -> ByteArray untype (PrimArray x) = ByteArray x +encodeLeb128 :: Natural -> Bytes+encodeLeb128 x = Bytes.unsafeDrop 1 (Exts.fromList (0xFF : go [] x)) where+  go !xs !n =+    let (q,r) = quotRem n 128+        r' = fromIntegral @Natural @Word8 r+        w = if q == 0+          then r'+          else Bits.setBit r' 7+        xs' = w : xs+     in if q == 0 +          then List.reverse xs'+          else go xs' q +-- x zigzagInteger :: Integer -> Natural+-- x zigzagInteger x+-- x   | x>=0 = fromInteger (x `Bits.shiftL` 1)+-- x   | otherwise = fromInteger (negate (x `Bits.shiftL` 1) - 1)++zigzag16 :: Int16 -> Word16+zigzag16 x = fromIntegral ((x `Bits.shiftL` 1) `Bits.xor` (x `Bits.shiftR` 15))++zigzag32 :: Int32 -> Word32+zigzag32 x = fromIntegral ((x `Bits.shiftL` 1) `Bits.xor` (x `Bits.shiftR` 31))