bytesmith 0.1.0.0 → 0.2.0.0

raw patch · 11 files changed

+1873/−691 lines, 11 filesdep +bytestringdep +contiguousdep +gaugedep ~basedep ~byteslicedep ~primitivePVP ok

version bump matches the API change (PVP)

Dependencies added: bytestring, contiguous, gauge, run-st, tasty, tasty-hunit, tasty-quickcheck, text-short

Dependency ranges changed: base, byteslice, primitive

API changes (from Hackage documentation)

Files

• CHANGELOG.md +11/−0
• bench/Main.hs +28/−0
• bytesmith.cabal +31/−2
• src/Data/Bytes/Parser.hs +265/−667
• src/Data/Bytes/Parser/Ascii.hs +195/−0
• src/Data/Bytes/Parser/BigEndian.hs +118/−0
• src/Data/Bytes/Parser/Internal.hs +148/−0
• src/Data/Bytes/Parser/Latin.hs +726/−0
• src/Data/Bytes/Parser/Unsafe.hs +62/−0
• src/Data/Bytes/Parser/Utf8.hs +143/−0
• test/Main.hs +146/−22

@@ -1,5 +1,16 @@ # Revision history for bytesmith +## 0.2.0.0 -- 2019-09-24++* Add big-endian word parsers.+* Redo module structure so that encoding-specific functions each+  live in their own module.+* Add a lot more functions and attempt to make naming somewhat+  consistent.+* Add `delimit`.+* Add `replicate`.+* Add `annotate` and its infix synonym `<?>`.+ ## 0.1.0.0 -- 2019-08-22  * First version.

@@ -0,0 +1,28 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE TypeApplications #-}++import Data.Char (ord)+import Data.Primitive (ByteArray)+import Data.Word (Word8)+import Gauge.Main (defaultMain,bench,whnf)++import qualified Data.Bytes.Parser as P+import qualified Data.Bytes.Parser.Latin as Latin+import qualified GHC.Exts as Exts++main :: IO ()+main = defaultMain+  [ bench "decPositiveInteger" $ whnf+      (\x -> P.parseByteArray (Latin.decUnsignedInteger ()) x)+      encodedBigNumber+  ]++encodedBigNumber :: ByteArray+encodedBigNumber = stringToByteArray $ show $ id @Integer $+  246246357264327645234627753190240202405243024304504230544+  *+  732345623640035232405249305932503920593209520932095234651++stringToByteArray :: String -> ByteArray+stringToByteArray =+  Exts.fromList . map (fromIntegral @Int @Word8 . ord)

@@ -1,6 +1,6 @@ cabal-version: 2.2 name: bytesmith-version: 0.1.0.0+version: 0.2.0.0 synopsis: Nonresumable byte parser description:   Parse bytes as fast as possible. This is a nonresumable parser@@ -19,10 +19,21 @@ library   exposed-modules:     Data.Bytes.Parser+    Data.Bytes.Parser.BigEndian+    Data.Bytes.Parser.Ascii+    Data.Bytes.Parser.Latin+    Data.Bytes.Parser.Unsafe+    Data.Bytes.Parser.Utf8+  other-modules:+    Data.Bytes.Parser.Internal   build-depends:     , base >=4.12 && <5-    , byteslice >=0.1.1 && <2+    , bytestring >=0.10.8 && <0.11+    , byteslice >=0.1.3 && <0.2+    , contiguous >= 0.4 && < 0.6     , primitive >=0.7 && <0.8+    , text-short >=0.1.3 && <0.2+    , run-st >=0.1 && <0.2   hs-source-dirs: src   ghc-options: -O2 -Wall   default-language: Haskell2010@@ -32,8 +43,26 @@   type: exitcode-stdio-1.0   hs-source-dirs: test   main-is: Main.hs+  ghc-options: -Wall -O2   build-depends:     , base >=4.12.0.0 && <5     , bytesmith     , primitive     , byteslice+    , tasty-hunit+    , tasty+    , tasty-quickcheck++benchmark bench+  type: exitcode-stdio-1.0+  build-depends:+    , base+    , byteslice+    , bytestring+    , gauge+    , primitive+    , bytesmith+  ghc-options: -Wall -O2+  default-language: Haskell2010+  hs-source-dirs: bench+  main-is: Main.hs

