diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,13 @@ # Revision history for bytesmith +## 0.3.0.0 -- 2019-??-?? + +* Include the offset into the byte sequence in `Result`. Breaking change. +* Rename `hexWord16` to `hexFixedWord16`. Breaking change. +* Rename `parseBytesST` to `parseBytesEffectfully`. Breaking change. +* Add `hexNibbleLower` and `tryHexNibbleLower`. +* Add `hexNibble` and `tryHexNibble`. + ## 0.2.0.1 -- 2019-09-24 * Correct an overflow-detection mistake in the implementation diff --git a/bytesmith.cabal b/bytesmith.cabal --- a/bytesmith.cabal +++ b/bytesmith.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: bytesmith -version: 0.2.0.1 +version: 0.3.0.0 synopsis: Nonresumable byte parser description: Parse bytes as fast as possible. This is a nonresumable parser @@ -26,6 +26,7 @@ Data.Bytes.Parser.Utf8 other-modules: Data.Bytes.Parser.Internal + Data.Bytes.Parser.Types build-depends: , base >=4.12 && <5 , bytestring >=0.10.8 && <0.11 diff --git a/src/Data/Bytes/Parser.hs b/src/Data/Bytes/Parser.hs --- a/src/Data/Bytes/Parser.hs +++ b/src/Data/Bytes/Parser.hs @@ -22,19 +22,22 @@ -- modules. module Data.Bytes.Parser ( -- * Types - Parser(..) + Parser , Result(..) + , Slice(..) -- * Run Parsers , parseByteArray , parseBytes - , parseBytesST + , parseBytesEffectfully -- * One Byte , any -- * Many Bytes , take , takeWhile + , takeTrailedBy -- * Skip , skipWhile + , skipTrailedBy -- * Match , byteArray , bytes @@ -80,12 +83,15 @@ import Prelude hiding (length,any,fail,takeWhile,take,replicate) -import Data.Bytes.Parser.Internal (InternalResult(..),Parser(..),unboxBytes,boxBytes,Result#,uneffectful,fail) -import Data.Bytes.Parser.Unsafe (unconsume) +import Data.Bytes.Parser.Internal (InternalResult(..),Parser(..),ST#,unboxBytes) +import Data.Bytes.Parser.Internal (boxBytes,Result#,uneffectful,fail) +import Data.Bytes.Parser.Internal (uneffectful#) +import Data.Bytes.Parser.Types (Result(Failure,Success),Slice(Slice)) +import Data.Bytes.Parser.Unsafe (unconsume,expose,cursor) import Data.Bytes.Types (Bytes(..)) import Data.Primitive (ByteArray(..)) -import GHC.Exts (Int(I#),Word#,Int#,Char#,(+#),(-#),(>=#)) -import GHC.ST (ST(..),runST) +import GHC.Exts (Int(I#),Word#,Int#,Char#,runRW#,(+#),(-#),(>=#)) +import GHC.ST (ST(..)) import GHC.Word (Word32(W32#),Word8) import Data.Primitive.Contiguous (Contiguous,Element) @@ -93,27 +99,25 @@ import qualified Data.Primitive as PM import qualified Data.Primitive.Contiguous as C --- | The result of running a parser. -data Result e a - = Failure e - -- ^ An error message indicating what went wrong. - | Success !a !Int - -- ^ The parsed value and the number of bytes - -- remaining in parsed slice. - deriving (Eq,Show) - -- | Parse a slice of a byte array. This can succeed even if the -- entire slice was not consumed by the parser. parseBytes :: forall e a. (forall s. Parser e s a) -> Bytes -> Result e a -parseBytes p !b = runST action +parseBytes p !b = runResultST action where - action :: forall s. ST s (Result e a) - action = case p @s of - Parser f -> ST - (\s0 -> case f (unboxBytes b) s0 of - (# s1, r #) -> (# s1, boxPublicResult r #) - ) + action :: forall s. ST# s (Result# e a) + action s0 = case p @s of + Parser f -> f (unboxBytes b) s0 +-- This is used internally to help reduce boxing when a parser +-- gets run. Due to the late inlining of runRW#, this variant +-- of runST still cause the result value to be boxed. However, +-- it avoids the additional boxing that the Success data +-- constructor would normally cause. +runResultST :: (forall s. ST# s (Result# e x)) -> Result e x +runResultST f = case (runRW# (\s0 -> case f s0 of { (# _, r #) -> r })) of + (# e | #) -> Failure e + (# | (# x, off, len #) #) -> Success (Slice (I# off) (I# len) x) + -- | Variant of 'parseBytes' that accepts an unsliced 'ByteArray'. parseByteArray :: (forall s. Parser e s a) -> ByteArray -> Result e a parseByteArray p b = @@ -121,8 +125,8 @@ -- | Variant of 'parseBytes' that allows the parser to be run -- as part of an existing effectful context. -parseBytesST :: Parser e s a -> Bytes -> ST s (Result e a) -parseBytesST (Parser f) !b = ST +parseBytesEffectfully :: Parser e s a -> Bytes -> ST s (Result e a) +parseBytesEffectfully (Parser f) !b = ST (\s0 -> case f (unboxBytes b) s0 of (# s1, r #) -> (# s1, boxPublicResult r #) ) @@ -183,6 +187,38 @@ takeWhile f = uneffectful $ \chunk -> case B.takeWhile f chunk of bs -> InternalSuccess bs (offset chunk + length bs) (length chunk - length bs) +-- | Take bytes until the specified byte is encountered. Consumes +-- the matched byte as well. Fails if the byte is not present. +-- Visually, the cursor advancement and resulting @Bytes@ for +-- @takeTrailedBy 0x19@ look like this: +-- +-- > 0x10 0x13 0x08 0x15 0x19 0x23 0x17 | input +-- > |---->---->---->---->----| | cursor +-- > {----*----*----*----} | result bytes +takeTrailedBy :: e -> Word8 -> Parser e s Bytes +takeTrailedBy e !w = do + !start <- cursor + skipTrailedBy e w + !end <- cursor + !arr <- expose + pure (Bytes arr start (end - start)) + +-- | Skip all characters until the character from the is encountered +-- and then consume the matching byte as well. +skipTrailedBy :: e -> Word8 -> Parser e s () +skipTrailedBy e !w = uneffectful# (\c -> skipUntilConsumeByteLoop e w c) + +skipUntilConsumeByteLoop :: + e -- Error message + -> Word8 -- byte to match + -> Bytes -- Chunk + -> Result# e () +skipUntilConsumeByteLoop e !w !c = if length c > 0 + then if PM.indexByteArray (array c) (offset c) /= (w :: Word8) + then skipUntilConsumeByteLoop e w (B.unsafeDrop 1 c) + else (# | (# (), unI (offset c + 1), unI (length c - 1) #) #) + else (# e | #) + -- | Take the given number of bytes. Fails if there is not enough -- remaining input. take :: e -> Int -> Parser e s Bytes @@ -226,7 +262,7 @@ InternalSuccess (length chunk == 0) (offset chunk) (length chunk) boxPublicResult :: Result# e a -> Result e a -boxPublicResult (# | (# a, _, c #) #) = Success a (I# c) +boxPublicResult (# | (# a, b, c #) #) = Success (Slice (I# b) (I# c) a) boxPublicResult (# e | #) = Failure e -- | Convert a 'Word32' parser to a 'Word#' parser. @@ -386,9 +422,9 @@ -- | Run a parser in a delimited context, failing if the requested number -- of bytes are not available or if the delimited parser does not -- consume all input. This combinator can be understood as a composition --- of 'take', 'effect', 'parseBytesST', and 'endOfInput'. It is provided as --- a single combinator because for convenience and because it is easy --- make mistakes when manually assembling the aforementioned parsers. +-- of 'take', 'effect', 'parseBytesEffectfully', and 'endOfInput'. It is +-- provided as a single combinator because for convenience and because it is +-- easy to make mistakes when manually assembling the aforementioned parsers. -- The pattern of prefixing an encoding with its length is common. -- This is discussed more in -- . @@ -430,3 +466,6 @@ go (ix + 1) else effect (C.unsafeFreeze marr) go 0 + +unI :: Int -> Int# +unI (I# w) = w diff --git a/src/Data/Bytes/Parser/Internal.hs b/src/Data/Bytes/Parser/Internal.hs --- a/src/Data/Bytes/Parser/Internal.hs +++ b/src/Data/Bytes/Parser/Internal.hs @@ -19,9 +19,11 @@ module Data.Bytes.Parser.Internal ( Parser(..) , InternalResult(..) + , InternalStep(..) , Bytes# , ST# , Result# + , unfailing , uneffectful , uneffectful# , boxBytes @@ -57,10 +59,19 @@ -- The parsed value, the offset after the last consumed byte, and the -- number of bytes remaining in parsed slice. +data InternalStep a = InternalStep !a !Int !Int + uneffectful :: (Bytes -> InternalResult e a) -> Parser e s a {-# inline uneffectful #-} uneffectful f = Parser ( \b s0 -> (# s0, unboxResult (f (boxBytes b)) #) ) + +-- This is like uneffectful but for parsers that always succeed. +-- These combinators typically have names that begin with @try@. +unfailing :: (Bytes -> InternalStep a) -> Parser e s a +{-# inline unfailing #-} +unfailing f = Parser + ( \b s0 -> (# s0, case f (boxBytes b) of { InternalStep a (I# off) (I# len) -> (# | (# a, off, len #) #) } #) ) boxBytes :: Bytes# -> Bytes {-# inline boxBytes #-} diff --git a/src/Data/Bytes/Parser/Latin.hs b/src/Data/Bytes/Parser/Latin.hs --- a/src/Data/Bytes/Parser/Latin.hs +++ b/src/Data/Bytes/Parser/Latin.hs @@ -46,6 +46,7 @@ , decWord8 , decWord16 , decWord32 + , decWord64 -- *** Signed , decUnsignedInt , decUnsignedInt# @@ -57,13 +58,18 @@ , decUnsignedInteger , decTrailingInteger -- ** Hexadecimal - , hexWord16 + , hexFixedWord16 + , hexNibbleLower + , tryHexNibbleLower + , hexNibble + , tryHexNibble ) where import Prelude hiding (length,any,fail,takeWhile) import Data.Bits ((.|.)) import Data.Bytes.Types (Bytes(..)) +import Data.Bytes.Parser.Internal (InternalStep(..),unfailing) import Data.Bytes.Parser.Internal (Parser(..),ST#,uneffectful,Result#,uneffectful#) import Data.Bytes.Parser.Internal (InternalResult(..),indexLatinCharArray,upcastUnitSuccess) import Data.Bytes.Parser.Internal (boxBytes) @@ -74,7 +80,7 @@ import GHC.Exts (Int(I#),Char(C#),Word#,Int#,Char#,(+#),(-#),indexCharArray#) import GHC.Exts (TYPE,RuntimeRep,int2Word#,or#) import GHC.Exts (ltWord#,gtWord#,notI#) -import GHC.Word (Word(W#),Word8(W8#),Word16(W16#),Word32(W32#)) +import GHC.Word (Word(W#),Word8(W8#),Word16(W16#),Word32(W32#),Word64(W64#)) import qualified GHC.Exts as Exts import qualified Data.Bytes as Bytes @@ -171,7 +177,7 @@ in InternalSuccess c (offset chunk + 1) (length chunk - 1) else InternalFailure e --- | Consume a character from the input or return Nothing if +-- | Consume a character from the input or return @Nothing@ if -- end of the stream has been reached. Since ISO 8859-1 maps every -- bytes to a character, this parser never fails. opt :: Parser e s (Maybe Char) @@ -295,6 +301,16 @@ (# s1, r #) -> (# s1, upcastWordResult r #) ) +-- | Parse a decimal-encoded unsigned number. If the number is +-- too large to be represented by a 64-bit word, this fails with +-- the provided error message. This accepts any number of leading +-- zeroes. +decWord64 :: e -> Parser e s Word64 +decWord64 e = Parser + (\chunk0 s0 -> case decWordStart e (boxBytes chunk0) s0 of + (# s1, r #) -> (# s1, upcastWord64Result r #) + ) + decSmallWordStart :: e -- Error message -> Word -- Upper Bound @@ -316,21 +332,30 @@ -> Word -- Accumulator -> Bytes -- Chunk -> Result# e Word# -decWordMore e !acc !chunk0 = if length chunk0 > 0 - then +decWordMore e !acc !chunk0 = case len of + 0 -> (# | (# unW (fromIntegral acc), unI (offset chunk0), 0# #) #) + _ -> let !w = fromIntegral @Word8 @Word (PM.indexByteArray (array chunk0) (offset chunk0)) - 48 - !acc' = acc * 10 + w - in if w < 10 && acc' >= acc - then decWordMore e acc' (Bytes.unsafeDrop 1 chunk0) - else (# | (# unW acc, unI (offset chunk0), unI (length chunk0) #) #) - else (# | (# unW acc, unI (offset chunk0), 0# #) #) - + in if w < 10 + then + let (overflow,acc') = unsignedPushBase10 acc w + in if overflow + then (# e | #) + else decWordMore e acc' (Bytes.unsafeDrop 1 chunk0) + else (# | (# unW (fromIntegral acc), unI (offset chunk0), len# #) #) + where + !len@(I# len# ) = length chunk0 upcastWordResult :: Result# e Word# -> Result# e Word upcastWordResult (# e | #) = (# e | #) upcastWordResult (# | (# a, b, c #) #) = (# | (# W# a, b, c #) #) +-- This only works on 64-bit platforms. +upcastWord64Result :: Result# e Word# -> Result# e Word64 +upcastWord64Result (# e | #) = (# e | #) +upcastWord64Result (# | (# a, b, c #) #) = (# | (# W64# a, b, c #) #) + decSmallWordMore :: e -- Error message -> Word -- Accumulator @@ -674,18 +699,18 @@ -- This is insensitive to case. This is particularly useful when -- parsing escape sequences in C or JSON, which allow encoding -- characters in the Basic Multilingual Plane as @\\uhhhh@. -hexWord16 :: e -> Parser e s Word16 -{-# inline hexWord16 #-} -hexWord16 e = Parser - (\x s0 -> case runParser (hexWord16# e) x s0 of +hexFixedWord16 :: e -> Parser e s Word16 +{-# inline hexFixedWord16 #-} +hexFixedWord16 e = Parser + (\x s0 -> case runParser (hexFixedWord16# e) x s0 of (# s1, r #) -> case r of (# err | #) -> (# s1, (# err | #) #) (# | (# a, b, c #) #) -> (# s1, (# | (# W16# a, b, c #) #) #) ) -hexWord16# :: e -> Parser e s Word# -{-# noinline hexWord16# #-} -hexWord16# e = uneffectfulWord# $ \chunk -> if length chunk >= 4 +hexFixedWord16# :: e -> Parser e s Word# +{-# noinline hexFixedWord16# #-} +hexFixedWord16# e = uneffectfulWord# $ \chunk -> if length chunk >= 4 then let !w0@(W# n0) = oneHex $ PM.indexByteArray (array chunk) (offset chunk) !w1@(W# n1) = oneHex $ PM.indexByteArray (array chunk) (offset chunk + 1) @@ -702,7 +727,58 @@ | otherwise -> (# e | #) else (# e | #) +-- | Consume a single character that is the lowercase hexadecimal +-- encoding of a 4-bit word. Fails if the character is not in the class +-- @[a-f0-9]@. +hexNibbleLower :: e -> Parser e s Word +hexNibbleLower e = uneffectful $ \chunk -> case length chunk of + 0 -> InternalFailure e + _ -> + let w = PM.indexByteArray (array chunk) (offset chunk) :: Word8 in + if | w >= 48 && w < 58 -> InternalSuccess (fromIntegral w - 48) (offset chunk + 1) (length chunk - 1) + | w >= 97 && w < 103 -> InternalSuccess (fromIntegral w - 87) (offset chunk + 1) (length chunk - 1) + | otherwise -> InternalFailure e +-- | Consume a single character that is the case-insensitive hexadecimal +-- encoding of a 4-bit word. Fails if the character is not in the class +-- @[a-fA-F0-9]@. +hexNibble :: e -> Parser e s Word +hexNibble e = uneffectful $ \chunk -> case length chunk of + 0 -> InternalFailure e + _ -> + let w = PM.indexByteArray (array chunk) (offset chunk) :: Word8 in + if | w >= 48 && w < 58 -> InternalSuccess (fromIntegral w - 48) (offset chunk + 1) (length chunk - 1) + | w >= 65 && w < 71 -> InternalSuccess (fromIntegral w - 55) (offset chunk + 1) (length chunk - 1) + | w >= 97 && w < 103 -> InternalSuccess (fromIntegral w - 87) (offset chunk + 1) (length chunk - 1) + | otherwise -> InternalFailure e + +-- | Consume a single character that is the lowercase hexadecimal +-- encoding of a 4-bit word. Returns @Nothing@ without consuming +-- the character if it is not in the class @[a-f0-9]@. The parser +-- never fails. +tryHexNibbleLower :: Parser e s (Maybe Word) +tryHexNibbleLower = unfailing $ \chunk -> case length chunk of + 0 -> InternalStep Nothing (offset chunk) (length chunk) + _ -> + let w = PM.indexByteArray (array chunk) (offset chunk) :: Word8 in + if | w >= 48 && w < 58 -> InternalStep (Just (fromIntegral w - 48)) (offset chunk + 1) (length chunk - 1) + | w >= 97 && w < 103 -> InternalStep (Just (fromIntegral w - 87)) (offset chunk + 1) (length chunk - 1) + | otherwise -> InternalStep Nothing (offset chunk) (length chunk) + +-- | Consume a single character that is the case-insensitive hexadecimal +-- encoding of a 4-bit word. Returns @Nothing@ without consuming +-- the character if it is not in the class @[a-fA-F0-9]@. This parser +-- never fails. +tryHexNibble :: Parser e s (Maybe Word) +tryHexNibble = unfailing $ \chunk -> case length chunk of + 0 -> InternalStep Nothing (offset chunk) (length chunk) + _ -> + let w = PM.indexByteArray (array chunk) (offset chunk) :: Word8 in + if | w >= 48 && w < 58 -> InternalStep (Just (fromIntegral w - 48)) (offset chunk + 1) (length chunk - 1) + | w >= 65 && w < 71 -> InternalStep (Just (fromIntegral w - 55)) (offset chunk + 1) (length chunk - 1) + | w >= 97 && w < 103 -> InternalStep (Just (fromIntegral w - 87)) (offset chunk + 1) (length chunk - 1) + | otherwise -> InternalStep Nothing (offset chunk) (length chunk) + -- Returns the maximum machine word if the argument is not -- the ASCII encoding of a hexadecimal digit. oneHex :: Word8 -> Word @@ -727,4 +803,12 @@ !cb = int2Word# (gtWord# r1 upper) !cc = int2Word# (ltWord# r1 0##) !c = ca `or#` cb `or#` cc + in (case c of { 0## -> False; _ -> True }, W# r1) + +unsignedPushBase10 :: Word -> Word -> (Bool,Word) +unsignedPushBase10 (W# a) (W# b) = + let !(# ca, r0 #) = Exts.timesWord2# a 10## + !r1 = Exts.plusWord# r0 b + !cb = int2Word# (ltWord# r1 r0) + !c = ca `or#` cb in (case c of { 0## -> False; _ -> True }, W# r1) diff --git a/src/Data/Bytes/Parser/Types.hs b/src/Data/Bytes/Parser/Types.hs new file mode 100644 --- /dev/null +++ b/src/Data/Bytes/Parser/Types.hs @@ -0,0 +1,41 @@ +{-# language DeriveFunctor #-} +{-# language DeriveFoldable #-} +{-# language DerivingStrategies #-} + +module Data.Bytes.Parser.Types + ( Parser + , Result(..) + , Slice(..) + ) where + +import Data.Bytes.Parser.Internal (Parser(..)) + +-- | The result of running a parser. +data Result e a + = Failure e + -- ^ An error message indicating what went wrong. + | Success {-# UNPACK #-} !(Slice a) + -- ^ The parsed value and the number of bytes + -- remaining in parsed slice. + deriving stock (Eq,Show,Foldable,Functor) + +-- | Slicing metadata (an offset and a length) accompanied +-- by a value. This does not represent a slice into the +-- value. This type is intended to be used as the result +-- of an executed parser. In this context the slicing metadata +-- describe a slice into to the array (or byte array) that +-- from which the value was parsed. +-- +-- It is often useful to check the @length@ when a parser +-- succeeds since a non-zero length indicates that there +-- was additional unconsumed input. The @offset@ is only +-- ever needed to construct a new slice (via @Bytes@ or +-- @SmallVector@) from the remaining input. +data Slice a = Slice + { offset :: {-# UNPACK #-} !Int + -- ^ Offset into the array. + , length :: {-# UNPACK #-} !Int + -- ^ Length of the slice. + , value :: a + -- ^ The structured data that was successfully parsed. + } deriving stock (Eq,Show,Foldable,Functor) diff --git a/src/Data/Bytes/Parser/Unsafe.hs b/src/Data/Bytes/Parser/Unsafe.hs --- a/src/Data/Bytes/Parser/Unsafe.hs +++ b/src/Data/Bytes/Parser/Unsafe.hs @@ -3,11 +3,13 @@ {-# language DataKinds #-} {-# language DeriveFunctor #-} {-# language DerivingStrategies #-} +{-# language DuplicateRecordFields #-} {-# language GADTSyntax #-} {-# language KindSignatures #-} {-# language LambdaCase #-} {-# language MagicHash #-} {-# language MultiWayIf #-} +{-# language NamedFieldPuns #-} {-# language PolyKinds #-} {-# language RankNTypes #-} {-# language ScopedTypeVariables #-} @@ -19,7 +21,10 @@ -- | Everything in this module is unsafe and can lead to -- nondeterministic output or segfaults if used incorrectly. module Data.Bytes.Parser.Unsafe - ( cursor + ( -- * Types + Parser(..) + -- * Functions + , cursor , expose , unconsume , jump @@ -36,27 +41,27 @@ -- it possible to observe the internal difference between 'Bytes' -- that refer to equivalent slices. Be careful. cursor :: Parser e s Int -cursor = uneffectful $ \chunk -> - InternalSuccess (offset chunk) (offset chunk) (length chunk) +cursor = uneffectful $ \Bytes{offset,length} -> + InternalSuccess offset offset length -- | Return the byte array being parsed. This includes bytes -- that preceed the current offset and may include bytes that -- go beyond the length. This is somewhat dangerous, so only -- use this is you know what you're doing. expose :: Parser e s ByteArray -expose = uneffectful $ \chunk -> - InternalSuccess (array chunk) (offset chunk) (length chunk) +expose = uneffectful $ \Bytes{length,offset,array} -> + InternalSuccess array offset length -- | Move the cursor back by @n@ bytes. Precondition: you -- must have previously consumed at least @n@ bytes. unconsume :: Int -> Parser e s () -unconsume n = uneffectful $ \chunk -> - InternalSuccess () (offset chunk - n) (length chunk + n) +unconsume n = uneffectful $ \Bytes{length,offset} -> + InternalSuccess () (offset - n) (length + n) -- | Set the position to the given index. Precondition: the index -- must be valid. It should be the result of an earlier call to -- 'cursor'. jump :: Int -> Parser e s () -jump ix = uneffectful $ \chunk -> - InternalSuccess () ix (length chunk + (offset chunk - ix)) +jump ix = uneffectful $ \(Bytes{length,offset}) -> + InternalSuccess () ix (length + (offset - ix)) diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -11,6 +11,7 @@ import Data.Word (Word8,Word64) import Data.Char (ord) import Data.Bytes.Types (Bytes(Bytes)) +import Data.Bytes.Parser (Slice(Slice)) import Test.Tasty (defaultMain,testGroup,TestTree) import Test.Tasty.HUnit ((@=?),testCase) import Test.Tasty.QuickCheck ((===),testProperty) @@ -30,10 +31,13 @@ tests :: TestTree tests = testGroup "Parser" [ testProperty "decStandardInt" $ \i -> - P.parseBytes (Latin.decStandardInt ()) (bytes (show i)) === P.Success i 0 + withSz (show i) $ \str len -> + P.parseBytes (Latin.decStandardInt ()) str + === + P.Success (Slice len 0 i) , testProperty "big-endian-word64" bigEndianWord64 , testCase "delimit" $ - P.Success (167,14625) 0 + P.Success (Slice 13 0 (167,14625)) @=? P.parseBytes (do len <- Latin.decUnsignedInt () @@ -52,7 +56,7 @@ P.parseBytes (Latin.decUnsignedInt ()) (bytes "742493495120739103935542") , testCase "B" $ - P.Success 4654667 3 + P.Success (Slice 8 3 4654667) @=? P.parseBytes (Latin.decUnsignedInt ()) (bytes "4654667,55") @@ -71,45 +75,73 @@ @=? P.parseBytes (Latin.decUnsignedInt ()) (bytes (show (fromIntegral @Int @Word maxBound + 1))) - , testCase "F" $ - P.Success maxBound 0 + , testCase "F" $ withSz (show (maxBound :: Int)) $ \str len -> + P.Success (Slice len 0 maxBound) @=? - P.parseBytes (Latin.decUnsignedInt ()) - (bytes (show (maxBound :: Int))) + P.parseBytes (Latin.decUnsignedInt ()) str , testProperty "property" $ \(QC.NonNegative i) -> - P.parseBytes (Latin.decUnsignedInt ()) (bytes (show i)) - === - P.Success i 0 + withSz (show i) $ \str len -> + P.parseBytes (Latin.decUnsignedInt ()) str + === + P.Success (Slice len 0 i) ] + , testGroup "hexNibbleLower" + [ testCase "A" $ + P.parseBytes (Latin.hexNibbleLower ()) (bytes "Ab") @=? P.Failure () + , testCase "B" $ + P.parseBytes (Latin.hexNibbleLower ()) (bytes "bA") @=? P.Success (Slice 2 1 0xb) + , testCase "C" $ + P.parseBytes (Latin.hexNibbleLower ()) (bytes "") @=? P.Failure () + ] + , testGroup "tryHexNibbleLower" + [ testCase "A" $ + P.Success @() (Slice 1 2 Nothing) + @=? + P.parseBytes Latin.tryHexNibbleLower (bytes "Ab") + , testCase "B" $ + P.Success @() (Slice 2 1 (Just 0xb)) + @=? + P.parseBytes Latin.tryHexNibbleLower (bytes "bA") + , testCase "C" $ + P.Success @() (Slice 1 0 Nothing) + @=? + P.parseBytes Latin.tryHexNibbleLower (bytes "") + ] , testGroup "decPositiveInteger" [ testCase "A" $ P.parseBytes (Latin.decUnsignedInteger ()) (bytes "5469999463123462573426452736423546373235260") @=? - P.Success 5469999463123462573426452736423546373235260 0 + P.Success + (Slice 44 0 5469999463123462573426452736423546373235260) , testProperty "property" $ \(LargeInteger i) -> - i >= 0 - QC.==> - P.parseBytes (Latin.decUnsignedInteger ()) (bytes (show i)) - === - P.Success i 0 + withSz (show i) $ \str len -> + i >= 0 + QC.==> + P.parseBytes (Latin.decUnsignedInteger ()) str + === + P.Success (Slice len 0 i) ] , testGroup "decTrailingInteger" [ testProperty "property" $ \(LargeInteger i) -> - i >= 0 - QC.==> - P.parseBytes (Latin.decTrailingInteger 2) (bytes (show i)) - === - (P.Success (read ('2' : show i) :: Integer) 0 :: P.Result () Integer) + withSz (show i) $ \str sz -> + i >= 0 + QC.==> + P.parseBytes (Latin.decTrailingInteger 2) str + === + (P.Success (Slice sz 0 (read ('2' : show i) :: Integer)) :: P.Result () Integer) ] , testGroup "decSignedInteger" [ testCase "A" $ P.parseBytes (Latin.decSignedInteger ()) (bytes "-54699994631234625734264527364235463732352601") @=? - P.Success (-54699994631234625734264527364235463732352601) 0 - , testCase "B" $ - P.Success (3,(-206173954435705292503)) 0 + P.Success + ( Slice 46 0 + (-54699994631234625734264527364235463732352601) + ) + , testCase "B" $ + P.Success (Slice 25 0 (3,(-206173954435705292503))) @=? P.parseBytes ( pure (,) @@ -118,21 +150,22 @@ <*> Latin.decSignedInteger () ) (bytes "3e-206173954435705292503") , testProperty "property" $ \(LargeInteger i) -> - P.parseBytes (Latin.decSignedInteger ()) (bytes (show i)) - === - P.Success i 0 + withSz (show i) $ \str len -> + P.parseBytes (Latin.decSignedInteger ()) str + === + P.Success (Slice len 0 i) ] , testGroup "decSignedInt" - [ testProperty "A" $ \i -> - P.parseBytes (Latin.decSignedInt ()) (bytes (show i)) + [ testProperty "A" $ \i -> withSz (show i) $ \str len -> + P.parseBytes (Latin.decSignedInt ()) str === - P.Success i 0 + P.Success (Slice len 0 i) , testProperty "B" $ \i -> - P.parseBytes - (Latin.decSignedInt ()) - (bytes ((if i >= 0 then "+" else "") ++ show i)) - === - P.Success i 0 + let s = (if i >= 0 then "+" else "") ++ show i in + withSz s $ \str len -> + P.parseBytes (Latin.decSignedInt ()) str + === + P.Success (Slice len 0 i) , testCase "C" $ P.Failure () @=? @@ -153,16 +186,14 @@ @=? P.parseBytes (Latin.decSignedInt ()) (bytes "-4305030950553840988981") - , testCase "G" $ - P.Success minBound 0 + , testCase "G" $ withSz (show (minBound :: Int)) $ \str len -> + P.Success (Slice len 0 minBound) @=? - P.parseBytes (Latin.decSignedInt ()) - (bytes (show (minBound :: Int))) - , testCase "H" $ - P.Success maxBound 0 + P.parseBytes (Latin.decSignedInt ()) str + , testCase "H" $ withSz (show (maxBound :: Int)) $ \str len -> + P.Success (Slice len 0 maxBound) @=? - P.parseBytes (Latin.decSignedInt ()) - (bytes (show (maxBound :: Int))) + P.parseBytes (Latin.decSignedInt ()) str , testCase "I" $ P.Failure () @=? @@ -177,8 +208,15 @@ P.parseBytes (Latin.decSignedInt ()) (bytes "-9223372036854775809") ] + , testGroup "decWord64" + [ testCase "A" $ + P.Failure () + @=? + P.parseBytes (Latin.decWord64 ()) + (bytes "2481030337885070917891") + ] , testCase "decWord-composition" $ - P.Success (42,8) 0 + P.Success (Slice 6 0 (42,8)) @=? P.parseBytes ( pure (,) @@ -188,7 +226,7 @@ <* Ascii.char () '.' ) (bytes "42.8.") , testCase "decWord-replicate" $ - P.Success (Exts.fromList [42,93] :: PrimArray Word) 0 + P.Success (Slice 7 0 (Exts.fromList [42,93] :: PrimArray Word)) @=? P.parseBytes (P.replicate 2 (Ascii.decWord () <* Ascii.char () '.')) @@ -231,7 +269,7 @@ + fromIntegral h * 256 ^ (0 :: Integer) in P.parseBytes (BigEndian.word64 ()) (Bytes arr 2 9) === - P.Success expected 1 + P.Success (Slice 10 1 expected) -- The Arbitrary instance for Integer that comes with -- QuickCheck only generates small numbers. @@ -249,3 +287,7 @@ f :: Word8 -> Integer -> Integer f w acc = (acc `Bits.shiftL` 8) + fromIntegral w +-- We add an extra 1 since bytes gives us a slice that +-- starts at that offset. +withSz :: String -> (Bytes -> Int -> a) -> a +withSz str f = f (bytes str) (length str + 1)