Z-Data 0.7.2.0 → 0.7.3.0

raw patch · 9 files changed

+256/−190 lines, 9 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +6/−0
• Z-Data.cabal +1/−1
• Z/Data/ASCII.hs +4/−4
• Z/Data/Builder/Base.hs +2/−2
• Z/Data/JSON/Value.hs +16/−33
• Z/Data/Parser.hs +2/−2
• Z/Data/Parser/Base.hs +223/−144
• Z/Data/Text/Base.hs +1/−3
• Z/Data/Vector/Base.hs +1/−1

@@ -1,5 +1,11 @@ # Revision history for Z-Data +## 0.7.3.0  -- 2021-03-30++* Add more helpers to debug `Parser`: `currentChunk`, `failWithInput`, `unsafeLiftIO`.+* Parser now is an instance of `PrimMonad`, which can perform limited effects, e.g. array operations.+* Make some parsers' error message more helpful.+ ## 0.7.2.0  -- 2021-03-22  * Add `fromMutablePrimArray` for constructing CBytes.

@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               Z-Data-version:            0.7.2.0+version:            0.7.3.0 synopsis:           Array, vector and text description:        This package provides array, slice and text operations license:            BSD-3-Clause

@@ -205,8 +205,8 @@ pattern EXCLAM :: Word8 pattern EXCLAM       = 0x21 -- | @\"@-pattern QUOTE_DOUBLE :: Word8-pattern QUOTE_DOUBLE = 0x22+pattern DOUBLE_QUOTE :: Word8+pattern DOUBLE_QUOTE = 0x22 -- | @\#@ pattern HASH :: Word8 pattern HASH         = 0x23@@ -226,8 +226,8 @@ pattern AND :: Word8 pattern AND          = 0x26 -- | @\'@-pattern QUOTE_SINGLE :: Word8-pattern QUOTE_SINGLE = 0x27+pattern SINGLE_QUOTE :: Word8+pattern SINGLE_QUOTE = 0x27 -- | @(@ pattern PAREN_LEFT :: Word8 pattern PAREN_LEFT   = 0x28