@@ -16,6 +16,10 @@ {-# language UnboxedSums #-} {-# language UnboxedTuples #-} +-- | Parse non-resumable sequence of bytes. To parse a byte sequence+-- as text, use the @Ascii@, @Latin@, and @Utf8@ modules instead.+-- Functions for parsing decimal-encoded numbers are found in those+-- modules. module Data.Bytes.Parser   ( -- * Types     Parser(..)@@ -24,85 +28,79 @@   , parseByteArray   , parseBytes   , parseBytesST-    -- * Build Parsers-  , fail-  , peekAnyAscii-  , ascii-  , ascii3-  , ascii4+    -- * One Byte   , any-  , anyAscii-  , anyAscii#-  , anyUtf8#-  , anyAsciiOpt-  , decWord-  , decWord8-  , decWord16-  , decWord32-  , hexWord16-  , decPositiveInteger+    -- * Many Bytes+  , take+  , takeWhile+    -- * Skip+  , skipWhile+    -- * Match+  , byteArray+  , bytes+    -- * End of Input   , endOfInput   , isEndOfInput-  , skipUntilAsciiConsume-  , skipWhile-  , skipAscii-  , skipAscii1-  , skipAlphaAscii-  , skipAlphaAscii1-  , skipDigitsAscii-  , skipDigitsAscii1+  , remaining+    -- * Control Flow+  , fail+  , orElse+  , annotate+  , (<?>)+    -- * Repetition+  , replicate+    -- * Subparsing+  , delimit+  , measure     -- * Lift Effects   , effect-    -- * Expose Internals-  , cursor-  , expose-  , unconsume-    -- * Cut down on boxing-  , unboxWord32+    -- * Box Result   , boxWord32+  , boxIntPair+    -- * Unbox Result+  , unboxWord32+  , unboxIntPair     -- * Specialized Bind-    -- $bind-  , bindChar-    -- * Alternative-  , orElse+    -- | Sometimes, GHC ends up building join points in a way that+    -- boxes arguments unnecessarily. In this situation, special variants+    -- of monadic @>>=@ can be helpful. If @C#@, @I#@, etc. never+    -- get used in your original source code, GHC will not introduce them.+  , bindFromCharToLifted+  , bindFromLiftedToIntPair+  , bindFromLiftedToInt+  , bindFromIntToIntPair+  , bindFromCharToIntPair+  , bindFromMaybeCharToIntPair+  , bindFromMaybeCharToLifted+    -- * Specialized Pure+  , pureIntPair+    -- * Specialized Fail+  , failIntPair   ) where -import Prelude hiding (length,any,fail)+import Prelude hiding (length,any,fail,takeWhile,take,replicate) -import Data.Char (ord)-import Data.Bits ((.&.),(.|.),unsafeShiftL,xor)-import Data.Kind (Type)-import GHC.ST (ST(..),runST)-import GHC.Exts (Word(W#),Word#,TYPE,State#,Int#,ByteArray#)-import GHC.Exts (Int(I#),Char(C#),chr#,RuntimeRep)-import GHC.Exts (Char#,(+#),(-#),(<#),(>#),word2Int#)-import GHC.Exts (indexCharArray#,indexWord8Array#,ord#)-import GHC.Exts (timesWord#,plusWord#)-import GHC.Word (Word16(W16#),Word8(W8#),Word32(W32#))+import Data.Bytes.Parser.Internal (InternalResult(..),Parser(..),unboxBytes,boxBytes,Result#,uneffectful,fail)+import Data.Bytes.Parser.Unsafe (unconsume) import Data.Bytes.Types (Bytes(..)) import Data.Primitive (ByteArray(..))+import GHC.Exts (Int(I#),Word#,Int#,Char#,(+#),(-#),(>=#))+import GHC.ST (ST(..),runST)+import GHC.Word (Word32(W32#),Word8)+import Data.Primitive.Contiguous (Contiguous,Element) +import qualified Data.Bytes as B import qualified Data.Primitive as PM-import qualified Control.Monad--type Bytes# = (# ByteArray#, Int#, Int# #)-type ST# s (a :: TYPE r) = State# s -> (# State# s, a #)-type Result# e (a :: TYPE r) =-  (# e-  | (# a, Int#, Int# #) #) -- ints are offset and length---- | A non-resumable parser.-newtype Parser :: forall (r :: RuntimeRep). Type -> Type -> TYPE r -> Type where-  Parser :: forall (r :: RuntimeRep) (e :: Type) (s :: Type) (a :: TYPE r).-    { runParser :: (# ByteArray#, Int#, Int# #) -> ST# s (Result# e a) } -> Parser e s a+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 !Int-    -- ^ The parsed value, the offset after the last consumed byte, and the-    --   number of bytes remaining in parsed slice.+  | 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.@@ -113,7 +111,7 @@   action = case p @s of     Parser f -> ST       (\s0 -> case f (unboxBytes b) s0 of-        (# s1, r #) -> (# s1, boxResult r #)+        (# s1, r #) -> (# s1, boxPublicResult r #)       )  -- | Variant of 'parseBytes' that accepts an unsliced 'ByteArray'.@@ -126,97 +124,9 @@ parseBytesST :: Parser e s a -> Bytes -> ST s (Result e a) parseBytesST (Parser f) !b = ST   (\s0 -> case f (unboxBytes b) s0 of-    (# s1, r #) -> (# s1, boxResult r #)+    (# s1, r #) -> (# s1, boxPublicResult r #)   ) -instance Functor (Parser e s) where-  {-# inline fmap #-}-  fmap f (Parser g) = Parser-    (\x s0 -> case g x s0 of-      (# s1, r #) -> case r of-        (# e | #) -> (# s1, (# e | #) #)-        (# | (# a, b, c #) #) -> (# s1, (# | (# f a, b, c #) #) #)-    )--instance Applicative (Parser e s) where-  pure = pureParser-  (<*>) = Control.Monad.ap--instance Monad (Parser e s) where-  {-# inline return #-}-  {-# inline (>>=) #-}-  return = pureParser-  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-    )--pureParser :: a -> Parser e s a-pureParser a = Parser-  (\(# _, b, c #) s -> (# s, (# | (# a, b, c #) #) #))--upcastUnitSuccess :: (# Int#, Int# #) -> Result# e ()-upcastUnitSuccess (# b, c #) = (# | (# (), b, c #) #)--upcastWordResult :: Result# e Word# -> Result# e Word-upcastWordResult (# e | #) = (# e | #)-upcastWordResult (# | (# a, b, c #) #) = (# | (# W# a, b, c #) #)---- Precondition: the word is small enough-upcastWord16Result :: Result# e Word# -> Result# e Word16-upcastWord16Result (# e | #) = (# e | #)-upcastWord16Result (# | (# a, b, c #) #) = (# | (# W16# a, b, c #) #)---- Precondition: the word is small enough-upcastWord32Result :: Result# e Word# -> Result# e Word32-upcastWord32Result (# e | #) = (# e | #)-upcastWord32Result (# | (# a, b, c #) #) = (# | (# W32# a, b, c #) #)---- Precondition: the word is small enough-upcastWord8Result :: Result# e Word# -> Result# e Word8-upcastWord8Result (# e | #) = (# e | #)-upcastWord8Result (# | (# a, b, c #) #) = (# | (# W8# a, b, c #) #)--c2w :: Char -> Word8-c2w = fromIntegral . ord---- | Get the current offset into the chunk. Using this makes--- it possible to observe the internal difference between 'Bytes'--- that refer to equivalent slices. Be careful.-cursor :: Parser e s Int-cursor = uneffectful $ \chunk ->-  Success (offset chunk) (offset chunk) (length chunk)---- | 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 ->-  Success (array chunk) (offset chunk) (length chunk)---- | 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 ->-  Success () (offset chunk - n) (length chunk + n)--uneffectful :: (Bytes -> Result e a) -> Parser e s a-{-# inline uneffectful #-}-uneffectful f = Parser-  ( \b s0 -> (# s0, unboxResult (f (boxBytes b)) #) )--uneffectful# :: (Bytes -> Result# e a) -> Parser e s a-uneffectful# f = Parser-  ( \b s0 -> (# s0, (f (boxBytes b)) #) )--uneffectfulWord# :: (Bytes -> Result# e Word#) -> Parser e s Word#-uneffectfulWord# f = Parser-  ( \b s0 -> (# s0, (f (boxBytes b)) #) )- -- | Lift an effectful computation into a parser. effect :: ST s a -> Parser e s a effect (ST f) = Parser@@ -224,59 +134,29 @@     (# s1, a #) -> (# s1, (# | (# a, off, len #) #) #)   ) --- | Only valid for characters with a Unicode code point lower--- than 128. This consumes a single byte, decoding it as an ASCII--- character.-ascii :: e -> Char -> Parser e s ()--- GHC should decide to inline this after optimization.-ascii e !c = uneffectful $ \chunk -> if length chunk > 0-  then if PM.indexByteArray (array chunk) (offset chunk) == c2w c-    then Success () (offset chunk + 1) (length chunk - 1)-    else Failure e-  else Failure e+byteArray :: e -> ByteArray -> Parser e s ()+byteArray e !expected = bytes e (B.fromByteArray expected) --- | Parse three bytes in succession.-ascii3 :: e -> Char -> Char -> Char -> Parser e s ()--- GHC should decide to inline this after optimization.-ascii3 e !c0 !c1 !c2 = uneffectful $ \chunk ->-  if | length chunk > 2-     , PM.indexByteArray (array chunk) (offset chunk) == c2w c0-     , PM.indexByteArray (array chunk) (offset chunk + 1) == c2w c1-     , PM.indexByteArray (array chunk) (offset chunk + 2) == c2w c2-         -> Success () (offset chunk + 3) (length chunk - 3)-     | otherwise -> Failure e+bytes :: e -> Bytes -> Parser e s ()+bytes e !expected = Parser+  ( \actual@(# _, off, len #) s ->+    let r = if B.isPrefixOf expected (boxBytes actual)+          then let !(I# movement) = length expected in+            (# | (# (), off +# movement, len -# movement #) #)+          else (# e | #)+     in (# s, r #)+  ) --- | Parse four bytes in succession.-ascii4 :: e -> Char -> Char -> Char -> Char -> Parser e s ()--- GHC should decide to inline this after optimization.-ascii4 e !c0 !c1 !c2 !c3 = uneffectful $ \chunk ->-  if | length chunk > 3-     , PM.indexByteArray (array chunk) (offset chunk) == c2w c0-     , PM.indexByteArray (array chunk) (offset chunk + 1) == c2w c1-     , PM.indexByteArray (array chunk) (offset chunk + 2) == c2w c2-     , PM.indexByteArray (array chunk) (offset chunk + 3) == c2w c3-         -> Success () (offset chunk + 4) (length chunk - 4)-     | otherwise -> Failure e+infix 0 <?> --- | Fail with the provided error message.-fail ::-     e -- ^ Error message-  -> Parser e s a-fail e = uneffectful $ \_ -> Failure e+-- | Infix version of 'annotate'.+(<?>) :: Parser x s a -> e -> Parser e s a+(<?>) = annotate --- | Interpret the next byte as an ASCII-encoded character.--- Fails if the byte corresponds to a number above 127.-peekAnyAscii :: e -> Parser e s Char-peekAnyAscii e = uneffectful $ \chunk -> if length chunk > 0-  then-    let w = PM.indexByteArray (array chunk) (offset chunk) :: Word8-     in if w < 128-          then Success-                 (C# (chr# (unI (fromIntegral w))))-                 (offset chunk)-                 (length chunk)-          else Failure e-  else Failure e+-- | Annotate a parser. If the parser fails, the error will+--   be returned.+annotate :: Parser x s a -> e -> Parser e s a+annotate p e = p `orElse` fail e  -- | Consumes and returns the next byte in the input. -- Fails if no characters are left.@@ -285,8 +165,8 @@ any e = uneffectful $ \chunk -> if length chunk > 0   then     let w = PM.indexByteArray (array chunk) (offset chunk) :: Word8-     in Success w (offset chunk + 1) (length chunk - 1)-  else Failure e+     in InternalSuccess w (offset chunk + 1) (length chunk - 1)+  else InternalFailure e  -- Interpret the next byte as an ASCII-encoded character. -- Does not check to see if any characters are left. This@@ -295,91 +175,28 @@ {-# inline anyUnsafe #-} anyUnsafe = uneffectful $ \chunk ->   let w = PM.indexByteArray (array chunk) (offset chunk) :: Word8-   in Success w (offset chunk + 1) (length chunk - 1)---- | Interpret the next byte as an ASCII-encoded character.--- Fails if the byte corresponds to a number above 127.-anyAscii :: e -> Parser e s Char-{-# inline anyAscii #-}-anyAscii e = uneffectful $ \chunk -> if length chunk > 0-  then-    let w = PM.indexByteArray (array chunk) (offset chunk) :: Word8-     in if w < 128-          then Success-                 (C# (chr# (unI (fromIntegral w))))-                 (offset chunk + 1)-                 (length chunk - 1)-          else Failure e-  else Failure e+   in InternalSuccess w (offset chunk + 1) (length chunk - 1) --- | Interpret the next byte as an ASCII-encoded character.--- Fails if the byte corresponds to a number above 127.-anyAscii# :: e -> Parser e s Char#-{-# inline anyAscii# #-}-anyAscii# e = Parser-  (\(# arr, off, len #) s0 -> case len of-    0# -> (# s0, (# e | #) #)-    _ ->-      let !w = indexCharArray# arr off-       in case ord# w <# 128# of-            1# -> (# s0, (# | (# w, off +# 1#, len -# 1# #) #) #)-            _ -> (# s0, (# e | #) #)-  )+-- | Take while the predicate is matched. This is always inlined.+takeWhile :: (Word8 -> Bool) -> Parser e s Bytes+{-# inline takeWhile #-}+takeWhile f = uneffectful $ \chunk -> case B.takeWhile f chunk of+  bs -> InternalSuccess bs (offset chunk + length bs) (length chunk - length bs) --- | Interpret the next one to four bytes as a UTF-8-encoded character.--- Fails if the decoded codepoint is in the range U+D800 through U+DFFF.-anyUtf8# :: e -> Parser e s Char#-{-# noinline anyUtf8# #-}-anyUtf8# e = Parser-  (\(# arr, off, len #) s0 -> case len ># 0# of-    1# ->-      let !w0 = indexWord8Array# arr off-       in if | oneByteChar (W8# w0) -> -                 (# s0, (# | (# chr# (word2Int# w0), off +# 1#, len -# 1# #) #) #)-             | twoByteChar (W8# w0) ->-                 if | I# len > 1-                    , w1 <- indexWord8Array# arr (off +# 1#)-                    , followingByte (W8# w1)-                    , C# c <- codepointFromTwoBytes (W8# w0) (W8# w1)-                      -> (# s0, (# | (# c, off +# 2#, len -# 2# #) #) #)-                    | otherwise -> (# s0, (# e | #) #)-             | threeByteChar (W8# w0) ->-                 if | I# len > 2-                    , w1 <- indexWord8Array# arr (off +# 1# )-                    , w2 <- indexWord8Array# arr (off +# 2# )-                    , followingByte (W8# w1)-                    , !c@(C# c#) <- codepointFromThreeBytes (W8# w0) (W8# w1) (W8# w2)-                    , c < '\xD800' || c > '\xDFFF'-                      -> (# s0, (# | (# c#, off +# 3#, len -# 3# #) #) #)-                    | otherwise -> (# s0, (# e | #) #)-             | fourByteChar (W8# w0) ->-                 if | I# len > 3-                    , w1 <- indexWord8Array# arr (off +# 1# )-                    , w2 <- indexWord8Array# arr (off +# 2# )-                    , w3 <- indexWord8Array# arr (off +# 3# )-                    , followingByte (W8# w1)-                    , !(C# c#) <- codepointFromFourBytes (W8# w0) (W8# w1) (W8# w2) (W8# w3)-                      -> (# s0, (# | (# c#, off +# 4#, len -# 4# #) #) #)-                    | otherwise -> (# s0, (# e | #) #)-             | otherwise -> (# s0, (# e | #) #)-    _ -> (# s0, (# e | #) #)-  )+-- | Take the given number of bytes. Fails if there is not enough+--   remaining input.+take :: e -> Int -> Parser e s Bytes+{-# inline take #-}+take e n = uneffectful $ \chunk -> if n <= B.length chunk+  then case B.unsafeTake n chunk of+    bs -> InternalSuccess bs (offset chunk + n) (length chunk - n)+  else InternalFailure e --- | Interpret the next byte as an ASCII-encoded character.--- Fails if the byte corresponds to a number above 127. Returns--- nothing if the end of the input has been reached.-anyAsciiOpt :: e -> Parser e s (Maybe Char)-{-# inline anyAsciiOpt #-}-anyAsciiOpt e = uneffectful $ \chunk -> if length chunk > 0-  then-    let w = PM.indexByteArray (array chunk) (offset chunk) :: Word8-     in if w < 128-          then Success-                 (Just (C# (chr# (unI (fromIntegral w)))))-                 (offset chunk + 1)-                 (length chunk - 1)-          else Failure e-  else Success Nothing (offset chunk) (length chunk)+-- | Consume all remaining bytes in the input.+remaining :: Parser e s Bytes+{-# inline remaining #-}+remaining = uneffectful $ \chunk ->+  InternalSuccess chunk (offset chunk + length chunk) 0  -- | Skip while the predicate is matched. This is always inlined. skipWhile :: (Word8 -> Bool) -> Parser e s ()@@ -393,345 +210,27 @@         then go         else unconsume 1 --- | Parse exactly four ASCII-encoded characters, interpretting--- them as the hexadecimal encoding of a 32-bit number. Note that--- this rejects a sequence such as @5A9@, requiring @05A9@ instead.--- This is insensitive to case.-hexWord16 :: e -> Parser e s Word16-{-# inline hexWord16 #-}-hexWord16 e = Parser-  (\x s0 -> case runParser (hexWord16# 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-  then-    let !w0@(W# n0) = oneHex $ PM.indexByteArray (array chunk) (offset chunk)-        !w1@(W# n1) = oneHex $ PM.indexByteArray (array chunk) (offset chunk + 1)-        !w2@(W# n2) = oneHex $ PM.indexByteArray (array chunk) (offset chunk + 2)-        !w3@(W# n3) = oneHex $ PM.indexByteArray (array chunk) (offset chunk + 3)-     in if | w0 .|. w1 .|. w2 .|. w3 /= maxBound ->-             (# |-                (# (n0 `timesWord#` 4096##) `plusWord#`-                   (n1 `timesWord#` 256##) `plusWord#`-                   (n2 `timesWord#` 16##) `plusWord#`-                   n3-                ,  unI (offset chunk) +# 4#-                ,  unI (length chunk) -# 4# #) #)-           | otherwise -> (# e | #)-  else (# e | #)----- Returns the maximum machine word if the argument is not--- the ASCII encoding of a hexadecimal digit.-oneHex :: Word8 -> Word-oneHex w-  | w >= 48 && w < 58 = (fromIntegral w - 48)-  | w >= 65 && w < 71 = (fromIntegral w - 55)-  | w >= 97 && w < 103 = (fromIntegral w - 87)-  | otherwise = maxBound---- | Skip ASCII-encoded digits until a non-digit is encountered.-skipDigitsAscii :: Parser e s ()-skipDigitsAscii = uneffectful# $ \c ->-  upcastUnitSuccess (skipDigitsAsciiLoop c)---- | Skip uppercase and lowercase letters until a non-alpha--- character is encountered.-skipDigitsAscii1 :: e -> Parser e s ()-skipDigitsAscii1 e = uneffectful# $ \c ->-  skipDigitsAscii1LoopStart e c---- | Skip uppercase and lowercase letters until a non-alpha--- character is encountered.-skipAlphaAscii :: Parser e s ()-skipAlphaAscii = uneffectful# $ \c ->-  upcastUnitSuccess (skipAlphaAsciiLoop c)---- | Skip uppercase and lowercase letters until a non-alpha--- character is encountered.-skipAlphaAscii1 :: e -> Parser e s ()-skipAlphaAscii1 e = uneffectful# $ \c ->-  skipAlphaAsciiLoop1Start e c---- | Skip the character any number of times. This succeeds--- even if the character was not present.-skipAscii :: Char -> Parser e s ()-skipAscii !w = uneffectful# $ \c ->-  upcastUnitSuccess (skipLoop (c2w w) c)---- | Skip the character any number of times. It must occur--- at least once or else this will fail.-skipAscii1 :: e -> Char -> Parser e s ()-skipAscii1 e !w = uneffectful# $ \c ->-  skipLoop1Start e (c2w w) c--skipDigitsAsciiLoop ::-     Bytes -- Chunk-  -> (# Int#, Int# #)-skipDigitsAsciiLoop !c = if length c > 0-  then-    let w = PM.indexByteArray (array c) (offset c) :: Word8-     in if w >= c2w '0' && w <= c2w '9'-          then skipDigitsAsciiLoop (advance 1 c)-          else (# unI (offset c), unI (length c) #)-  else (# unI (offset c), unI (length c) #)--skipAlphaAsciiLoop ::-     Bytes -- Chunk-  -> (# Int#, Int# #)-skipAlphaAsciiLoop !c = if length c > 0-  then-    let w = PM.indexByteArray (array c) (offset c) :: Word8-     in if (w >= c2w 'a' && w <= c2w 'z') || (w >= c2w 'A' && w <= c2w 'Z')-          then skipAlphaAsciiLoop (advance 1 c)-          else (# unI (offset c), unI (length c) #)-  else (# unI (offset c), unI (length c) #)--skipAlphaAsciiLoop1Start ::-     e-  -> Bytes -- chunk-  -> Result# e ()-skipAlphaAsciiLoop1Start e !c = if length c > 0-  then -    let w = PM.indexByteArray (array c) (offset c) :: Word8-     in if (w >= c2w 'a' && w <= c2w 'z') || (w >= c2w 'A' && w <= c2w 'Z')-          then upcastUnitSuccess (skipAlphaAsciiLoop (advance 1 c))-          else (# e | #)-  else (# e | #)--skipDigitsAscii1LoopStart ::-     e-  -> Bytes -- chunk-  -> Result# e ()-skipDigitsAscii1LoopStart e !c = if length c > 0-  then -    let w = PM.indexByteArray (array c) (offset c) :: Word8-     in if w >= c2w '0' && w <= c2w '9'-          then upcastUnitSuccess (skipDigitsAsciiLoop (advance 1 c))-          else (# e | #)-  else (# e | #)--skipLoop ::-     Word8 -- byte to match-  -> Bytes -- Chunk-  -> (# Int#, Int# #)-skipLoop !w !c = if length c > 0-  then if PM.indexByteArray (array c) (offset c) == w-    then skipLoop w (advance 1 c)-    else (# unI (offset c), unI (length c) #)-  else (# unI (offset c), unI (length c) #)--skipLoop1Start ::-     e-  -> Word8 -- byte to match-  -> Bytes -- chunk-  -> Result# e ()-skipLoop1Start e !w !chunk0 = if length chunk0 > 0-  then if PM.indexByteArray (array chunk0) (offset chunk0) == w-    then upcastUnitSuccess (skipLoop w (advance 1 chunk0))-    else (# e | #)-  else (# e | #)---- | Skip bytes until the character from the ASCII plane is encountered.--- This does not ensure that the skipped bytes were ASCII-encoded--- characters.-skipUntilAsciiConsume :: e -> Char -> Parser e s ()-skipUntilAsciiConsume e !w = uneffectful# $ \c ->-  skipUntilConsumeLoop e (c2w w) c--skipUntilConsumeLoop ::-     e -- Error message-  -> Word8 -- byte to match-  -> Bytes -- Chunk-  -> Result# e ()-skipUntilConsumeLoop e !w !c = if length c > 0-  then if PM.indexByteArray (array c) (offset c) /= w-    then skipUntilConsumeLoop e w (advance 1 c)-    else (# | (# (), unI (offset c + 1), unI (length c - 1) #) #)-  else (# e | #)- -- | Fails if there is still more input remaining. endOfInput :: e -> Parser e s () -- GHC should decide to inline this after optimization. endOfInput e = uneffectful $ \chunk -> if length chunk == 0-  then Success () (offset chunk) 0-  else Failure e+  then InternalSuccess () (offset chunk) 0+  else InternalFailure e  -- | Returns true if there are no more bytes in the input. Returns -- false otherwise. Always succeeds. isEndOfInput :: Parser e s Bool -- GHC should decide to inline this after optimization. isEndOfInput = uneffectful $ \chunk ->-  Success (length chunk == 0) (offset chunk) (length chunk)---- | Parse a decimal-encoded 8-bit word. If the number is larger--- than 255, this parser fails.-decWord8 :: e -> Parser e s Word8-decWord8 e = Parser-  (\chunk0 s0 -> case decSmallWordStart e 256 (boxBytes chunk0) s0 of-    (# s1, r #) -> (# s1, upcastWord8Result r #)-  )---- | Parse a decimal-encoded 16-bit word. If the number is larger--- than 65535, this parser fails.-decWord16 :: e -> Parser e s Word16-decWord16 e = Parser-  (\chunk0 s0 -> case decSmallWordStart e 65536 (boxBytes chunk0) s0 of-    (# s1, r #) -> (# s1, upcastWord16Result r #)-  )---- | Parse a decimal-encoded 32-bit word. If the number is larger--- than 4294967295, this parser fails.-decWord32 :: e -> Parser e s Word32--- This will not work on 32-bit platforms.-decWord32 e = Parser-  (\chunk0 s0 -> case decSmallWordStart e 4294967296 (boxBytes chunk0) s0 of-    (# s1, r #) -> (# s1, upcastWord32Result r #)-  )---- | Parse a decimal-encoded number. If the number is too large to be--- represented by a machine word, this overflows rather than failing.--- This may be changed in a future release.-decWord :: e -> Parser e s Word-decWord e = Parser-  (\chunk0 s0 -> case decWordStart e (boxBytes chunk0) s0 of-    (# s1, r #) -> (# s1, upcastWordResult r #)-  )---- | Parse a decimal-encoded positive integer of arbitrary--- size. Note: this is not implemented efficiently. This--- pulls in one digit at a time, multiplying the accumulator--- by ten each time and adding the new digit. Since--- arithmetic involving arbitrary-precision integers is--- somewhat expensive, it would be better to pull in several--- digits at a time, convert those to a machine-sized integer,--- then upcast and perform the multiplication and addition.-decPositiveInteger :: e -> Parser e s Integer-decPositiveInteger e = Parser-  (\chunk0 s0 -> decPositiveIntegerStart e (boxBytes chunk0) s0)--decWordStart ::-     e -- Error message-  -> Bytes -- Chunk-  -> ST# s (Result# e Word# )-decWordStart e !chunk0 s0 = if length chunk0 > 0-  then-    let !w = fromIntegral @Word8 @Word-          (PM.indexByteArray (array chunk0) (offset chunk0)) - 48-     in if w < 10-          then (# s0, decWordMore e w (advance 1 chunk0) #)-          else (# s0, (# e | #) #)-  else (# s0, (# e | #) #)---- No limit on length for integers.-decPositiveIntegerStart ::-     e-  -> Bytes-  -> ST# s (Result# e Integer)-decPositiveIntegerStart e !chunk0 s0 = if length chunk0 > 0-  then-    let !w = (PM.indexByteArray (array chunk0) (offset chunk0)) - 48-     in if w < (10 :: Word8)-          then (# s0, decIntegerMore e (fromIntegral w) (advance 1 chunk0) #)-          else (# s0, (# e | #) #)-  else (# s0, (# e | #) #)--decSmallWordStart ::-     e -- Error message-  -> Word -- Upper Bound-  -> Bytes -- Chunk-  -> ST# s (Result# e Word# )-decSmallWordStart e !limit !chunk0 s0 = if length chunk0 > 0-  then-    let !w = fromIntegral @Word8 @Word-          (PM.indexByteArray (array chunk0) (offset chunk0)) - 48-     in if w < 10-          then (# s0, decSmallWordMore e w limit (advance 1 chunk0) #)-          else (# s0, (# e | #) #)-  else (# s0, (# e | #) #)---- This will not inline since it is recursive, but worker--- wrapper will still happen.-decWordMore ::-     e -- Error message-  -> Word -- Accumulator-  -> Bytes -- Chunk-  -> Result# e Word#-decWordMore e !acc !chunk0 = if length chunk0 > 0-  then-    let !w = fromIntegral @Word8 @Word-          (PM.indexByteArray (array chunk0) (offset chunk0)) - 48-     in if w < 10-          then decWordMore e (acc * 10 + w)-                 (advance 1 chunk0)-          else (# | (# unW acc, unI (offset chunk0), unI (length chunk0)  #) #)-  else (# | (# unW acc, unI (offset chunk0), 0# #) #)--decSmallWordMore ::-     e -- Error message-  -> Word -- Accumulator-  -> Word -- Upper Bound-  -> Bytes -- Chunk-  -> Result# e Word#-decSmallWordMore e !acc !limit !chunk0 = if length chunk0 > 0-  then-    let !w = fromIntegral @Word8 @Word-          (PM.indexByteArray (array chunk0) (offset chunk0)) - 48-     in if w < 10-          then-            let w' = acc * 10 + w-             in if w' < limit-                  then decSmallWordMore e w' limit (advance 1 chunk0)-                  else (# e | #)-          else (# | (# unW acc, unI (offset chunk0), unI (length chunk0)  #) #)-  else (# | (# unW acc, unI (offset chunk0), 0# #) #)--decIntegerMore ::-     e -- Error message-  -> Integer -- Accumulator-  -> Bytes -- Chunk-  -> Result# e Integer-decIntegerMore e !acc !chunk0 = if length chunk0 > 0-  then-    let w :: Word8-        !w = (PM.indexByteArray (array chunk0) (offset chunk0)) - 48-     in if w < 10-          then-            let w' = acc * 10 + fromIntegral w-             in decIntegerMore e w' (advance 1 chunk0)-          else (# | (# acc, unI (offset chunk0), unI (length chunk0) #) #)-  else (# | (# acc, unI (offset chunk0), 0# #) #)--advance :: Int -> Bytes -> Bytes-advance n (Bytes arr off len) = Bytes arr (off + n) (len - n)--unW :: Word -> Word#-unW (W# w) = w--unI :: Int -> Int#-unI (I# w) = w--boxBytes :: Bytes# -> Bytes-boxBytes (# a, b, c #) = Bytes (ByteArray a) (I# b) (I# c)--unboxBytes :: Bytes -> Bytes#-unboxBytes (Bytes (ByteArray a) (I# b) (I# c)) = (# a,b,c #)--unboxResult :: Result e a -> Result# e a-unboxResult (Success a (I# b) (I# c)) = (# | (# a, b, c #) #)-unboxResult (Failure e) = (# e | #)+  InternalSuccess (length chunk == 0) (offset chunk) (length chunk) -boxResult :: Result# e a -> Result e a-boxResult (# | (# a, b, c #) #) = Success a (I# b) (I# c)-boxResult (# e | #) = Failure e+boxPublicResult :: Result# e a -> Result e a+boxPublicResult (# | (# a, _, c #) #) = Success a (I# c)+boxPublicResult (# e | #) = Failure e  -- | Convert a 'Word32' parser to a 'Word#' parser.-unboxWord32 :: Parser s e Word32 -> Parser s e Word#+unboxWord32 :: Parser e s Word32 -> Parser e s Word# unboxWord32 (Parser f) = Parser   (\x s0 -> case f x s0 of     (# s1, r #) -> case r of@@ -739,9 +238,18 @@       (# | (# W32# a, b, c #) #) -> (# s1, (# | (# a, b, c #) #) #)   ) +-- | Convert a @(Int,Int)@ parser to a @(# Int#, Int# #)@ parser.+unboxIntPair :: Parser e s (Int,Int) -> Parser e s (# Int#, Int# #)+unboxIntPair (Parser f) = Parser+  (\x s0 -> case f x s0 of+    (# s1, r #) -> case r of+      (# e | #) -> (# s1, (# e | #) #)+      (# | (# (I# y, I# z), b, c #) #) -> (# s1, (# | (# (# y, z #), b, c #) #) #)+  )+ -- | Convert a 'Word#' parser to a 'Word32' parser. Precondition: -- the argument parser only returns words less than 4294967296.-boxWord32 :: Parser s e Word# -> Parser s e Word32+boxWord32 :: Parser e s Word# -> Parser e s Word32 boxWord32 (Parser f) = Parser   (\x s0 -> case f x s0 of     (# s1, r #) -> case r of@@ -749,13 +257,26 @@       (# | (# a, b, c #) #) -> (# s1, (# | (# W32# a, b, c #) #) #)   ) --- | There is a law-abiding instance of @Alternative@ for 'Parser'.+-- | Convert a @(# Int#, Int# #)@ parser to a @(Int,Int)@ parser.+boxIntPair :: Parser e s (# Int#, Int# #) -> Parser e s (Int,Int)+boxIntPair (Parser f) = Parser+  (\x s0 -> case f x s0 of+    (# s1, r #) -> case r of+      (# e | #) -> (# s1, (# e | #) #)+      (# | (# (# y, z #), b, c #) #) -> (# s1, (# | (# (I# y, I# z), b, c #) #) #)+  )+++-- | There is a law-abiding instance of 'Alternative' for 'Parser'. -- However, it is not terribly useful since error messages seldom--- have a 'Monoid' instance. This function is a right-biased--- variant of @\<|\>@. Consequently, it lacks an identity.--- See <https://github.com/bos/attoparsec/issues/122 attoparsec #122>+-- have a 'Monoid' instance. This function is a variant of @\<|\>@+-- that is right-biased in its treatment of error messages.+-- Consequently, @orElse@ lacks an identity.+-- See <https://github.com/bos/attoparsec/issues/122 attoparsec issue #122> -- for more discussion of this topic.-orElse :: Parser s e a -> Parser s e a -> Parser s e a+infixl 3 `orElse`+orElse :: Parser x s a -> Parser e s a -> Parser e s a+{-# inline orElse #-} orElse (Parser f) (Parser g) = Parser   (\x s0 -> case f x s0 of     (# s1, r0 #) -> case r0 of@@ -763,68 +284,75 @@       (# | r #) -> (# s1, (# | r #) #)   ) -codepointFromFourBytes :: Word8 -> Word8 -> Word8 -> Word8 -> Char-codepointFromFourBytes w1 w2 w3 w4 = C#-  ( chr#-    ( unI $ fromIntegral-      ( unsafeShiftL (word8ToWord w1 .&. 0b00001111) 18 .|. -        unsafeShiftL (word8ToWord w2 .&. 0b00111111) 12 .|. -        unsafeShiftL (word8ToWord w3 .&. 0b00111111) 6 .|. -        (word8ToWord w4 .&. 0b00111111)-      )-    )+bindFromCharToLifted :: Parser s e Char# -> (Char# -> Parser s e a) -> Parser s e a+{-# inline bindFromCharToLifted #-}+bindFromCharToLifted (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   ) -codepointFromThreeBytes :: Word8 -> Word8 -> Word8 -> Char-codepointFromThreeBytes w1 w2 w3 = C#-  ( chr#-    ( unI $ fromIntegral-      ( unsafeShiftL (word8ToWord w1 .&. 0b00001111) 12 .|. -        unsafeShiftL (word8ToWord w2 .&. 0b00111111) 6 .|. -        (word8ToWord w3 .&. 0b00111111)-      )-    )+bindFromCharToIntPair :: Parser s e Char# -> (Char# -> Parser s e (# Int#, Int# #)) -> Parser s e (# Int#, Int# #)+{-# inline bindFromCharToIntPair #-}+bindFromCharToIntPair (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   ) -codepointFromTwoBytes :: Word8 -> Word8 -> Char-codepointFromTwoBytes w1 w2 = C#-  ( chr#-    ( unI $ fromIntegral @Word @Int-      ( unsafeShiftL (word8ToWord w1 .&. 0b00011111) 6 .|. -        (word8ToWord w2 .&. 0b00111111)-      )-    )+bindFromLiftedToInt :: Parser s e a -> (a -> Parser s e Int#) -> Parser s e Int#+{-# inline bindFromLiftedToInt #-}+bindFromLiftedToInt (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   ) -oneByteChar :: Word8 -> Bool-oneByteChar !w = w .&. 0b10000000 == 0--twoByteChar :: Word8 -> Bool-twoByteChar !w = w .&. 0b11100000 == 0b11000000--threeByteChar :: Word8 -> Bool-threeByteChar !w = w .&. 0b11110000 == 0b11100000--fourByteChar :: Word8 -> Bool-fourByteChar !w = w .&. 0b11111000 == 0b11110000--word8ToWord :: Word8 -> Word-word8ToWord = fromIntegral+bindFromLiftedToIntPair :: Parser s e a -> (a -> Parser s e (# Int#, Int# #)) -> Parser s e (# Int#, Int# #)+{-# inline bindFromLiftedToIntPair #-}+bindFromLiftedToIntPair (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+  ) -followingByte :: Word8 -> Bool-followingByte !w = xor w 0b01000000 .&. 0b11000000 == 0b11000000+bindFromIntToIntPair :: Parser s e Int# -> (Int# -> Parser s e (# Int#, Int# #)) -> Parser s e (# Int#, Int# #)+{-# inline bindFromIntToIntPair #-}+bindFromIntToIntPair (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+  ) -{- $bind-Sometimes, GHC ends up building join points in a way that-boxes arguments unnecessarily. In this situation, special variants-of monadic @>>=@ can be helpful. If @C#@, @I#@, etc. never-get used in you original source code, GHC cannot introduce them.--}+bindFromMaybeCharToIntPair ::+     Parser s e (# (# #) | Char# #)+  -> ((# (# #) | Char# #) -> Parser s e (# Int#, Int# #))+  -> Parser s e (# Int#, Int# #)+{-# inline bindFromMaybeCharToIntPair #-}+bindFromMaybeCharToIntPair (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+  ) --- | Specialization of monadic bind for parsers that return 'Char#'.-bindChar :: Parser s e Char# -> (Char# -> Parser s e a) -> Parser s e a-{-# inline bindChar #-}-bindChar (Parser f) g = Parser+bindFromMaybeCharToLifted ::+     Parser s e (# (# #) | Char# #)+  -> ((# (# #) | Char# #) -> Parser s e a)+  -> Parser s e a+{-# inline bindFromMaybeCharToLifted #-}+bindFromMaybeCharToLifted (Parser f) g = Parser   (\x@(# arr, _, _ #) s0 -> case f x s0 of     (# s1, r0 #) -> case r0 of       (# e | #) -> (# s1, (# e | #) #)@@ -832,3 +360,73 @@         runParser (g y) (# arr, b, c #) s1   ) +pureIntPair ::+     (# Int#, Int# #)+  -> Parser s e (# Int#, Int# #)+{-# inline pureIntPair #-}+pureIntPair a = Parser+  (\(# _, b, c #) s -> (# s, (# | (# a, b, c #) #) #))++failIntPair :: e -> Parser e s (# Int#, Int# #)+{-# inline failIntPair #-}+failIntPair e = Parser+  (\(# _, _, _ #) s -> (# s, (# e | #) #))++-- | Augment a parser with the number of bytes that were consume while+-- it executed.+measure :: Parser e s a -> Parser e s (Int,a)+{-# inline measure #-}+measure (Parser f) = Parser+  (\x@(# _, pre, _ #) s0 -> case f x s0 of+    (# s1, r #) -> case r of+      (# e | #) -> (# s1, (# e | #) #)+      (# | (# y, post, c #) #) -> (# s1, (# | (# (I# (post -# pre), y),post,c #) #) #)+  )++-- | 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.+-- The pattern of prefixing an encoding with its length is common.+-- This is discussed more in+-- <https://github.com/bos/attoparsec/issues/129 attoparsec issue #129>.+--+-- > delimit e1 e2 n remaining === take e1 n+delimit ::+     e -- ^ Error message when not enough bytes are present+  -> e -- ^ Error message when delimited parser does not consume all input+  -> Int -- ^ Exact number of bytes delimited parser is expected to consume+  -> Parser e s a -- ^ Parser to execute in delimited context+  -> Parser e s a+delimit esz eleftovers (I# n) (Parser f) = Parser+  ( \(# arr, off, len #) s0 -> case len >=# n of+    1# -> case f (# arr, off, n #) s0 of+      (# s1, r #) -> case r of+        (# e | #) -> (# s1, (# e | #) #)+        (# | (# a, newOff, leftovers #) #) -> case leftovers of+          0# -> (# s1, (# | (# a, newOff, len -# n #) #) #)+          _ -> (# s1, (# eleftovers | #) #)+    _ -> (# s0, (# esz | #) #)+  )++-- | Replicate a parser @n@ times, writing the results into+-- an array of length @n@. For @Array@ and @SmallArray@, this+-- is lazy in the elements, so be sure the they result of the+-- parser is evaluated appropriately to avoid unwanted thunks.+replicate :: forall arr e s a. (Contiguous arr, Element arr a)+  => Int -- ^ Number of times to run the parser+  -> Parser e s a -- ^ Parser+  -> Parser e s (arr a)+{-# inline replicate #-}+replicate !len p = do+  marr <- effect (C.new len)+  let go :: Int -> Parser e s (arr a)+      go !ix = if ix < len+        then do+          a <- p+          effect (C.write marr ix a)+          go (ix + 1)+        else effect (C.unsafeFreeze marr)+  go 0

@@ -0,0 +1,195 @@+{-# 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 #-}++-- | Parse input as ASCII-encoded text. Some parsers in this module,+-- like 'any' and 'peek', fail if they encounter a byte above @0x7F@.+-- Others, like numeric parsers and skipping parsers, leave the cursor+-- at the position of the offending byte without failing.+module Data.Bytes.Parser.Ascii+  ( -- * Matching+    Latin.char+  , Latin.char2+  , Latin.char3+  , Latin.char4+    -- * Get Character+  , any+  , any#+  , peek+  , opt+    -- * Match Many+  , shortTrailedBy+    -- * Skip+  , Latin.skipDigits+  , Latin.skipDigits1+  , Latin.skipChar+  , Latin.skipChar1+  , skipAlpha+  , skipAlpha1+  , skipTrailedBy+    -- * Numbers+  , Latin.decWord+  , Latin.decWord8+  , Latin.decWord16+  , Latin.decWord32+  ) where++import Prelude hiding (length,any,fail,takeWhile)++import Data.Bytes.Types (Bytes(..))+import Data.Bytes.Parser.Internal (Parser(..),uneffectful,Result#,uneffectful#)+import Data.Bytes.Parser.Internal (InternalResult(..),indexLatinCharArray,upcastUnitSuccess)+import Data.Word (Word8)+import Data.Text.Short (ShortText)+import Control.Monad.ST.Run (runByteArrayST)+import GHC.Exts (Int(I#),Char(C#),Int#,Char#,(-#),(+#),(<#),ord#,indexCharArray#,chr#)++import qualified Data.ByteString.Short.Internal as BSS+import qualified Data.Text.Short.Unsafe as TS+import qualified Data.Bytes as Bytes+import qualified Data.Bytes.Parser.Latin as Latin+import qualified Data.Bytes.Parser.Unsafe as Unsafe+import qualified Data.Primitive as PM++-- | Consume input until the trailer is found. Then, consume+-- the trailer as well. This fails if the trailer is not+-- found or if any non-ASCII characters are encountered.+skipTrailedBy :: e -> Char -> Parser e s ()+skipTrailedBy e !c = do+  let go = do+        !d <- any e+        if d == c+          then pure ()+          else go+  go++-- | 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+-- encounters any bytes above @0x7F@.+shortTrailedBy :: e -> Char -> Parser e s ShortText+shortTrailedBy e !c = do+  !start <- Unsafe.cursor+  skipTrailedBy e c+  end <- Unsafe.cursor+  src <- Unsafe.expose+  let len = end - start - 1+      !r = runByteArrayST $ do+        marr <- PM.newByteArray len+        PM.copyByteArray marr 0 src start len+        PM.unsafeFreezeByteArray marr+  pure+    $ TS.fromShortByteStringUnsafe+    $ byteArrayToShortByteString+    $ r+++-- | Consumes and returns the next character in the input.+any :: e -> Parser e s Char+any e = uneffectful $ \chunk -> if length chunk > 0+  then+    let c = indexLatinCharArray (array chunk) (offset chunk)+     in if c < '\128'+          then InternalSuccess c (offset chunk + 1) (length chunk - 1)+          else InternalFailure e+  else InternalFailure e++-- | Variant of 'any' with unboxed result.+any# :: e -> Parser e s Char#+{-# inline any# #-}+any# e = Parser+  (\(# arr, off, len #) s0 -> case len of+    0# -> (# s0, (# e | #) #)+    _ ->+      let !w = indexCharArray# arr off+       in case ord# w <# 128# of+            1# -> (# s0, (# | (# w, off +# 1#, len -# 1# #) #) #)+            _ -> (# s0, (# e | #) #)+  )++unI :: Int -> Int#+unI (I# w) = w++-- | Examine the next byte without consuming it, interpret it as an+-- ASCII-encoded character. This fails if the byte is above @0x7F@ or+-- if the end of input has been reached.+peek :: e -> Parser e s Char+peek e = uneffectful $ \chunk -> if length chunk > 0+  then+    let w = PM.indexByteArray (array chunk) (offset chunk) :: Word8+     in if w < 128+          then InternalSuccess+                 (C# (chr# (unI (fromIntegral w))))+                 (offset chunk)+                 (length chunk)+          else InternalFailure e+  else InternalFailure e++-- | Consume the next byte, interpreting it as an ASCII-encoded character.+-- Fails if the byte is above @0x7F@. Returns @Nothing@ if the+-- end of the input has been reached.+opt :: e -> Parser e s (Maybe Char)+{-# inline opt #-}+opt e = uneffectful $ \chunk -> if length chunk > 0+  then+    let w = PM.indexByteArray (array chunk) (offset chunk) :: Word8+     in if w < 128+          then InternalSuccess+                 (Just (C# (chr# (unI (fromIntegral w)))))+                 (offset chunk + 1)+                 (length chunk - 1)+          else InternalFailure e+  else InternalSuccess Nothing (offset chunk) (length chunk)++-- | Skip uppercase and lowercase letters until a non-alpha+-- character is encountered.+skipAlpha :: Parser e s ()+skipAlpha = uneffectful# $ \c ->+  upcastUnitSuccess (skipAlphaAsciiLoop c)++-- | Skip uppercase and lowercase letters until a non-alpha+-- character is encountered.+skipAlpha1 :: e -> Parser e s ()+skipAlpha1 e = uneffectful# $ \c ->+  skipAlphaAsciiLoop1Start e c++skipAlphaAsciiLoop ::+     Bytes -- Chunk+  -> (# Int#, Int# #)+skipAlphaAsciiLoop !c = if length c > 0+  then+    let w = indexLatinCharArray (array c) (offset c)+     in if (w >= 'a' && w <= 'z') || (w >= 'A' && w <= 'Z')+          then skipAlphaAsciiLoop (Bytes.unsafeDrop 1 c)+          else (# unI (offset c), unI (length c) #)+  else (# unI (offset c), unI (length c) #)++skipAlphaAsciiLoop1Start ::+     e+  -> Bytes -- chunk+  -> Result# e ()+skipAlphaAsciiLoop1Start e !c = if length c > 0+  then +    let w = indexLatinCharArray (array c) (offset c)+     in if (w >= 'a' && w <= 'z') || (w >= 'A' && w <= 'Z')+          then upcastUnitSuccess (skipAlphaAsciiLoop (Bytes.unsafeDrop 1 c))+          else (# e | #)+  else (# e | #)++byteArrayToShortByteString :: PM.ByteArray -> BSS.ShortByteString+byteArrayToShortByteString (PM.ByteArray x) = BSS.SBS x+

@@ -0,0 +1,118 @@+{-# 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 #-}++-- | Big-endian fixed-width numbers.+module Data.Bytes.Parser.BigEndian+  ( -- * Unsigned+    word8+  , word16+  , word32+  , word64+    -- * Signed+  , int8+  , int16+  , int32+  , int64+  ) where++import Prelude hiding (length,any,fail,takeWhile)++import Data.Bits ((.|.),unsafeShiftL)+import Data.Bytes.Types (Bytes(..))+import Data.Bytes.Parser.Internal (Parser,uneffectful)+import Data.Bytes.Parser.Internal (InternalResult(..))+import Data.Word (Word8,Word16,Word32,Word64)+import Data.Int (Int8,Int16,Int32,Int64)++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++-- | 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 wa) 8 .|. fromIntegral wb))+          (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 wa) 24 .|.+              unsafeShiftL (fromIntegral wb) 16 .|.+              unsafeShiftL (fromIntegral wc) 8 .|.+              fromIntegral wd+            )+          )+          (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 wa) 56 .|.+            unsafeShiftL (fromIntegral wb) 48 .|.+            unsafeShiftL (fromIntegral wc) 40 .|.+            unsafeShiftL (fromIntegral wd) 32 .|.+            unsafeShiftL (fromIntegral we) 24 .|.+            unsafeShiftL (fromIntegral wf) 16 .|.+            unsafeShiftL (fromIntegral wg) 8 .|.+            fromIntegral wh+          )+          (offset chunk + 8) (length chunk - 8)+  else InternalFailure 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

@@ -0,0 +1,148 @@+{-# 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 #-}++module Data.Bytes.Parser.Internal+  ( Parser(..)+  , InternalResult(..)+  , Bytes#+  , ST#+  , Result#+  , uneffectful+  , uneffectful#+  , boxBytes+  , unboxBytes+  , unboxResult+  , fail+  , indexLatinCharArray+  , upcastUnitSuccess+  ) where++import Prelude hiding (length,any,fail,takeWhile)++import Control.Applicative (Alternative)+import Data.Primitive (ByteArray(ByteArray))+import Data.Bytes.Types (Bytes(Bytes))+import Data.Kind (Type)+import GHC.Exts (TYPE,RuntimeRep,Int(I#),Int#,State#,ByteArray#,Char(C#))++import qualified Control.Applicative+import qualified Control.Monad+import qualified GHC.Exts as Exts++-- | A non-resumable parser.+newtype Parser :: forall (r :: RuntimeRep). Type -> Type -> TYPE r -> Type where+  Parser :: forall (r :: RuntimeRep) (e :: Type) (s :: Type) (a :: TYPE r).+    { runParser :: (# ByteArray#, Int#, Int# #) -> ST# s (Result# e a) } -> Parser e s a++-- The result of running a parser. Used internally.+data InternalResult e a+  = InternalFailure e+    -- An error message indicating what went wrong.+  | InternalSuccess !a !Int !Int+    -- The parsed value, the offset after the last consumed byte, and the+    -- number of bytes remaining in parsed slice.++uneffectful :: (Bytes -> InternalResult e a) -> Parser e s a+{-# inline uneffectful #-}+uneffectful f = Parser+  ( \b s0 -> (# s0, unboxResult (f (boxBytes b)) #) )++boxBytes :: Bytes# -> Bytes+{-# inline boxBytes #-}+boxBytes (# a, b, c #) = Bytes (ByteArray a) (I# b) (I# c)++unboxBytes :: Bytes -> Bytes#+{-# inline unboxBytes #-}+unboxBytes (Bytes (ByteArray a) (I# b) (I# c)) = (# a,b,c #)++type Bytes# = (# ByteArray#, Int#, Int# #)+type ST# s (a :: TYPE r) = State# s -> (# State# s, a #)+type Result# e (a :: TYPE r) =+  (# e+  | (# a, Int#, Int# #) #) -- ints are offset and length++unboxResult :: InternalResult e a -> Result# e a+unboxResult (InternalSuccess a (I# b) (I# c)) = (# | (# a, b, c #) #)+unboxResult (InternalFailure e) = (# e | #)++-- | Combines the error messages using '<>' when both+-- parsers fail.+instance Monoid e => Alternative (Parser e s) where+  {-# inline empty #-}+  {-# inline (<|>) #-}+  empty = fail mempty+  Parser f <|> Parser g = Parser+    (\x s0 -> case f x s0 of+      (# s1, r0 #) -> case r0 of+        (# eRight | #) -> case g x s1 of+          (# s2, r1 #) -> case r1 of+            (# eLeft | #) -> (# s2, (# eRight <> eLeft | #) #)+            (# | r #) -> (# s2, (# | r #) #)+        (# | r #) -> (# s1, (# | r #) #)+    )++-- | Fail with the provided error message.+fail ::+     e -- ^ Error message+  -> Parser e s a+fail e = uneffectful $ \_ -> InternalFailure e++instance Applicative (Parser e s) where+  pure = pureParser+  (<*>) = Control.Monad.ap++pureParser :: a -> Parser e s a+pureParser a = Parser+  (\(# _, b, c #) s -> (# s, (# | (# a, b, c #) #) #))+++instance Monad (Parser e s) where+  {-# inline return #-}+  {-# inline (>>=) #-}+  return = pureParser+  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+    )++instance Functor (Parser e s) where+  {-# inline fmap #-}+  fmap f (Parser g) = Parser+    (\x s0 -> case g x s0 of+      (# s1, r #) -> case r of+        (# e | #) -> (# s1, (# e | #) #)+        (# | (# a, b, c #) #) -> (# s1, (# | (# f a, b, c #) #) #)+    )++indexLatinCharArray :: ByteArray -> Int -> Char+{-# inline indexLatinCharArray #-}+indexLatinCharArray (ByteArray arr) (I# off) =+  C# (Exts.indexCharArray# arr off)++uneffectful# :: (Bytes -> Result# e a) -> Parser e s a+{-# inline uneffectful# #-}+uneffectful# f = Parser+  ( \b s0 -> (# s0, (f (boxBytes b)) #) )++upcastUnitSuccess :: (# Int#, Int# #) -> Result# e ()+{-# inline upcastUnitSuccess #-}+upcastUnitSuccess (# b, c #) = (# | (# (), b, c #) #)+

@@ -0,0 +1,726 @@+{-# 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 #-}++-- | Parse input as though it were text encoded by+-- ISO 8859-1 (Latin-1). All byte sequences are valid+-- text under ISO 8859-1.+module Data.Bytes.Parser.Latin+  ( -- * Matching+    -- ** Required+    char+  , char2+  , char3+  , char4+    -- ** Try+  , trySatisfy+  , trySatisfyThen+    -- * Get Character+  , any+  , opt+  , opt#+    -- * Skip+  , skipDigits+  , skipDigits1+  , skipChar+  , skipChar1+  , skipTrailedBy+    -- * Numbers+    -- ** Decimal+    -- *** Unsigned+  , decWord+  , decWord8+  , decWord16+  , decWord32+    -- *** Signed+  , decUnsignedInt+  , decUnsignedInt#+  , decSignedInt+  , decStandardInt+  , decTrailingInt+  , decTrailingInt#+  , decSignedInteger+  , decUnsignedInteger+  , decTrailingInteger+    -- ** Hexadecimal+  , hexWord16+  ) where++import Prelude hiding (length,any,fail,takeWhile)++import Data.Bits ((.|.))+import Data.Bytes.Types (Bytes(..))+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.Word (Word8)+import Data.Char (ord)+import Data.Kind (Type)+import GHC.Exts (Int(I#),Char(C#),Word#,Int#,Char#,(+#),(-#),indexCharArray#)+import GHC.Exts (TYPE,RuntimeRep)+import GHC.Word (Word(W#),Word8(W8#),Word16(W16#),Word32(W32#))++import qualified GHC.Exts as Exts+import qualified Data.Bytes as Bytes+import qualified Data.Primitive as PM++-- | Runs the predicate on the next character in the input. If the+-- predicate is matched, this consumes the character. Otherwise,+-- the character is not consumed. This returns @False@ if the end+-- of the input has been reached. This never fails.+trySatisfy :: (Char -> Bool) -> Parser e s Bool+trySatisfy f = uneffectful $ \chunk -> case length chunk of+  0 -> InternalSuccess False (offset chunk) (length chunk)+  _ -> case f (indexLatinCharArray (array chunk) (offset chunk)) of+    True -> InternalSuccess True (offset chunk + 1) (length chunk - 1)+    False -> InternalSuccess False (offset chunk) (length chunk)++-- | Runs the function on the next character in the input. If the+-- function returns @Just@, this consumes the character and then+-- runs the parser on the remaining input. If the function returns+-- @Nothing@, this does not consume the tested character, and it+-- runs the default parser on the input (which includes the tested+-- character). If there is no input remaining, this also runs the+-- default parser. This combinator never fails.+trySatisfyThen :: forall (r :: RuntimeRep) (e :: Type) (s :: Type) (a :: TYPE r).+     Parser e s a -- ^ Default parser. Runs on @Nothing@ or end of input.+  -> (Char -> Maybe (Parser e s a)) -- ^ Parser-selecting predicate+  -> Parser e s a+{-# inline trySatisfyThen #-}+trySatisfyThen (Parser g) f = Parser+  (\input@(# arr,off0,len0 #) s0 -> case len0 of+    0# -> g input s0+    _ -> case f (C# (indexCharArray# arr off0)) of+      Nothing -> g input s0+      Just (Parser p) -> p (# arr, off0 +# 1#, len0 -# 1# #) s0+  )++-- | Consume the next character, failing if it does not+-- match the expected value or if there is no more input.+char :: e -> Char -> Parser e s ()+-- GHC should decide to inline this after optimization.+char e !c = uneffectful $ \chunk -> if length chunk > 0+  then if indexLatinCharArray (array chunk) (offset chunk) == c+    then InternalSuccess () (offset chunk + 1) (length chunk - 1)+    else InternalFailure e+  else InternalFailure e++-- | Consume the next two characters, failing if they do+-- not match they expected values.+--+-- > char2 e a b === char e a *> char e b+char2 :: e -> Char -> Char -> Parser e s ()+-- GHC should decide to inline this after optimization.+char2 e !c0 !c1 = uneffectful $ \chunk ->+  if | length chunk > 1+     , indexLatinCharArray (array chunk) (offset chunk) == c0+     , indexLatinCharArray (array chunk) (offset chunk + 1) == c1+         -> InternalSuccess () (offset chunk + 2) (length chunk - 2)+     | otherwise -> InternalFailure e++-- | Consume the three characters, failing if they do+-- not match they expected values.+--+-- > char3 e a b c === char e a *> char e b *> char e c+char3 :: e -> Char -> Char -> Char -> Parser e s ()+-- GHC should decide to inline this after optimization.+char3 e !c0 !c1 !c2 = uneffectful $ \chunk ->+  if | length chunk > 2+     , indexLatinCharArray (array chunk) (offset chunk) == c0+     , indexLatinCharArray (array chunk) (offset chunk + 1) == c1+     , indexLatinCharArray (array chunk) (offset chunk + 2) == c2+         -> InternalSuccess () (offset chunk + 3) (length chunk - 3)+     | otherwise -> InternalFailure e++-- | Consume the four characters, failing if they do+-- not match they 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 ()+-- GHC should decide to inline this after optimization.+char4 e !c0 !c1 !c2 !c3 = uneffectful $ \chunk ->+  if | length chunk > 3+     , 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+         -> InternalSuccess () (offset chunk + 4) (length chunk - 4)+     | 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+  then+    let c = indexLatinCharArray (array chunk) (offset chunk)+     in InternalSuccess c (offset chunk + 1) (length chunk - 1)+  else InternalFailure e++-- | 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)+opt = uneffectful $ \chunk -> case length chunk of+  0 -> InternalSuccess Nothing (offset chunk) (length chunk)+  _ -> InternalSuccess+    (Just (indexLatinCharArray (array chunk) (offset chunk)))+    (offset chunk + 1) (length chunk - 1)++-- | Variant of @opt@ with unboxed result.+opt# :: Parser e s (# (# #) | Char# #)+{-# inline opt# #-}+opt# = Parser+  (\(# arr, off, len #) s0 -> case len of+    0# -> (# s0, (# | (# (# (# #) | #), off, len #) #) #)+    _ -> (# s0, (# | (# (# | indexCharArray# arr off #), off +# 1#, len -# 1# #) #) #)+  )++skipDigitsAsciiLoop ::+     Bytes -- Chunk+  -> (# Int#, Int# #)+skipDigitsAsciiLoop !c = if length c > 0+  then+    let w = indexLatinCharArray (array c) (offset c)+     in if w >= '0' && w <= '9'+          then skipDigitsAsciiLoop (Bytes.unsafeDrop 1 c)+          else (# unI (offset c), unI (length c) #)+  else (# unI (offset c), unI (length c) #)++skipDigitsAscii1LoopStart ::+     e+  -> Bytes -- chunk+  -> Result# e ()+skipDigitsAscii1LoopStart e !c = if length c > 0+  then +    let w = indexLatinCharArray (array c) (offset c)+     in if w >= '0' && w <= '9'+          then upcastUnitSuccess (skipDigitsAsciiLoop (Bytes.unsafeDrop 1 c))+          else (# e | #)+  else (# e | #)++-- | Variant of 'skipDigits' that requires at least one digit+-- to be present.+skipDigits1 :: e -> Parser e s ()+skipDigits1 e = uneffectful# $ \c ->+  skipDigitsAscii1LoopStart e c++-- | Skip the characters @0-9@ until a non-digit is encountered.+-- This parser does not fail.+skipDigits :: Parser e s ()+skipDigits = uneffectful# $ \c ->+  upcastUnitSuccess (skipDigitsAsciiLoop c)++unI :: Int -> Int#+unI (I# w) = w++-- | Skip the character any number of times. This succeeds+-- even if the character was not present.+skipChar :: Char -> Parser e s ()+skipChar !w = uneffectful# $ \c ->+  upcastUnitSuccess (skipLoop w c)++-- | Skip the character any number of times. It must occur+-- at least once or else this will fail.+skipChar1 :: e -> Char -> Parser e s ()+skipChar1 e !w = uneffectful# $ \c ->+  skipLoop1Start e w c++skipLoop ::+     Char -- byte to match+  -> Bytes -- Chunk+  -> (# Int#, Int# #)+skipLoop !w !c = if length c > 0+  then if indexLatinCharArray (array c) (offset c) == w+    then skipLoop w (Bytes.unsafeDrop 1 c)+    else (# unI (offset c), unI (length c) #)+  else (# unI (offset c), unI (length c) #)++skipLoop1Start ::+     e+  -> Char -- byte to match+  -> Bytes -- chunk+  -> Result# e ()+skipLoop1Start e !w !chunk0 = if length chunk0 > 0+  then if indexLatinCharArray (array chunk0) (offset chunk0) == w+    then upcastUnitSuccess (skipLoop w (Bytes.unsafeDrop 1 chunk0))+    else (# e | #)+  else (# e | #)++-- | Parse a decimal-encoded 8-bit word. If the number is larger+-- than 255, this parser fails.+decWord8 :: e -> Parser e s Word8+decWord8 e = Parser+  (\chunk0 s0 -> case decSmallWordStart e 256 (boxBytes chunk0) s0 of+    (# s1, r #) -> (# s1, upcastWord8Result r #)+  )++-- | Parse a decimal-encoded 16-bit word. If the number is larger+-- than 65535, this parser fails.+decWord16 :: e -> Parser e s Word16+decWord16 e = Parser+  (\chunk0 s0 -> case decSmallWordStart e 65536 (boxBytes chunk0) s0 of+    (# s1, r #) -> (# s1, upcastWord16Result r #)+  )++-- | Parse a decimal-encoded 32-bit word. If the number is larger+-- than 4294967295, this parser fails.+decWord32 :: e -> Parser e s Word32+-- This will not work on 32-bit platforms.+decWord32 e = Parser+  (\chunk0 s0 -> case decSmallWordStart e 4294967296 (boxBytes chunk0) s0 of+    (# s1, r #) -> (# s1, upcastWord32Result r #)+  )++-- | Parse a decimal-encoded number. If the number is too large to be+-- represented by a machine word, this fails with the provided+-- error message. This accepts any number of leading zeroes.+decWord :: e -> Parser e s Word+decWord e = Parser+  (\chunk0 s0 -> case decWordStart e (boxBytes chunk0) s0 of+    (# s1, r #) -> (# s1, upcastWordResult r #)+  )++decSmallWordStart ::+     e -- Error message+  -> Word -- Upper Bound+  -> Bytes -- Chunk+  -> ST# s (Result# e Word# )+decSmallWordStart e !limit !chunk0 s0 = if length chunk0 > 0+  then+    let !w = fromIntegral @Word8 @Word+          (PM.indexByteArray (array chunk0) (offset chunk0)) - 48+     in if w < 10+          then (# s0, decSmallWordMore e w limit (Bytes.unsafeDrop 1 chunk0) #)+          else (# s0, (# e | #) #)+  else (# s0, (# e | #) #)++-- This will not inline since it is recursive, but worker+-- wrapper will still happen.+decWordMore ::+     e -- Error message+  -> Word -- Accumulator+  -> Bytes -- Chunk+  -> Result# e Word#+decWordMore e !acc !chunk0 = if length chunk0 > 0+  then+    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# #) #)+++upcastWordResult :: Result# e Word# -> Result# e Word+upcastWordResult (# e | #) = (# e | #)+upcastWordResult (# | (# a, b, c #) #) = (# | (# W# a, b, c #) #)++decSmallWordMore ::+     e -- Error message+  -> Word -- Accumulator+  -> Word -- Upper Bound+  -> Bytes -- Chunk+  -> Result# e Word#+decSmallWordMore e !acc !limit !chunk0 = if length chunk0 > 0+  then+    let !w = fromIntegral @Word8 @Word+          (PM.indexByteArray (array chunk0) (offset chunk0)) - 48+     in if w < 10+          then+            let w' = acc * 10 + w+             in if w' < limit+                  then decSmallWordMore e w' limit (Bytes.unsafeDrop 1 chunk0)+                  else (# e | #)+          else (# | (# unW acc, unI (offset chunk0), unI (length chunk0)  #) #)+  else (# | (# unW acc, unI (offset chunk0), 0# #) #)++unW :: Word -> Word#+unW (W# w) = w++decWordStart ::+     e -- Error message+  -> Bytes -- Chunk+  -> ST# s (Result# e Word# )+decWordStart e !chunk0 s0 = if length chunk0 > 0+  then+    let !w = fromIntegral @Word8 @Word+          (PM.indexByteArray (array chunk0) (offset chunk0)) - 48+     in if w < 10+          then (# s0, decWordMore e w (Bytes.unsafeDrop 1 chunk0) #)+          else (# s0, (# e | #) #)+  else (# s0, (# e | #) #)++-- Precondition: the word is small enough+upcastWord16Result :: Result# e Word# -> Result# e Word16+upcastWord16Result (# e | #) = (# e | #)+upcastWord16Result (# | (# a, b, c #) #) = (# | (# W16# a, b, c #) #)++-- Precondition: the word is small enough+upcastWord32Result :: Result# e Word# -> Result# e Word32+upcastWord32Result (# e | #) = (# e | #)+upcastWord32Result (# | (# a, b, c #) #) = (# | (# W32# a, b, c #) #)++-- Precondition: the word is small enough+upcastWord8Result :: Result# e Word# -> Result# e Word8+upcastWord8Result (# e | #) = (# e | #)+upcastWord8Result (# | (# a, b, c #) #) = (# | (# W8# a, b, c #) #)++-- | Parse a decimal-encoded number. If the number is too large to be+-- represented by a machine integer, this fails with the provided+-- error message. This rejects input with that is preceeded by plus+-- or minus. Consequently, it does not parse negative numbers. Use+-- 'decStandardInt' or 'decSignedInt' for that purpose. On a 64-bit+-- platform 'decWord' will successfully parse 9223372036854775808+-- (i.e. @2 ^ 63@), but 'decUnsignedInt' will fail. This parser allows+-- leading zeroes.+decUnsignedInt :: e -> Parser e s Int+decUnsignedInt e = Parser+  (\chunk0 s0 -> case decPosIntStart e (boxBytes chunk0) s0 of+    (# s1, r #) -> (# s1, upcastIntResult r #)+  )++-- | Variant of 'decUnsignedInt' with an unboxed result.+decUnsignedInt# :: e -> Parser e s Int#+decUnsignedInt# e = Parser+  (\chunk0 s0 -> decPosIntStart e (boxBytes chunk0) s0)++-- | Parse a decimal-encoded number. If the number is too large to be+-- represented by a machine integer, this fails with the provided+-- error message. This allows the number to optionally be prefixed+-- by plus or minus. If the sign prefix is not present, the number+-- is interpreted as positive. This allows leading zeroes.+decSignedInt :: e -> Parser e s Int+decSignedInt e = Parser+  (\chunk0 s0 -> case runParser (decSignedInt# e) chunk0 s0 of+    (# s1, r #) -> (# s1, upcastIntResult r #)+  )++-- | Variant of 'decUnsignedInt' that lets the caller supply a leading+-- digit. This is useful when parsing formats like JSON where integers with+-- leading zeroes are considered invalid. The calling context must+-- consume the first digit before calling this parser. Results are+-- always positive numbers.+decTrailingInt ::+     e -- ^ Error message+  -> Int -- ^ Leading digit, should be between @0@ and @9@.+  -> Parser e s Int+decTrailingInt e (I# w) = Parser+  (\chunk0 s0 -> case runParser (decTrailingInt# e w) chunk0 s0 of+    (# s1, r #) -> (# s1, upcastIntResult r #)+  )++decTrailingInt# ::+     e -- Error message+  -> Int# -- Leading digit, should be between @0@ and @9@.+  -> Parser e s Int#+decTrailingInt# e !w =+  Parser (\chunk0 s0 -> (# s0, decPosIntMore e (I# w) (boxBytes chunk0) #))++-- | Parse a decimal-encoded number. If the number is too large to be+-- represented by a machine integer, this fails with the provided+-- error message. This allows the number to optionally be prefixed+-- by minus. If the minus prefix is not present, the number+-- is interpreted as positive. The disallows a leading plus sign.+-- For example, 'decStandardInt' rejects @+42@, but 'decSignedInt'+-- allows it.+decStandardInt :: e -> Parser e s Int+decStandardInt e = Parser+  (\chunk0 s0 -> case runParser (decStandardInt# e) chunk0 s0 of+    (# s1, r #) -> (# s1, upcastIntResult r #)+  )++decSignedInt# :: e -> Parser e s Int#+{-# noinline decSignedInt# #-}+decSignedInt# e = any e `bindFromLiftedToInt` \c -> case c of+  '+' -> Parser -- plus sign+    (\chunk0 s0 -> decPosIntStart e (boxBytes chunk0) s0)+  '-' -> Parser -- minus sign+    (\chunk0 s0 -> decNegIntStart e (boxBytes chunk0) s0)+  _ -> Parser -- no sign, there should be a digit here +    (\chunk0 s0 ->+      let !w = char2Word c - 48+        in if w < 10+             then (# s0, decPosIntMore e (fromIntegral @Word @Int w) (boxBytes chunk0) #)+             else (# s0, (# e | #) #)+    )++-- This is the same as decSignedInt except that we disallow+-- a leading plus sign.+decStandardInt# :: e -> Parser e s Int#+{-# noinline decStandardInt# #-}+decStandardInt# e = any e `bindFromLiftedToInt` \c -> case c of+  '-' -> Parser -- minus sign+    (\chunk0 s0 -> decNegIntStart e (boxBytes chunk0) s0)+  _ -> Parser -- no sign, there should be a digit here +    (\chunk0 s0 ->+      let !w = char2Word c - 48+        in if w < 10+             then (# s0, decPosIntMore e (fromIntegral @Word @Int w) (boxBytes chunk0) #)+             else (# s0, (# e | #) #)+    )++-- | Variant of 'decUnsignedInteger' that lets the caller supply a leading+-- digit. This is useful when parsing formats like JSON where integers with+-- leading zeroes are considered invalid. The calling context must+-- consume the first digit before calling this parser. Results are+-- always positive numbers.+decTrailingInteger ::+     Int -- ^ Leading digit, should be between @0@ and @9@.+  -> Parser e s Integer+decTrailingInteger (I# w) =+  Parser (\chunk0 s0 -> (# s0, (# | decIntegerChunks (I# w) 10 0 (boxBytes chunk0) #) #))++-- | Parse a decimal-encoded positive integer of arbitrary+-- size. This rejects input that begins with a plus or minus+-- sign.+decUnsignedInteger :: e -> Parser e s Integer+decUnsignedInteger e = Parser+  (\chunk0 s0 -> decUnsignedIntegerStart e (boxBytes chunk0) s0)++-- | Parse a decimal-encoded integer of arbitrary size.+-- This accepts input that begins with a plus or minus sign.+-- Input without a sign prefix is interpreted as positive.+decSignedInteger :: e -> Parser e s Integer+{-# noinline decSignedInteger #-}+decSignedInteger e = any e >>= \c -> case c of+  '+' -> do+    decUnsignedInteger e+  '-' -> do+    x <- decUnsignedInteger e+    pure $! negate x+  _ -> Parser -- no sign, there should be a digit here +    (\chunk0 s0 ->+      let !w = char2Word c - 48 in+      if w < 10+        then+          let !r = decIntegerChunks+                (fromIntegral @Word @Int w)+                10+                0+                (boxBytes chunk0)+           in (# s0, (# | r #) #)+        else (# s0, (# e | #) #)+    )++decPosIntStart ::+     e -- Error message+  -> Bytes -- Chunk+  -> ST# s (Result# e Int# )+decPosIntStart e !chunk0 s0 = if length chunk0 > 0+  then+    let !w = fromIntegral @Word8 @Word+          (PM.indexByteArray (array chunk0) (offset chunk0)) - 48+     in if w < 10+          then (# s0, decPosIntMore e (fromIntegral @Word @Int w) (Bytes.unsafeDrop 1 chunk0) #)+          else (# s0, (# e | #) #)+  else (# s0, (# e | #) #)++decNegIntStart ::+     e -- Error message+  -> Bytes -- Chunk+  -> ST# s (Result# e Int# )+decNegIntStart e !chunk0 s0 = if length chunk0 > 0+  then+    let !w = fromIntegral @Word8 @Word+          (PM.indexByteArray (array chunk0) (offset chunk0)) - 48+     in if w < 10+          then (# s0, decNegIntMore e (negate (fromIntegral @Word @Int w)) (Bytes.unsafeDrop 1 chunk0) #)+          else (# s0, (# e | #) #)+  else (# s0, (# e | #) #)++decUnsignedIntegerStart ::+     e+  -> Bytes+  -> ST# s (Result# e Integer)+decUnsignedIntegerStart e !chunk0 s0 = if length chunk0 > 0+  then+    let !w = (PM.indexByteArray (array chunk0) (offset chunk0)) - 48+     in if w < (10 :: Word8)+          then+            let !r = decIntegerChunks+                  (fromIntegral @Word8 @Int w)+                  10+                  0+                  (Bytes.unsafeDrop 1 chunk0)+             in (# s0, (# | r #) #)+          else (# s0, (# e | #) #)+  else (# s0, (# e | #) #)++-- This will not inline since it is recursive, but worker+-- wrapper will still happen.+decNegIntMore ::+     e -- Error message+  -> Int -- Accumulator+  -> Bytes -- Chunk+  -> Result# e Int#+decNegIntMore e !acc !chunk0 = if length chunk0 > 0+  then+    let !w = fromIntegral @Word8 @Word+          (PM.indexByteArray (array chunk0) (offset chunk0)) - 48+        !acc' = acc * 10 - (fromIntegral @Word @Int w)+     in if w < 10+          then if acc' <= acc+            then decNegIntMore e acc' (Bytes.unsafeDrop 1 chunk0)+            else (# e | #)+          else (# | (# unI acc, unI (offset chunk0), unI (length chunk0)  #) #)+  else (# | (# unI acc, unI (offset chunk0), 0# #) #)++-- This will not inline since it is recursive, but worker+-- wrapper will still happen. Fails if the accumulator+-- exceeds the size of a machine integer.+decPosIntMore ::+     e -- Error message+  -> Int -- Accumulator+  -> Bytes -- Chunk+  -> Result# e Int#+decPosIntMore e !acc !chunk0 = if len > 0+  then+    let !w = fromIntegral @Word8 @Word+          (PM.indexByteArray (array chunk0) (offset chunk0)) - 48+        !acc' = acc * 10 + (fromIntegral @Word @Int w)+     in if w < 10+          then if acc' >= acc+            then decPosIntMore e acc' (Bytes.unsafeDrop 1 chunk0)+            else (# e | #)+          else (# | (# unI acc, unI (offset chunk0), len# #) #)+  else (# | (# unI acc, unI (offset chunk0), 0# #) #)+  where+  !len@(I# len# ) = length chunk0++-- This will not inline since it is recursive, but worker+-- wrapper will still happen. When the accumulator+-- exceeds the size of a machine integer, this pushes the+-- accumulated machine int and the shift amount onto the+-- stack.+-- We are intentionally lazy in the accumulator. There is+-- no need to force this on every iteration. We do however,+-- force it preemptively every time it changes.+-- Because of how we track overflow, we are able to use the+-- same function for both positive and negative numbers.+decIntegerChunks ::+     Int -- Chunk accumulator (e.g. 236)+  -> Int -- Chunk base-ten bound (e.g. 1000)+  -> Integer -- Accumulator+  -> Bytes -- Chunk+  -> (# Integer, Int#, Int# #)+decIntegerChunks !nAcc !eAcc acc !chunk0 = if len > 0+  then+    let !w = fromIntegral @Word8 @Word+          (PM.indexByteArray (array chunk0) (offset chunk0)) - 48+     in if w < 10+          then let !eAcc' = eAcc * 10 in+            if eAcc' >= eAcc+              then decIntegerChunks+                (nAcc * 10 + fromIntegral @Word @Int w)+                eAcc'+                acc+                (Bytes.unsafeDrop 1 chunk0)+              else+                -- In this case, notice that we deliberately+                -- unconsume the digit that would have caused+                -- an overflow.+                let !r = (acc * fromIntegral @Int @Integer eAcc)+                       + (fromIntegral @Int @Integer nAcc)+                 in decIntegerChunks 0 1 r chunk0+          else+            let !r = (acc * fromIntegral @Int @Integer eAcc)+                   + (fromIntegral @Int @Integer nAcc)+             in (# r, unI (offset chunk0), len# #)+  else+    let !r = (acc * fromIntegral @Int @Integer eAcc)+           + (fromIntegral @Int @Integer nAcc)+     in (# r, unI (offset chunk0), 0# #)+  where+  !len@(I# len# ) = length chunk0++upcastIntResult :: Result# e Int# -> Result# e Int+upcastIntResult (# e | #) = (# e | #)+upcastIntResult (# | (# a, b, c #) #) = (# | (# I# a, b, c #) #)++char2Word :: Char -> Word+char2Word = fromIntegral . ord++-- | Skip all characters until the character from the 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+-- > |->->->->-|+skipTrailedBy :: e -> Char -> Parser e s ()+skipTrailedBy e !w = uneffectful# $ \c ->+  skipUntilConsumeLoop e w 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+    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+-- this rejects a sequence such as @5A9@, requiring @05A9@ instead.+-- 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+    (# 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+  then+    let !w0@(W# n0) = oneHex $ PM.indexByteArray (array chunk) (offset chunk)+        !w1@(W# n1) = oneHex $ PM.indexByteArray (array chunk) (offset chunk + 1)+        !w2@(W# n2) = oneHex $ PM.indexByteArray (array chunk) (offset chunk + 2)+        !w3@(W# n3) = oneHex $ PM.indexByteArray (array chunk) (offset chunk + 3)+     in if | w0 .|. w1 .|. w2 .|. w3 /= maxBound ->+             (# |+                (# (n0 `Exts.timesWord#` 4096##) `Exts.plusWord#`+                   (n1 `Exts.timesWord#` 256##) `Exts.plusWord#`+                   (n2 `Exts.timesWord#` 16##) `Exts.plusWord#`+                   n3+                ,  unI (offset chunk) +# 4#+                ,  unI (length chunk) -# 4# #) #)+           | otherwise -> (# e | #)+  else (# e | #)+++-- Returns the maximum machine word if the argument is not+-- the ASCII encoding of a hexadecimal digit.+oneHex :: Word8 -> Word+oneHex w+  | w >= 48 && w < 58 = (fromIntegral w - 48)+  | w >= 65 && w < 71 = (fromIntegral w - 55)+  | w >= 97 && w < 103 = (fromIntegral w - 87)+  | otherwise = maxBound++uneffectfulWord# :: (Bytes -> Result# e Word#) -> Parser e s Word#+uneffectfulWord# f = Parser+  ( \b s0 -> (# s0, (f (boxBytes b)) #) )+

@@ -0,0 +1,62 @@+{-# 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 #-}++-- | Everything in this module is unsafe and can lead to+-- nondeterministic output or segfaults if used incorrectly.+module Data.Bytes.Parser.Unsafe+  ( cursor+  , expose+  , unconsume+  , jump+  ) where++import Prelude hiding (length)++import Data.Primitive (ByteArray)+import Data.Bytes.Types (Bytes(..))+import Data.Bytes.Parser.Internal (Parser(..),uneffectful)+import Data.Bytes.Parser.Internal (InternalResult(..))++-- | Get the current offset into the chunk. Using this makes+-- 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)++-- | 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)++-- | 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)++-- | 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))+

@@ -0,0 +1,143 @@+{-# 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 #-}++-- | Parse input as UTF-8-encoded text. Parsers in this module will+-- fail if they encounter a byte above @0x7F@.+module Data.Bytes.Parser.Utf8+  ( -- * Get Character+    any#+  , shortText+  ) where++import Prelude hiding (length,any,fail,takeWhile)++import Data.Bits ((.&.),(.|.),unsafeShiftL,xor)+import Data.Bytes.Parser.Internal (Parser(..))+import Data.Text.Short (ShortText)+import GHC.Exts (Int(I#),Char(C#),Int#,Char#,(-#),(+#),(>#),chr#)+import GHC.Word (Word8(W8#))++import qualified Data.ByteString.Short.Internal as BSS+import qualified Data.Bytes.Parser as Parser+import qualified Data.Primitive as PM+import qualified Data.Text.Short as TS+import qualified GHC.Exts as Exts++-- | Interpret the next one to four bytes as a UTF-8-encoded character.+-- Fails if the decoded codepoint is in the range U+D800 through U+DFFF.+any# :: e -> Parser e s Char#+{-# noinline any# #-}+any# e = Parser+  (\(# arr, off, len #) s0 -> case len ># 0# of+    1# ->+      let !w0 = Exts.indexWord8Array# arr off+       in if | oneByteChar (W8# w0) -> +                 (# s0, (# | (# chr# (Exts.word2Int# w0), off +# 1#, len -# 1# #) #) #)+             | twoByteChar (W8# w0) ->+                 if | I# len > 1+                    , w1 <- Exts.indexWord8Array# arr (off +# 1#)+                    , followingByte (W8# w1)+                    , C# c <- codepointFromTwoBytes (W8# w0) (W8# w1)+                      -> (# s0, (# | (# c, off +# 2#, len -# 2# #) #) #)+                    | otherwise -> (# s0, (# e | #) #)+             | threeByteChar (W8# w0) ->+                 if | I# len > 2+                    , w1 <- Exts.indexWord8Array# arr (off +# 1# )+                    , w2 <- Exts.indexWord8Array# arr (off +# 2# )+                    , followingByte (W8# w1)+                    , !c@(C# c#) <- codepointFromThreeBytes (W8# w0) (W8# w1) (W8# w2)+                    , c < '\xD800' || c > '\xDFFF'+                      -> (# s0, (# | (# c#, off +# 3#, len -# 3# #) #) #)+                    | otherwise -> (# s0, (# e | #) #)+             | fourByteChar (W8# w0) ->+                 if | I# len > 3+                    , w1 <- Exts.indexWord8Array# arr (off +# 1# )+                    , w2 <- Exts.indexWord8Array# arr (off +# 2# )+                    , w3 <- Exts.indexWord8Array# arr (off +# 3# )+                    , followingByte (W8# w1)+                    , !(C# c#) <- codepointFromFourBytes (W8# w0) (W8# w1) (W8# w2) (W8# w3)+                      -> (# s0, (# | (# c#, off +# 4#, len -# 4# #) #) #)+                    | otherwise -> (# s0, (# e | #) #)+             | otherwise -> (# s0, (# e | #) #)+    _ -> (# s0, (# e | #) #)+  )++codepointFromFourBytes :: Word8 -> Word8 -> Word8 -> Word8 -> Char+codepointFromFourBytes w1 w2 w3 w4 = C#+  ( chr#+    ( unI $ fromIntegral+      ( unsafeShiftL (word8ToWord w1 .&. 0b00001111) 18 .|. +        unsafeShiftL (word8ToWord w2 .&. 0b00111111) 12 .|. +        unsafeShiftL (word8ToWord w3 .&. 0b00111111) 6 .|. +        (word8ToWord w4 .&. 0b00111111)+      )+    )+  )++codepointFromThreeBytes :: Word8 -> Word8 -> Word8 -> Char+codepointFromThreeBytes w1 w2 w3 = C#+  ( chr#+    ( unI $ fromIntegral+      ( unsafeShiftL (word8ToWord w1 .&. 0b00001111) 12 .|. +        unsafeShiftL (word8ToWord w2 .&. 0b00111111) 6 .|. +        (word8ToWord w3 .&. 0b00111111)+      )+    )+  )++codepointFromTwoBytes :: Word8 -> Word8 -> Char+codepointFromTwoBytes w1 w2 = C#+  ( chr#+    ( unI $ fromIntegral @Word @Int+      ( unsafeShiftL (word8ToWord w1 .&. 0b00011111) 6 .|. +        (word8ToWord w2 .&. 0b00111111)+      )+    )+  )++oneByteChar :: Word8 -> Bool+oneByteChar !w = w .&. 0b10000000 == 0++twoByteChar :: Word8 -> Bool+twoByteChar !w = w .&. 0b11100000 == 0b11000000++threeByteChar :: Word8 -> Bool+threeByteChar !w = w .&. 0b11110000 == 0b11100000++fourByteChar :: Word8 -> Bool+fourByteChar !w = w .&. 0b11111000 == 0b11110000++followingByte :: Word8 -> Bool+followingByte !w = xor w 0b01000000 .&. 0b11000000 == 0b11000000++word8ToWord :: Word8 -> Word+word8ToWord = fromIntegral++unI :: Int -> Int#+unI (I# w) = w++-- | Consume input that matches the argument. Fails if the+-- input does not match.+shortText :: e -> ShortText -> Parser e s ()+shortText e !t = Parser.byteArray e+  (shortByteStringToByteArray (TS.toShortByteString t))++shortByteStringToByteArray ::+     BSS.ShortByteString+  -> PM.ByteArray+shortByteStringToByteArray (BSS.SBS x) = PM.ByteArray x

@@ -1,43 +1,167 @@ {-# language BangPatterns #-} {-# language MultiWayIf #-}+{-# language NumDecimals #-}+{-# language OverloadedStrings #-} {-# language ScopedTypeVariables #-} {-# language TypeApplications #-} -import Control.Exception (throwIO)-import Data.Primitive (ByteArray)-import Data.Word (Word8)+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 (Parser,Result(..))+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.Parser as P+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.Primitive as PM import qualified GHC.Exts as Exts+import qualified Test.Tasty.QuickCheck as QC  main :: IO ()-main = do-  putStrLn "Start"-  putStrLn "A"-  testA-  putStrLn "Finished"+main = defaultMain tests -testA :: IO ()-testA =-  let r = P.parseByteArray+tests :: TestTree+tests = testGroup "Parser"+  [ testProperty "decStandardInt" $ \i ->+      P.parseBytes (Latin.decStandardInt ()) (bytes (show i)) === P.Success i 0+  , testProperty "big-endian-word64" bigEndianWord64+  , testCase "delimit" $+      P.Success (167,14625) 0+      @=?+      P.parseBytes+        (do len <- Latin.decUnsignedInt ()+            Latin.char () ','+            r <- P.delimit () () len $ (,)+              <$> Latin.decUnsignedInt ()+              <*  Latin.char () '*'+              <*> Latin.decUnsignedInt ()+            Latin.char () '0'+            pure r+        ) (bytes "9,167*146250")+  , testGroup "decUnsignedInt"+    [ testCase "A" $+        P.Failure ()+        @=?+        P.parseBytes (Latin.decUnsignedInt ())+          (bytes "742493495120739103935542")+    , testCase "B" $+        P.Success 4654667 3+        @=?+        P.parseBytes (Latin.decUnsignedInt ())+          (bytes "4654667,55")+    , testProperty "property" $ \(QC.NonNegative i) ->+        P.parseBytes (Latin.decUnsignedInt ()) (bytes (show i))+        ===+        P.Success i 0+    ]+  , testGroup "decPositiveInteger"+    [ testCase "A" $ +        P.parseBytes (Latin.decUnsignedInteger ())+          (bytes "5469999463123462573426452736423546373235260")+        @=?+        P.Success 5469999463123462573426452736423546373235260 0+    , testProperty "property" $ \(LargeInteger i) ->+        i >= 0+        QC.==>+        P.parseBytes (Latin.decUnsignedInteger ()) (bytes (show i))+        ===+        P.Success i 0+    ]+  , testGroup "decSignedInteger"+    [ testCase "A" $ +        P.parseBytes (Latin.decSignedInteger ())+          (bytes "-54699994631234625734264527364235463732352601")+        @=?+        P.Success (-54699994631234625734264527364235463732352601) 0+    , testProperty "property" $ \(LargeInteger i) ->+        P.parseBytes (Latin.decSignedInteger ()) (bytes (show i))+        ===+        P.Success i 0+    ]+  , testProperty "decSignedInt-A" $ \i ->+      P.parseBytes (Latin.decSignedInt ()) (bytes (show i)) === P.Success i 0+  , testProperty "decSignedInt-B" $ \i ->+      P.parseBytes+        (Latin.decSignedInt ())+        (bytes ((if i >= 0 then "+" else "") ++ show i))+      ===+      P.Success i 0+  , testCase "decWord-composition" $+      P.Success (42,8) 0+      @=?+      P.parseBytes         ( pure (,)-        <*> P.decWord ()-        <*  P.ascii () '.'-        <*> P.decWord ()-        <*  P.ascii () '.'-        ) (pack "42.8.")-   in case r of-        Failure () -> fail "test A failed parsing"-        Success (42,8) 5 0 -> pure ()-        Success _ _ _ -> fail "test A wrong result"+        <*> Ascii.decWord ()+        <*  Ascii.char () '.'+        <*> Ascii.decWord ()+        <*  Ascii.char () '.'+        ) (bytes "42.8.")+  , testCase "decWord-replicate" $+      P.Success (Exts.fromList [42,93] :: PrimArray Word) 0+      @=?+      P.parseBytes+        (P.replicate 2 (Ascii.decWord () <* Ascii.char () '.'))+        (bytes "42.93.")+  ]  bytes :: String -> Bytes-bytes s = let b = pack s in Bytes b 0 (PM.sizeofByteArray b)+bytes s = let b = pack ('x' : s) in Bytes b 1 (PM.sizeofByteArray b - 1)  pack :: String -> ByteArray pack = Exts.fromList . map (fromIntegral @Int @Word8 . ord)++bigEndianWord64 ::+     Word8 -> Word8 -> Word8 -> Word8+  -> Word8 -> Word8 -> Word8 -> Word8+  -> QC.Property+bigEndianWord64 a b c d e f g h = +  let arr = runST $ do+        m <- PM.newByteArray 11+        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 (e :: Word8)+        PM.writeByteArray m 7 (f :: Word8)+        PM.writeByteArray m 8 (g :: Word8)+        PM.writeByteArray m 9 (h :: Word8)+        PM.writeByteArray m 10 (0xEE :: Word8)+        PM.unsafeFreezeByteArray m+      expected = (0 :: Word64)+        + fromIntegral a * 256 ^ (7 :: Integer)+        + fromIntegral b * 256 ^ (6 :: Integer)+        + fromIntegral c * 256 ^ (5 :: Integer)+        + fromIntegral d * 256 ^ (4 :: Integer)+        + fromIntegral e * 256 ^ (3 :: Integer)+        + fromIntegral f * 256 ^ (2 :: Integer)+        + fromIntegral g * 256 ^ (1 :: Integer)+        + fromIntegral h * 256 ^ (0 :: Integer)+   in P.parseBytes (BigEndian.word64 ()) (Bytes arr 2 9)+      ===+      P.Success expected 1++-- The Arbitrary instance for Integer that comes with+-- QuickCheck only generates small numbers.+newtype LargeInteger = LargeInteger Integer+  deriving (Eq,Show)++instance QC.Arbitrary LargeInteger where+  arbitrary = QC.sized $ \sz -> do+      n <- QC.choose (1, sz)+      sign <- QC.arbitrary+      r <- (if sign then negate else id) . foldr f 0+        <$> replicateM n QC.arbitrary+      pure (LargeInteger r)+    where+      f :: Word8 -> Integer -> Integer+      f w acc = (acc `Bits.shiftL` 8) + fromIntegral w