@@ -513,12 +513,12 @@ -- | add @/".../"@ to original builder. quotes :: Builder () -> Builder () {-# INLINE quotes #-}-quotes b = encodePrim QUOTE_DOUBLE >> b >> encodePrim QUOTE_DOUBLE+quotes b = encodePrim DOUBLE_QUOTE >> b >> encodePrim DOUBLE_QUOTE  -- | add @/'.../'@ to original builder. squotes :: Builder () -> Builder () {-# INLINE squotes #-}-squotes b = encodePrim QUOTE_SINGLE >> b >> encodePrim QUOTE_SINGLE+squotes b = encodePrim SINGLE_QUOTE >> b >> encodePrim SINGLE_QUOTE  -- | write an ASCII @:@ colon :: Builder ()

@@ -47,6 +47,7 @@ import           Data.Int import           Data.Word import           GHC.Generics+import           Z.Data.ASCII import qualified Z.Data.Parser              as P import qualified Z.Data.Builder.Numeric     as B import qualified Z.Data.Text.Base           as T@@ -59,24 +60,6 @@ import           Test.QuickCheck.Arbitrary  (Arbitrary(..)) import           Test.QuickCheck.Gen        (Gen(..), listOf) -#define BACKSLASH 92-#define CLOSE_CURLY 125-#define CLOSE_SQUARE 93-#define COMMA 44-#define COLON 58-#define DOUBLE_QUOTE 34-#define OPEN_CURLY 123-#define OPEN_SQUARE 91-#define C_0 48-#define C_9 57-#define C_A 65-#define C_F 70-#define C_a 97-#define C_f 102-#define C_n 110-#define C_t 116-#define MINUS    45- -------------------------------------------------------------------------------- -- | A JSON value represented as a Haskell value. --@@ -188,26 +171,26 @@     w <- P.peek     case w of         DOUBLE_QUOTE    -> P.skipWord8 *> (String <$> string_)-        OPEN_CURLY      -> P.skipWord8 *> (Object <$> object_)-        OPEN_SQUARE     -> P.skipWord8 *> (Array <$> array_)-        C_f             -> P.bytes "false" $> (Bool False)-        C_t             -> P.bytes "true" $> (Bool True)-        C_n             -> P.bytes "null" $> Null+        CURLY_LEFT      -> P.skipWord8 *> (Object <$> object_)+        SQUARE_LEFT     -> P.skipWord8 *> (Array <$> array_)+        LETTER_f        -> P.bytes "false" $> (Bool False)+        LETTER_t        -> P.bytes "true" $> (Bool True)+        LETTER_n        -> P.bytes "null" $> Null         _   | w >= 48 && w <= 57 || w == MINUS -> Number <$> P.scientific'             | otherwise -> P.fail' "Z.Data.JSON.Value.value: not a valid json value" --- | parse json array with leading OPEN_SQUARE.+-- | parse json array with leading SQUARE_LEFT. array :: P.Parser (V.Vector Value) {-# INLINE array #-}-array = P.word8 OPEN_SQUARE *> array_+array = P.word8 SQUARE_LEFT *> array_ --- | parse json array without leading OPEN_SQUARE.+-- | parse json array without leading SQUARE_LEFT. array_ :: P.Parser (V.Vector Value) {-# INLINABLE array_ #-} array_ = do     skipSpaces     w <- P.peek-    if w == CLOSE_SQUARE+    if w == SQUARE_RIGHT     then P.skipWord8 $> V.empty     else loop [] 1   where@@ -216,23 +199,23 @@         !v <- value         skipSpaces         let acc' = v:acc-        ch <- P.satisfy $ \w -> w == COMMA || w == CLOSE_SQUARE+        ch <- P.satisfy $ \w -> w == COMMA || w == SQUARE_RIGHT         if ch == COMMA         then skipSpaces *> loop acc' (n+1)         else pure $! V.packRN n acc'  -- n start from 1, so no need to +1 here --- | parse json array with leading OPEN_CURLY.+-- | parse json array with leading 'CURLY_LEFT'. object :: P.Parser (V.Vector (T.Text, Value)) {-# INLINE object #-}-object = P.word8 OPEN_CURLY *> object_+object = P.word8 CURLY_LEFT *> object_ --- | parse json object without leading OPEN_CURLY.+-- | parse json object without leading 'CURLY_LEFT'. object_ :: P.Parser (V.Vector (T.Text, Value)) {-# INLINABLE object_ #-} object_ = do     skipSpaces     w <- P.peek-    if w == CLOSE_CURLY+    if w == CURLY_RIGHT     then P.skipWord8 $> V.empty     else loop [] 1  where@@ -244,7 +227,7 @@         !v <- value         skipSpaces         let acc' = (k, v) : acc-        ch <- P.satisfy $ \w -> w == COMMA || w == CLOSE_CURLY+        ch <- P.satisfy $ \w -> w == COMMA || w == CURLY_RIGHT         if ch == COMMA         then skipSpaces *> loop acc' (n+1)         else pure $! V.packRN n acc'  -- n start from 1, so no need to +1 here

@@ -33,7 +33,7 @@   , parse, parse', parseChunk, ParseChunks, parseChunks, finishParsing   , runAndKeepTrack, match     -- * Basic parsers-  , ensureN, endOfInput, atEnd+  , ensureN, endOfInput, atEnd, currentChunk     -- * Primitive decoders   , decodePrim, BE(..), LE(..)   , decodePrimLE, decodePrimBE@@ -67,7 +67,7 @@   , utcTime   , zonedTime     -- * Misc-  , fail'+  , fail', failWithInput, unsafeLiftIO   ) where  import           Z.Data.Parser.Base

@@ -22,7 +22,7 @@   , parse, parse', parseChunk, ParseChunks, parseChunks, finishParsing   , runAndKeepTrack, match     -- * Basic parsers-  , ensureN, endOfInput, atEnd+  , ensureN, endOfInput, currentChunk, atEnd     -- * Primitive decoders   , decodePrim, BE(..), LE(..)   , decodePrimLE, decodePrimBE@@ -32,12 +32,13 @@   , skipWord8, endOfLine, skip, skipWhile, skipSpaces   , take, takeN, takeTill, takeWhile, takeWhile1, takeRemaining, bytes, bytesCI   , text-    -- * Misc-  , fail'+    -- * Error reporting+  , fail', failWithInput, unsafeLiftIO   ) where  import           Control.Applicative import           Control.Monad+import           Control.Monad.Primitive import qualified Control.Monad.Fail                 as Fail import qualified Data.CaseInsensitive               as CI import qualified Data.Primitive.PrimArray           as A@@ -45,11 +46,12 @@ import           Data.Word import           Data.Bits                          ((.&.)) import           GHC.Types+import           GHC.Exts                           (State#, runRW#, unsafeCoerce#) import           Prelude                            hiding (take, takeWhile) import           Z.Data.Array.Unaligned import           Z.Data.ASCII+import qualified Z.Data.Text                        as T import qualified Z.Data.Text.Base                   as T-import qualified Z.Data.Text.Extra                  as T import qualified Z.Data.Text.UTF8Codec              as T import qualified Z.Data.Vector.Base                 as V import qualified Z.Data.Vector.Extra                as V@@ -83,7 +85,6 @@     show (Partial _)      = "Partial _"     show (Failure errs _) = "Failure: " ++ show errs - -- | Simple CPSed parser -- -- A parser takes a failure continuation, and a success one, while the success continuation is@@ -93,40 +94,62 @@ --  @ --    xxParser = do --      ensureN errMsg ...            -- make sure we have some bytes---      Parser $ \ kf k inp ->        -- fail continuation, success continuation and input+--      Parser $ \ kf k s inp ->      -- fail continuation, success continuation, state token and input --        ... --        ... kf errMsg (if input not OK)---        ... k ... (if we get something useful for next parser)+--        ... k s ... (if we get something useful for next parser) --  @ newtype Parser a = Parser {-        runParser :: forall r . (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r+        runParser :: forall r . (ParseError -> ParseStep r)+                  -> (State# ParserState -> a -> ParseStep r)+                  -> State# ParserState -> ParseStep r     } +-- | State token tag used in `Parser`+data ParserState+ -- It seems eta-expand all params to ensure parsers are saturated is helpful instance Functor Parser where-    fmap f (Parser pa) = Parser (\ kf k inp -> pa kf (k . f) inp)+    fmap f (Parser pa) = Parser (\ kf k s inp -> pa kf (\ s' -> k s' . f) s inp)     {-# INLINE fmap #-}-    a <$ Parser pb = Parser (\ kf k inp -> pb kf (\ _ -> k a) inp)+    a <$ Parser pb = Parser (\ kf k s inp -> pb kf (\ s' _ -> k s' a) s inp)     {-# INLINE (<$) #-}  instance Applicative Parser where-    pure x = Parser (\ _ k inp -> k x inp)+    pure x = Parser (\ _ k s inp -> k s x inp)     {-# INLINE pure #-}-    Parser pf <*> Parser pa = Parser (\ kf k inp -> pf kf (\ f -> pa kf (k . f)) inp)+    Parser pf <*> Parser pa = Parser (\ kf k s inp -> pf kf (\ s' f -> pa kf (\ s'' -> k s'' . f) s') s inp)     {-# INLINE (<*>) #-}-    Parser pa *> Parser pb = Parser (\ kf k inp -> pa kf (\ _ inp' -> pb kf k inp') inp)+    Parser pa *> Parser pb = Parser (\ kf k s inp -> pa kf (\ s' _ -> pb kf k s') s inp)     {-# INLINE (*>) #-}-    Parser pa <* Parser pb = Parser (\ kf k inp -> pa kf (\ x inp' -> pb kf (\ _ -> k x) inp') inp)+    Parser pa <* Parser pb = Parser (\ kf k s inp -> pa kf (\ s' x -> pb kf (\ s'' _ -> k s'' x) s') s inp)     {-# INLINE (<*) #-}  instance Monad Parser where     return = pure     {-# INLINE return #-}-    Parser pa >>= f = Parser (\ kf k inp -> pa kf (\ a -> runParser (f a) kf k) inp)+    Parser pa >>= f = Parser (\ kf k s inp -> pa kf (\ s' a -> runParser (f a) kf k s') s inp)     {-# INLINE (>>=) #-}     (>>) = (*>)     {-# INLINE (>>) #-} +instance PrimMonad Parser where+    type PrimState Parser = ParserState+    {-# INLINE primitive #-}+    primitive = \ io -> Parser $ \ _ k st inp ->+        let !(# st', r #) = io st+        in k st' r inp++-- | Unsafely lifted an `IO` action into 'Parser'.+--+-- This is only for debugging purpose(logging, etc). Don't mix compuation from+-- realworld to parsing result, otherwise parsing is not deterministic.+unsafeLiftIO :: IO a -> Parser a+{-# INLINE unsafeLiftIO #-}+unsafeLiftIO (IO io) = Parser $ \ _ k st inp ->+    let !(# st', r #) = io (unsafeCoerce# st)+    in k (unsafeCoerce# st') r inp+ instance Fail.MonadFail Parser where     fail = fail' . T.pack     {-# INLINE fail #-}@@ -143,31 +166,39 @@     f <|> g = do         (r, bss) <- runAndKeepTrack f         case r of-            Success x inp   -> Parser (\ _ k _ -> k x inp)+            Success x inp   -> Parser (\ _ k s _ -> k s x inp)             Failure _ _     -> let !bs = V.concat (reverse bss)-                               in Parser (\ kf k _ -> runParser g kf k bs)+                               in Parser (\ kf k s _ -> runParser g kf k s bs)             _               -> error "Z.Data.Parser.Base: impossible"     {-# INLINE (<|>) #-}  -- | 'T.Text' version of 'fail'. fail' :: T.Text -> Parser a {-# INLINE fail' #-}-fail' msg = Parser (\ kf _ inp -> kf [msg] inp)+fail' msg = Parser (\ kf _ _ inp -> kf [msg] inp) +-- | Similar to `fail'`, but can produce error message with current input chunk.+failWithInput :: (V.Bytes -> T.Text) -> Parser a+{-# INLINE failWithInput #-}+failWithInput f = Parser (\ kf _ _ inp -> kf [f inp] inp)+ -- | Parse the complete input, without resupplying parse' :: Parser a -> V.Bytes -> Either ParseError a {-# INLINE parse' #-}-parse' (Parser p) inp = snd $ finishParsing (p Failure Success inp)+parse' (Parser p) inp = snd $ finishParsing (runRW# (\ s ->+        unsafeCoerce# (p Failure (\ _ r -> Success r) (unsafeCoerce# s) inp)))  -- | Parse the complete input, without resupplying, return the rest bytes parse :: Parser a -> V.Bytes -> (V.Bytes, Either ParseError a) {-# INLINE parse #-}-parse (Parser p) inp = finishParsing (p Failure Success inp)+parse (Parser p) inp = finishParsing (runRW# ( \ s ->+    unsafeCoerce# (p Failure (\ _ r -> Success r) (unsafeCoerce# s) inp)))  -- | Parse an input chunk parseChunk :: Parser a -> V.Bytes -> Result a {-# INLINE parseChunk #-}-parseChunk (Parser p) = p Failure Success+parseChunk (Parser p) = runRW# (\ s ->+    unsafeCoerce# (p Failure (\ _ r -> Success r) (unsafeCoerce# s)))  -- | Finish parsing and fetch result, feed empty bytes if it's 'Partial' result. finishParsing :: Result a -> (V.Bytes, Either ParseError a)@@ -187,7 +218,8 @@ -- more bytes (take it as 'endOfInput'). parseChunks :: Monad m => Parser a -> ParseChunks m V.Bytes ParseError a {-# INLINABLE parseChunks #-}-parseChunks (Parser p) m0 inp = go m0 (p Failure Success inp)+parseChunks (Parser p) m0 inp = go m0 (runRW# (\ s ->+    unsafeCoerce# (p Failure (\ _ r -> Success r) (unsafeCoerce# s) inp)))   where     go m r = case r of         Partial f -> do@@ -200,7 +232,7 @@  (<?>) :: T.Text -> Parser a -> Parser a {-# INLINE (<?>) #-}-msg <?> (Parser p) = Parser (\ kf k inp -> p (kf . (msg:)) k inp)+msg <?> (Parser p) = Parser (\ kf k s inp -> p (kf . (msg:)) k s inp) infixr 0 <?>  -- | Run a parser and keep track of all the input chunks it consumes.@@ -209,13 +241,14 @@ -- runAndKeepTrack :: Parser a -> Parser (Result a, [V.Bytes]) {-# INLINE runAndKeepTrack #-}-runAndKeepTrack (Parser pa) = Parser $ \ _ k0 inp ->-    let go !acc r k = case r of-            Partial k'      -> Partial (\ inp' -> go (inp':acc) (k' inp') k)-            Success _ inp' -> k (r, reverse acc) inp'-            Failure _ inp' -> k (r, reverse acc) inp'-        r0 = pa Failure Success inp-    in go [inp] r0 k0+runAndKeepTrack (Parser pa) = Parser $ \ _ k0 st0 inp ->+    let go !acc r k (st :: State# ParserState) = case r of+            Partial k'      -> Partial (\ inp' -> go (inp':acc) (k' inp') k st)+            Success _ inp' -> k st (r, reverse acc) inp'+            Failure _ inp' -> k st (r, reverse acc) inp'+        r0 = runRW# (\ s ->+                unsafeCoerce# (pa Failure (\ _ r -> Success r) (unsafeCoerce# s) inp))+    in go [inp] r0 k0 st0  -- | Return both the result of a parse and the portion of the input -- that was consumed while it was being parsed.@@ -223,10 +256,10 @@ {-# INLINE match #-} match p = do     (r, bss) <- runAndKeepTrack p-    Parser (\ _ k _ ->+    Parser (\ _ k s _ ->         case r of             Success r' inp'  -> let !consumed = V.dropR (V.length inp') (V.concat (reverse bss))-                                in k (consumed , r') inp'+                                in k s (consumed , r') inp'             Failure err inp' -> Failure err inp'             Partial _        -> error "Z.Data.Parser.Base.match: impossible") @@ -237,37 +270,50 @@ -- to attach custom error info. ensureN :: Int -> ParseError -> Parser () {-# INLINE ensureN #-}-ensureN n0 err = Parser $ \ kf k inp -> do+ensureN n0 err = Parser $ \ kf k s inp -> do     let l = V.length inp     if l >= n0-    then k () inp-    else Partial (ensureNPartial l inp kf k)+    then k s () inp+    else Partial (ensureNPartial l inp kf k s)   where     {-# INLINABLE ensureNPartial #-}-    ensureNPartial :: forall r. Int -> V.PrimVector Word8 -> (ParseError -> ParseStep r) -> (() -> ParseStep r) -> ParseStep r-    ensureNPartial l0 inp0 kf k =-        let go acc !l = \ inp -> do+    ensureNPartial :: forall r. Int -> V.PrimVector Word8 -> (ParseError -> ParseStep r)+                   -> (State# ParserState -> () -> ParseStep r)+                   -> State# ParserState -> ParseStep r+    ensureNPartial l0 inp0 kf k s0 =+        let go acc !l s = \ inp -> do                 let l' = V.length inp                 if l' == 0                 then kf err (V.concat (reverse (inp:acc)))                 else do                     let l'' = l + l'                     if l'' < n0-                    then Partial (go (inp:acc) l'')+                    then Partial (go (inp:acc) l'' s)                     else                         let !inp' = V.concat (reverse (inp:acc))-                        in k () inp'-        in go [inp0] l0+                        in k s () inp'+        in go [inp0] l0 s0 +-- | Get current input chunk, draw new chunk if neccessary. 'V.null' means EOF.+--+-- Note this is different from 'takeRemaining', 'currentChunk' only return what's+-- left in current input chunk.+currentChunk :: Parser V.Bytes+{-# INLINE currentChunk #-}+currentChunk =  Parser $ \ _ k s inp ->+    if V.null inp+    then Partial (\ inp' -> k s inp' V.empty)+    else k s inp V.empty+ -- | Test whether all input has been consumed, i.e. there are no remaining -- undecoded bytes. Fail if not 'atEnd'. endOfInput :: Parser () {-# INLINE endOfInput #-}-endOfInput = Parser $ \ kf k inp ->+endOfInput = Parser $ \ kf k s inp ->     if V.null inp     then Partial (\ inp' ->         if (V.null inp')-        then k () inp'+        then k s () inp'         else kf ["Z.Data.Parser.Base.endOfInput: end not reached yet"] inp)     else kf ["Z.Data.Parser.Base.endOfInput: end not reached yet"] inp @@ -275,10 +321,10 @@ -- undecoded bytes. atEnd :: Parser Bool {-# INLINE atEnd #-}-atEnd = Parser $ \ _ k inp ->+atEnd = Parser $ \ _ k s inp ->     if V.null inp-    then Partial (\ inp' -> k (V.null inp') inp')-    else k False inp+    then Partial (\ inp' -> k s (V.null inp') inp')+    else k s False inp  -- | Decode a primitive type in host byte order. decodePrim :: forall a. (Unaligned a) => Parser a@@ -297,9 +343,9 @@ {-# SPECIALIZE INLINE decodePrim :: Parser Float #-} decodePrim = do     ensureN n ["Z.Data.Parser.Base.decodePrim: not enough bytes"]-    Parser (\ _ k (V.PrimVector ba i len) ->+    Parser (\ _ k s (V.PrimVector ba i len) ->         let !r = indexPrimWord8ArrayAs ba i-        in k r (V.PrimVector ba (i+n) (len-n)))+        in k s r (V.PrimVector ba (i+n) (len-n)))   where     n = getUnalignedSize (unalignedSize @a) @@ -318,9 +364,9 @@ {-# SPECIALIZE INLINE decodePrimLE :: Parser Float #-} decodePrimLE = do     ensureN n ["Z.Data.Parser.Base.decodePrimLE: not enough bytes"]-    Parser (\ _ k (V.PrimVector ba i len) ->+    Parser (\ _ k s (V.PrimVector ba i len) ->         let !r = indexPrimWord8ArrayAs ba i-        in k (getLE r) (V.PrimVector ba (i+n) (len-n)))+        in k s (getLE r) (V.PrimVector ba (i+n) (len-n)))   where     n = getUnalignedSize (unalignedSize @(LE a)) @@ -339,9 +385,9 @@ {-# SPECIALIZE INLINE decodePrimBE :: Parser Float #-} decodePrimBE = do     ensureN n ["Z.Data.Parser.Base.decodePrimBE: not enough bytes"]-    Parser (\ _ k (V.PrimVector ba i len) ->+    Parser (\ _ k s (V.PrimVector ba i len) ->         let !r = indexPrimWord8ArrayAs ba i-        in k (getBE r) (V.PrimVector ba (i+n) (len-n)))+        in k s (getBE r) (V.PrimVector ba (i+n) (len-n)))   where     n = getUnalignedSize (unalignedSize @(BE a)) @@ -379,25 +425,26 @@ -- scanChunks :: forall s. s -> (s -> V.Bytes -> Either s (V.Bytes, V.Bytes, s)) -> Parser (V.Bytes, s) {-# INLINE scanChunks #-}-scanChunks s0 consume = Parser (\ _ k inp ->+scanChunks s0 consume = Parser (\ _ k st inp ->     case consume s0 inp of-        Right (want, rest, s') -> k (want, s') rest-        Left s' -> Partial (scanChunksPartial s' k inp))+        Right (want, rest, s') -> k st (want, s') rest+        Left s' -> Partial (scanChunksPartial s' k st inp))   where     -- we want to inline consume if possible     {-# INLINABLE scanChunksPartial #-}-    scanChunksPartial :: forall r. s -> ((V.PrimVector Word8, s) -> ParseStep r) -> V.PrimVector Word8 -> ParseStep r-    scanChunksPartial s0' k inp0 =-        let go s acc = \ inp ->+    scanChunksPartial :: forall r. s -> (State# ParserState -> (V.PrimVector Word8, s) -> ParseStep r)+                      -> State# ParserState -> V.PrimVector Word8 -> ParseStep r+    scanChunksPartial s0' k st0 inp0 =+        let go s acc st = \ inp ->                 if V.null inp-                then k (V.concat (reverse acc), s) inp+                then k st (V.concat (reverse acc), s) inp                 else case consume s inp of                         Left s' -> do                             let acc' = inp : acc-                            Partial (go s' acc')+                            Partial (go s' acc' st)                         Right (want,rest,s') ->-                            let !r = V.concat (reverse (want:acc)) in k (r, s') rest-        in go s0' [inp0]+                            let !r = V.concat (reverse (want:acc)) in k st (r, s') rest+        in go s0' [inp0] st0  -------------------------------------------------------------------------------- @@ -407,12 +454,12 @@ peekMaybe :: Parser (Maybe Word8) {-# INLINE peekMaybe #-} peekMaybe =-    Parser $ \ _ k inp ->+    Parser $ \ _ k s inp ->         if V.null inp-        then Partial (\ inp' -> k (if V.null inp'+        then Partial (\ inp' -> k s (if V.null inp'             then Nothing             else Just (V.unsafeHead inp)) inp')-        else k (Just (V.unsafeHead inp)) inp+        else k s (Just (V.unsafeHead inp)) inp  -- | Match any byte, to perform lookahead.  Does not consume any -- input, but will fail if end of input has been reached.@@ -420,13 +467,13 @@ peek :: Parser Word8 {-# INLINE peek #-} peek =-    Parser $ \ kf k inp ->+    Parser $ \ kf k s inp ->         if V.null inp         then Partial (\ inp' ->             if V.null inp'             then kf ["Z.Data.Parser.Base.peek: not enough bytes"] inp'-            else k (V.unsafeHead inp') inp')-        else k (V.unsafeHead inp) inp+            else k s (V.unsafeHead inp') inp')+        else k s (V.unsafeHead inp) inp  -- | The parser @satisfy p@ succeeds for any byte for which the -- predicate @p@ returns 'True'. Returns the byte that is actually@@ -439,11 +486,12 @@ {-# INLINE satisfy #-} satisfy p = do     ensureN 1 ["Z.Data.Parser.Base.satisfy: not enough bytes"]-    Parser $ \ kf k inp ->+    Parser $ \ kf k s inp ->         let w = V.unsafeHead inp         in if p w-            then k w (V.unsafeTail inp)-            else kf ["Z.Data.Parser.Base.satisfy: unsatisfied byte"] (V.unsafeTail inp)+            then k s w (V.unsafeTail inp)+            else kf [ "Z.Data.Parser.Base.satisfy: unsatisfied bytes " <> T.toText (V.take 8 inp) ]+                    (V.unsafeTail inp)  -- | The parser @satisfyWith f p@ transforms a byte, and succeeds if -- the predicate @p@ returns 'True' on the transformed value. The@@ -453,10 +501,10 @@ {-# INLINE satisfyWith #-} satisfyWith f p = do     ensureN 1 ["Z.Data.Parser.Base.satisfyWith: not enough bytes"]-    Parser $ \ kf k inp ->+    Parser $ \ kf k s inp ->         let a = f (V.unsafeHead inp)         in if p a-            then k a (V.unsafeTail inp)+            then k s a (V.unsafeTail inp)             else kf ["Z.Data.Parser.Base.satisfyWith: unsatisfied byte"] (V.unsafeTail inp)  -- | Match a specific byte.@@ -465,11 +513,18 @@ {-# INLINE word8 #-} word8 w' = do     ensureN 1 ["Z.Data.Parser.Base.word8: not enough bytes"]-    Parser (\ kf k inp ->+    Parser (\ kf k s inp ->         let w = V.unsafeHead inp         in if w == w'-            then k () (V.unsafeTail inp)-            else kf ["Z.Data.Parser.Base.word8: mismatch byte"] inp)+            then k s () (V.unsafeTail inp)+            else kf [ T.concat [+                 "Z.Data.Parser.Base.word8: mismatch byte, expected "+                , T.toText w'+                , ", meet "+                , T.toText w+                , " at "+                , T.toText (V.take 8 inp)+                ] ] inp)  -- | Return a byte, this is an alias to @decodePrim @Word8@. --@@ -508,10 +563,8 @@ anyChar7 :: Parser Char {-# INLINE anyChar7 #-} anyChar7 = do-    w <- anyWord8-    if w > 0x7f-    then fail' "Z.Data.Parser.anyChar7: byte exceeds 0x7F"-    else return $! w2c w+    w <- satisfy (<= 0x7f)+    return $! w2c w  -- | Decode next few bytes as an UTF8 char. --@@ -519,18 +572,17 @@ anyCharUTF8 :: Parser Char {-# INLINABLE anyCharUTF8 #-} anyCharUTF8 = do-    r <- Parser $ \ kf k inp -> do-        let (V.PrimVector arr s l) = inp+    r <- Parser $ \ kf k st inp@(V.PrimVector arr s l) -> do         if l > 0         then             let l' = T.decodeCharLen arr s             in if l' > l-            then k (Left l') inp+            then k st (Left l') inp             else do                 case T.validateMaybe (V.unsafeTake l' inp) of-                    Just t -> k (Right $! T.head t) $! V.unsafeDrop l' inp+                    Just t -> k st (Right $! T.head t) $! V.unsafeDrop l' inp                     _ -> kf ["Z.Data.Parser.Base.anyCharUTF8: invalid UTF8 bytes"] inp-        else k (Left 1) inp+        else k st (Left 1) inp     case r of         Left d -> do             ensureN d ["Z.Data.Parser.Base.anyCharUTF8: not enough bytes"]@@ -546,8 +598,15 @@     case w of         10 -> return ()         13 -> word8 10-        _  -> fail' "Z.Data.Parser.Base.endOfLine: mismatch byte" +        _  -> Parser (\ kf _ _ inp -> kf [+            T.concat [+             "Z.Data.Parser.Base.endOfLine: mismatch byte, expected 10 or 13, meet "+            , T.toText w+            , " at "+            , T.toText (V.cons w (V.take 8 inp))+            ] ] inp)+ --------------------------------------------------------------------------------  -- | 'skip' N bytes.@@ -555,60 +614,61 @@ skip :: Int -> Parser () {-# INLINE skip #-} skip n =-    Parser (\ kf k inp ->+    Parser (\ kf k s inp ->         let l = V.length inp             !n' = max n 0         in if l >= n'-            then k () $! V.unsafeDrop n' inp-            else Partial (skipPartial (n'-l) kf k))+            then k s () $! V.unsafeDrop n' inp+            else Partial (skipPartial (n'-l) kf k s)) -skipPartial :: Int -> (ParseError -> ParseStep r) -> (() -> ParseStep r) -> ParseStep r+skipPartial :: Int -> (ParseError -> ParseStep r) -> (State# ParserState -> () -> ParseStep r)+            -> State# ParserState -> ParseStep r {-# INLINABLE skipPartial #-}-skipPartial n kf k =-    let go !n' = \ inp ->+skipPartial n kf k s0 =+    let go !n' s = \ inp ->             let l = V.length inp             in if l >= n'-                then k () $! V.unsafeDrop n' inp+                then k s () $! V.unsafeDrop n' inp                 else if l == 0                     then kf ["Z.Data.Parser.Base.skip: not enough bytes"] inp-                    else Partial (go (n'-l))-    in go n+                    else Partial (go (n'-l) s)+    in go n s0  -- | Skip a byte. -- skipWord8 :: Parser () {-# INLINE skipWord8 #-} skipWord8 =-    Parser $ \ kf k inp ->+    Parser $ \ kf k s inp ->         if V.null inp         then Partial (\ inp' ->             if V.null inp'             then kf ["Z.Data.Parser.Base.skipWord8: not enough bytes"] inp'-            else k () (V.unsafeTail inp'))-        else k () (V.unsafeTail inp)+            else k s () (V.unsafeTail inp'))+        else k s () (V.unsafeTail inp)  -- | Skip past input for as long as the predicate returns 'True'. -- skipWhile :: (Word8 -> Bool) -> Parser () {-# INLINE skipWhile #-} skipWhile p =-    Parser (\ _ k inp ->+    Parser (\ _ k s inp ->         let rest = V.dropWhile p inp         in if V.null rest-            then Partial (skipWhilePartial k)-            else k () rest)+            then Partial (skipWhilePartial k s)+            else k s () rest)   where     -- we want to inline p if possible     {-# INLINABLE skipWhilePartial #-}-    skipWhilePartial :: forall r. (() -> ParseStep r) -> ParseStep r-    skipWhilePartial k =-        let go = \ inp ->+    skipWhilePartial :: forall r. (State# ParserState -> () -> ParseStep r) -> State# ParserState -> ParseStep r+    skipWhilePartial k s0 =+        let go s = \ inp ->                 if V.null inp-                then k () inp+                then k s () inp                 else                     let !rest = V.dropWhile p inp-                    in if V.null rest then Partial go else k () rest-        in go+                    in if V.null rest then Partial (go s) else k s () rest+        in go s0  -- | Skip over white space using 'isSpace'. --@@ -621,10 +681,10 @@ take n = do     -- we use unsafe slice, guard negative n here     ensureN n' ["Z.Data.Parser.Base.take: not enough bytes"]-    Parser (\ _ k inp ->+    Parser (\ _ k s inp ->         let !r = V.unsafeTake n' inp             !inp' = V.unsafeDrop n' inp-        in k r inp')+        in k s r inp')   where !n' = max 0 n  -- | Consume input as long as the predicate returns 'False' or reach the end of input,@@ -632,51 +692,53 @@ -- takeTill :: (Word8 -> Bool) -> Parser V.Bytes {-# INLINE takeTill #-}-takeTill p = Parser (\ _ k inp ->+takeTill p = Parser (\ _ k s inp ->     let (want, rest) = V.break p inp     in if V.null rest-        then Partial (takeTillPartial k want)-        else k want rest)+        then Partial (takeTillPartial k s want)+        else k s want rest)   where     {-# INLINABLE takeTillPartial #-}-    takeTillPartial :: forall r. (V.PrimVector Word8 -> ParseStep r) -> V.PrimVector Word8 -> ParseStep r-    takeTillPartial k want =-        let go acc = \ inp ->+    takeTillPartial :: forall r. (State# ParserState -> V.PrimVector Word8 -> ParseStep r)+                    -> State# ParserState -> V.PrimVector Word8 -> ParseStep r+    takeTillPartial k s0 want =+        let go acc s = \ inp ->                 if V.null inp-                then let !r = V.concat (reverse acc) in k r inp+                then let !r = V.concat (reverse acc) in k s r inp                 else                     let (want', rest) = V.break p inp                         acc' = want' : acc                     in if V.null rest-                        then Partial (go acc')-                        else let !r = V.concat (reverse acc') in k r rest-        in go [want]+                        then Partial (go acc' s)+                        else let !r = V.concat (reverse acc') in k s r rest+        in go [want] s0  -- | Consume input as long as the predicate returns 'True' or reach the end of input, -- and return the consumed input. -- takeWhile :: (Word8 -> Bool) -> Parser V.Bytes {-# INLINE takeWhile #-}-takeWhile p = Parser (\ _ k inp ->+takeWhile p = Parser (\ _ k s inp ->     let (want, rest) = V.span p inp     in if V.null rest-        then Partial (takeWhilePartial k want)-        else k want rest)+        then Partial (takeWhilePartial k s want)+        else k s want rest)   where     -- we want to inline p if possible     {-# INLINABLE takeWhilePartial #-}-    takeWhilePartial :: forall r. (V.PrimVector Word8 -> ParseStep r) -> V.PrimVector Word8 -> ParseStep r-    takeWhilePartial k want =-        let go acc = \ inp ->+    takeWhilePartial :: forall r. (State# ParserState -> V.PrimVector Word8 -> ParseStep r)+                     -> State# ParserState -> V.PrimVector Word8 -> ParseStep r+    takeWhilePartial k s0 want =+        let go acc s = \ inp ->                 if V.null inp-                then let !r = V.concat (reverse acc) in k r inp+                then let !r = V.concat (reverse acc) in k s r inp                 else                     let (want', rest) = V.span p inp                         acc' = want' : acc                     in if V.null rest-                        then Partial (go acc')-                        else let !r = V.concat (reverse acc') in k r rest-        in go [want]+                        then Partial (go acc' s)+                        else let !r = V.concat (reverse acc') in k s r rest+        in go [want] s0  -- | Similar to 'takeWhile', but requires the predicate to succeed on at least one byte -- of input: it will fail if the predicate never returns 'True' or reach the end of input@@ -686,22 +748,25 @@ takeWhile1 p = do     bs <- takeWhile p     if V.null bs-    then fail' "Z.Data.Parser.Base.takeWhile1: no satisfied byte"+    then Parser (\ kf _ _ inp ->+            kf ["Z.Data.Parser.Base.takeWhile1: no satisfied byte at " <> T.toText (V.take 10 inp) ]+               inp)     else return bs  -- | Take all the remaining input chunks and return as 'V.Bytes'. takeRemaining :: Parser V.Bytes {-# INLINE takeRemaining #-}-takeRemaining = Parser (\ _ k inp -> Partial (takeRemainingPartial k inp))+takeRemaining = Parser (\ _ k s inp -> Partial (takeRemainingPartial k s inp))   where     {-# INLINABLE takeRemainingPartial #-}-    takeRemainingPartial :: forall r. (V.PrimVector Word8 -> ParseStep r) -> V.PrimVector Word8 -> ParseStep r-    takeRemainingPartial k want =-        let go acc = \ inp ->+    takeRemainingPartial :: forall r. (State# ParserState -> V.PrimVector Word8 -> ParseStep r)+                         -> State# ParserState -> V.PrimVector Word8 -> ParseStep r+    takeRemainingPartial k s0 want =+        let go acc s = \ inp ->                 if V.null inp-                then let !r = V.concat (reverse acc) in k r inp-                else let acc' = inp : acc in Partial (go acc')-        in go [want]+                then let !r = V.concat (reverse acc) in k s r inp+                else let acc' = inp : acc in Partial (go acc' s)+        in go [want] s0  -- | Similar to 'take', but requires the predicate to succeed on next N bytes -- of input, and take N bytes(no matter if N+1 byte satisfy predicate or not).@@ -712,7 +777,10 @@     bs <- take n     if go bs 0     then return bs-    else fail' "Z.Data.Parser.Base.takeWhileN: byte does not satisfy"+    else Parser (\ kf _ _ inp ->+        kf [ "Z.Data.Parser.Base.takeN: byte does not satisfy at " <> T.toText (bs <> V.take 10 inp) ]+            inp)+   where     go bs@(V.PrimVector _ _ l) !i         | i < l = p (V.unsafeIndex bs i) && go bs (i+1)@@ -725,10 +793,15 @@ bytes bs = do     let n = V.length bs     ensureN n ["Z.Data.Parser.Base.bytes: not enough bytes"]-    Parser (\ kf k inp ->+    Parser (\ kf k s inp ->         if bs == V.unsafeTake n inp-        then k () $! V.unsafeDrop n inp-        else kf ["Z.Data.Parser.Base.bytes: mismatch bytes"] inp)+        then k s () $! V.unsafeDrop n inp+        else kf [ T.concat [+             "Z.Data.Parser.Base.bytes: mismatch bytes, expected "+            , T.toText bs+            , ", meet "+            , T.toText (V.take n inp)+            ] ] inp)   -- | Same as 'bytes' but ignoring ASCII case.@@ -738,10 +811,16 @@     let n = V.length bs     -- casefold an ASCII string should not change it's length     ensureN n ["Z.Data.Parser.Base.bytesCI: not enough bytes"]-    Parser (\ kf k inp ->+    Parser (\ kf k s inp ->         if bs' == CI.foldCase (V.unsafeTake n inp)-        then k () $! V.unsafeDrop n inp-        else kf ["Z.Data.Parser.Base.bytesCI: mismatch bytes"] inp)+        then k s () $! V.unsafeDrop n inp+        else kf [ T.concat [+             "Z.Data.Parser.Base.bytesCI: mismatch bytes, expected "+            , T.toText bs+            , "(case insensitive), meet "+            , T.toText (V.take n inp)+            ] ] inp)+   where     bs' = CI.foldCase bs 

@@ -114,8 +114,6 @@   , c_ascii_validate_addr  ) where -#define DOUBLE_QUOTE 34- import           Control.DeepSeq import           Control.Exception import           Control.Monad.ST@@ -136,7 +134,7 @@ import           GHC.Stack import           GHC.CString               (unpackCString#, unpackCStringUtf8#) import           Z.Data.Array-import           Z.Data.ASCII              (c2w)+import           Z.Data.ASCII              (c2w, pattern DOUBLE_QUOTE) import           Z.Data.Text.UTF8Codec import           Z.Data.Text.UTF8Rewind import           Z.Data.Vector.Base        (Bytes, PrimVector(..), c_strlen)

@@ -536,7 +536,7 @@ type Bytes = PrimVector Word8  -- | This instance use 'packASCII', which may silently chop bytes, use it with ASCII literals only.-instance (a ~ Word8) => IsString (PrimVector a) where+instance IsString Bytes where     {-# INLINE fromString #-}     fromString = packASCII