megaparsec 9.2.2 → 9.3.0
raw patch · 7 files changed
+495/−138 lines, 7 files
Files
- CHANGELOG.md +18/−0
- Text/Megaparsec.hs +1/−1
- Text/Megaparsec/Char/Lexer.hs +2/−3
- Text/Megaparsec/Debug.hs +219/−73
- Text/Megaparsec/Internal.hs +31/−28
- Text/Megaparsec/Stream.hs +223/−32
- megaparsec.cabal +1/−1
CHANGELOG.md view
@@ -1,5 +1,23 @@ *Megaparsec follows [SemVer](https://semver.org/).* +## Megaparsec 9.3.0++* Now `label` can override more than one group of hints in the parser it+ wraps. [Issue 482](https://github.com/mrkkrp/megaparsec/issues/482).++* `takeP n` now returns the empty chunk of the input stream when `n` is+ negative, similar to when `n == 0`. [Issue+ 497](https://github.com/mrkkrp/megaparsec/issues/497).++* Added the `MonadParsecDbg` type class in `Text.Megaparsec.Debug`. The type+ class allows us to use `dbg` in MTL monad transformers. [Issue+ 488](https://github.com/mrkkrp/megaparsec/issues/488).++* Introduced the `ShareInput` and `NoShareInput` newtype wrappers in+ `Text.Megaparsec.Stream` in order to allow the user to choose how the+ input should be sliced and shared during the parsing. [Issue+ 492](https://github.com/mrkkrp/megaparsec/issues/492).+ ## Megaparsec 9.2.2 * Fixed a space leak in the implementations of the `reachOffset` and
Text/Megaparsec.hs view
@@ -370,7 +370,7 @@ -- wrapper. This applies to both normal and delayed 'ParseError's. -- -- As a side-effect of the implementation the inner computation will start--- with empty collection of delayed errors and they will be updated and+-- with an empty collection of delayed errors and they will be updated and -- “restored” on the way out of 'region'. -- -- @since 5.3.0
Text/Megaparsec/Char/Lexer.hs view
@@ -229,9 +229,8 @@ -- the “reference” token. The reference token can influence parsing, see -- 'IndentOpt' for more information. ----- Tokens /must not/ consume newlines after them. On the other hand, the--- first argument of this function /must/ consume newlines among other white--- space characters.+-- __Note__: the first argument of this function /must/ consume newlines+-- among other white space characters. -- -- @since 4.3.0 indentBlock ::
Text/Megaparsec/Debug.hs view
@@ -1,4 +1,6 @@ {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE Unsafe #-} @@ -15,103 +17,227 @@ -- -- @since 7.0.0 module Text.Megaparsec.Debug- ( dbg,+ ( MonadParsecDbg (..), dbg', ) where +import Control.Monad.Identity (IdentityT, mapIdentityT)+import qualified Control.Monad.Trans.RWS.Lazy as L+import qualified Control.Monad.Trans.RWS.Strict as S+import qualified Control.Monad.Trans.Reader as L+import qualified Control.Monad.Trans.State.Lazy as L+import qualified Control.Monad.Trans.State.Strict as S+import qualified Control.Monad.Trans.Writer.Lazy as L+import qualified Control.Monad.Trans.Writer.Strict as S+import Data.Bifunctor (Bifunctor (first)) import qualified Data.List.NonEmpty as NE import Data.Proxy import Debug.Trace+import Text.Megaparsec.Class (MonadParsec) import Text.Megaparsec.Error import Text.Megaparsec.Internal import Text.Megaparsec.State import Text.Megaparsec.Stream --- | @'dbg' label p@ parser works exactly like @p@, but when it's evaluated--- it prints information useful for debugging. The @label@ is only used to--- refer to this parser in the debugging output. This combinator uses the--- 'trace' function from "Debug.Trace" under the hood.+-- | Type class describing parser monads that can trace during evaluation. ----- Typical usage is to wrap every sub-parser in misbehaving parser with--- 'dbg' assigning meaningful labels. Then give it a shot and go through the--- print-out. As of current version, this combinator prints all available--- information except for /hints/, which are probably only interesting to--- the maintainer of Megaparsec itself and may be quite verbose to output in--- general. Let me know if you would like to be able to see hints in the--- debugging output.+-- @since 9.3.0+class MonadParsec e s m => MonadParsecDbg e s m where+ -- | @'dbg' label p@ parser works exactly like @p@, but when it's evaluated+ -- it prints information useful for debugging. The @label@ is only used to+ -- refer to this parser in the debugging output. This combinator uses the+ -- 'trace' function from "Debug.Trace" under the hood.+ --+ -- Typical usage is to wrap every sub-parser in misbehaving parser with+ -- 'dbg' assigning meaningful labels. Then give it a shot and go through the+ -- print-out. As of current version, this combinator prints all available+ -- information except for /hints/, which are probably only interesting to+ -- the maintainer of Megaparsec itself and may be quite verbose to output in+ -- general. Let me know if you would like to be able to see hints in the+ -- debugging output.+ --+ -- The output itself is pretty self-explanatory, although the following+ -- abbreviations should be clarified (they are derived from the low-level+ -- source code):+ --+ -- * @COK@—“consumed OK”. The parser consumed input and succeeded.+ -- * @CERR@—“consumed error”. The parser consumed input and failed.+ -- * @EOK@—“empty OK”. The parser succeeded without consuming input.+ -- * @EERR@—“empty error”. The parser failed without consuming input.+ --+ -- __Note__: up until the version /9.3.0/ this was a non-polymorphic+ -- function that worked only in 'ParsecT'. It was first introduced in the+ -- version /7.0.0/.+ dbg ::+ Show a =>+ -- | Debugging label+ String ->+ -- | Parser to debug+ m a ->+ -- | Parser that prints debugging messages+ m a++-- | @dbg (p :: StateT st m)@ prints state __after__ running @p@: ----- The output itself is pretty self-explanatory, although the following--- abbreviations should be clarified (they are derived from the low-level--- source code):+-- >>> p = modify succ >> dbg "a" (single 'a' >> modify succ)+-- >>> parseTest (runStateT p 0) "a"+-- a> IN: 'a'+-- a> MATCH (COK): 'a'+-- a> VALUE: () (STATE: 2)+-- ((),2)+instance+ (Show st, MonadParsecDbg e s m) =>+ MonadParsecDbg e s (L.StateT st m)+ where+ dbg str sma = L.StateT $ \s ->+ dbgWithComment "STATE" str $ L.runStateT sma s++-- | @dbg (p :: StateT st m)@ prints state __after__ running @p@: ----- * @COK@—“consumed OK”. The parser consumed input and succeeded.--- * @CERR@—“consumed error”. The parser consumed input and failed.--- * @EOK@—“empty OK”. The parser succeeded without consuming input.--- * @EERR@—“empty error”. The parser failed without consuming input.+-- >>> p = modify succ >> dbg "a" (single 'a' >> modify succ)+-- >>> parseTest (runStateT p 0) "a"+-- a> IN: 'a'+-- a> MATCH (COK): 'a'+-- a> VALUE: () (STATE: 2)+-- ((),2)+instance+ (Show st, MonadParsecDbg e s m) =>+ MonadParsecDbg e s (S.StateT st m)+ where+ dbg str sma = S.StateT $ \s ->+ dbgWithComment "STATE" str $ S.runStateT sma s++instance+ MonadParsecDbg e s m =>+ MonadParsecDbg e s (L.ReaderT r m)+ where+ dbg = L.mapReaderT . dbg++-- | @dbg (p :: WriterT st m)@ prints __only__ log produced by @p@: ----- Finally, it's not possible to lift this function into some monad--- transformers without introducing surprising behavior (e.g. unexpected--- state backtracking) or adding otherwise redundant constraints (e.g.--- 'Show' instance for state), so this helper is only available for--- 'ParsecT' monad, not any instance of 'Text.Megaparsec.MonadParsec' in--- general.-dbg ::- forall e s m a.- ( VisualStream s,- ShowErrorComponent e,- Show a- ) =>- -- | Debugging label- String ->- -- | Parser to debug- ParsecT e s m a ->- -- | Parser that prints debugging messages- ParsecT e s m a-dbg lbl p = ParsecT $ \s cok cerr eok eerr ->- let l = dbgLog lbl :: DbgItem s e a -> String- unfold = streamTake 40- cok' x s' hs =- flip trace (cok x s' hs) $- l (DbgIn (unfold (stateInput s)))- ++ l (DbgCOK (streamTake (streamDelta s s') (stateInput s)) x)- cerr' err s' =- flip trace (cerr err s') $- l (DbgIn (unfold (stateInput s)))- ++ l (DbgCERR (streamTake (streamDelta s s') (stateInput s)) err)- eok' x s' hs =- flip trace (eok x s' hs) $- l (DbgIn (unfold (stateInput s)))- ++ l (DbgEOK (streamTake (streamDelta s s') (stateInput s)) x)- eerr' err s' =- flip trace (eerr err s') $- l (DbgIn (unfold (stateInput s)))- ++ l (DbgEERR (streamTake (streamDelta s s') (stateInput s)) err)- in unParser p s cok' cerr' eok' eerr'+-- >>> p = tell [0] >> dbg "a" (single 'a' >> tell [1])+-- >>> parseTest (runWriterT p) "a"+-- a> IN: 'a'+-- a> MATCH (COK): 'a'+-- a> VALUE: () (LOG: [1])+-- ((),[0,1])+instance+ (Monoid w, Show w, MonadParsecDbg e s m) =>+ MonadParsecDbg e s (L.WriterT w m)+ where+ dbg str wma = L.WriterT $ dbgWithComment "LOG" str $ L.runWriterT wma --- | Just like 'dbg', but doesn't require the return value of the parser to--- be 'Show'-able.+-- | @dbg (p :: WriterT st m)@ prints __only__ log produced by @p@: ----- @since 9.1.0-dbg' ::- forall e s m a.- ( VisualStream s,- ShowErrorComponent e- ) =>- -- | Debugging label+-- >>> p = tell [0] >> dbg "a" (single 'a' >> tell [1])+-- >>> parseTest (runWriterT p) "a"+-- a> IN: 'a'+-- a> MATCH (COK): 'a'+-- a> VALUE: () (LOG: [1])+-- ((),[0,1])+instance+ (Monoid w, Show w, MonadParsecDbg e s m) =>+ MonadParsecDbg e s (S.WriterT w m)+ where+ dbg str wma = S.WriterT $ dbgWithComment "LOG" str $ S.runWriterT wma++-- | @RWST@ works like @StateT@ inside a @WriterT@: subparser's log and its+-- final state is printed:+--+-- >>> p = tell [0] >> modify succ >> dbg "a" (single 'a' >> tell [1] >> modify succ)+-- >>> parseTest (runRWST p () 0) "a"+-- a> IN: 'a'+-- a> MATCH (COK): 'a'+-- a> VALUE: () (STATE: 2) (LOG: [1])+-- ((),2,[0,1])+instance+ (Monoid w, Show w, Show st, MonadParsecDbg e s m) =>+ MonadParsecDbg e s (L.RWST r w st m)+ where+ dbg str sma = L.RWST $ \r s -> do+ let smth =+ (\(a, st, w) -> ShowComment "LOG" (ShowComment "STATE" (a, st), w))+ <$> L.runRWST sma r s+ ((a, st), w) <- first unComment . unComment <$> dbg str smth+ pure (a, st, w)++-- | @RWST@ works like @StateT@ inside a @WriterT@: subparser's log and its+-- final state is printed:+--+-- >>> p = tell [0] >> modify succ >> dbg "a" (single 'a' >> tell [1] >> modify succ)+-- >>> parseTest (runRWST p () 0) "a"+-- a> IN: 'a'+-- a> MATCH (COK): 'a'+-- a> VALUE: () (STATE: 2) (LOG: [1])+-- ((),2,[0,1])+instance+ (Monoid w, Show w, Show st, MonadParsecDbg e s m) =>+ MonadParsecDbg e s (S.RWST r w st m)+ where+ dbg str sma = S.RWST $ \r s -> do+ let smth =+ (\(a, st, w) -> ShowComment "LOG" (ShowComment "STATE" (a, st), w))+ <$> S.runRWST sma r s+ ((a, st), w) <- first unComment . unComment <$> dbg str smth+ pure (a, st, w)++instance MonadParsecDbg e s m => MonadParsecDbg e s (IdentityT m) where+ dbg = mapIdentityT . dbg++-- | @'dbgWithComment' label_a label_c m@ traces the first component of the+-- result produced by @m@ with @label_a@ and the second component with+-- @label_b@.+dbgWithComment ::+ (MonadParsecDbg e s m, Show a, Show c) =>+ -- | Debugging label (for @a@) String ->+ -- | Extra component label (for @c@)+ String -> -- | Parser to debug- ParsecT e s m a ->+ m (a, c) -> -- | Parser that prints debugging messages- ParsecT e s m a-dbg' lbl p = unBlind <$> dbg lbl (Blind <$> p)+ m (a, c)+dbgWithComment lbl str ma =+ unComment <$> dbg str (ShowComment lbl <$> ma) --- | A wrapper type with a dummy 'Show' instance.-newtype Blind x = Blind {unBlind :: x}+-- | A wrapper with a special show instance:+--+-- >>> show (ShowComment "STATE" ("Hello, world!", 42))+-- Hello, world! (STATE: 42)+data ShowComment c a = ShowComment String (a, c) -instance Show (Blind x) where- show _ = "NOT SHOWN"+unComment :: ShowComment c a -> (a, c)+unComment (ShowComment _ val) = val +instance (Show c, Show a) => Show (ShowComment c a) where+ show (ShowComment lbl (a, c)) = show a ++ " (" ++ lbl ++ ": " ++ show c ++ ")"++instance+ (VisualStream s, ShowErrorComponent e) =>+ MonadParsecDbg e s (ParsecT e s m)+ where+ dbg lbl p = ParsecT $ \s cok cerr eok eerr ->+ let l = dbgLog lbl+ unfold = streamTake 40+ cok' x s' hs =+ flip trace (cok x s' hs) $+ l (DbgIn (unfold (stateInput s)))+ ++ l (DbgCOK (streamTake (streamDelta s s') (stateInput s)) x)+ cerr' err s' =+ flip trace (cerr err s') $+ l (DbgIn (unfold (stateInput s)))+ ++ l (DbgCERR (streamTake (streamDelta s s') (stateInput s)) err)+ eok' x s' hs =+ flip trace (eok x s' hs) $+ l (DbgIn (unfold (stateInput s)))+ ++ l (DbgEOK (streamTake (streamDelta s s') (stateInput s)) x)+ eerr' err s' =+ flip trace (eerr err s') $+ l (DbgIn (unfold (stateInput s)))+ ++ l (DbgEERR (streamTake (streamDelta s s') (stateInput s)) err)+ in unParser p s cok' cerr' eok' eerr'+ -- | A single piece of info to be rendered with 'dbgLog'. data DbgItem s e a = DbgIn [Token s]@@ -172,3 +298,23 @@ case fst <$> takeN_ n s of Nothing -> [] Just chk -> chunkToTokens (Proxy :: Proxy s) chk++-- | Just like 'dbg', but doesn't require the return value of the parser to+-- be 'Show'-able.+--+-- @since 9.1.0+dbg' ::+ MonadParsecDbg e s m =>+ -- | Debugging label+ String ->+ -- | Parser to debug+ m a ->+ -- | Parser that prints debugging messages+ m a+dbg' lbl p = unBlind <$> dbg lbl (Blind <$> p)++-- | A wrapper type with a dummy 'Show' instance.+newtype Blind x = Blind {unBlind :: x}++instance Show (Blind x) where+ show _ = "NOT SHOWN"
Text/Megaparsec/Internal.hs view
@@ -36,7 +36,7 @@ toHints, withHints, accHints,- refreshLastHint,+ refreshHints, runParsecT, withParsecT, )@@ -85,12 +85,12 @@ -- 1:2: -- unexpected 'a' -- expecting 'r' or end of input-newtype Hints t = Hints [Set (ErrorItem t)]+newtype Hints t = Hints (Set (ErrorItem t)) -instance Semigroup (Hints t) where+instance Ord t => Semigroup (Hints t) where Hints xs <> Hints ys = Hints $ xs <> ys -instance Monoid (Hints t) where+instance Ord t => Monoid (Hints t) where mempty = Hints mempty -- | All information available after parsing. This includes consumption of@@ -170,7 +170,7 @@ p1 *> p2 = p1 `pBind` const p2 p1 <* p2 = do x1 <- p1; void p2; return x1 -pPure :: a -> ParsecT e s m a+pPure :: Stream s => a -> ParsecT e s m a pPure x = ParsecT $ \s _ _ eok _ -> eok x s mempty {-# INLINE pPure #-} @@ -267,7 +267,7 @@ runParsecT p s `catchError` \e -> runParsecT (h e) s -mkPT :: Monad m => (State s e -> m (Reply e s a)) -> ParsecT e s m a+mkPT :: (Stream s, Monad m) => (State s e -> m (Reply e s a)) -> ParsecT e s m a mkPT k = ParsecT $ \s cok cerr eok eerr -> do (Reply s' consumption result) <- k s case consumption of@@ -364,9 +364,9 @@ let el = Label <$> NE.nonEmpty l cok' x s' hs = case el of- Nothing -> cok x s' (refreshLastHint hs Nothing)+ Nothing -> cok x s' (refreshHints hs Nothing) Just _ -> cok x s' hs- eok' x s' hs = eok x s' (refreshLastHint hs el)+ eok' x s' hs = eok x s' (refreshHints hs el) eerr' err = eerr $ case err of (TrivialError pos us _) ->@@ -381,7 +381,7 @@ in unParser p s cok eerr' eok eerr' {-# INLINE pTry #-} -pLookAhead :: ParsecT e s m a -> ParsecT e s m a+pLookAhead :: Stream s => ParsecT e s m a -> ParsecT e s m a pLookAhead p = ParsecT $ \s _ cerr eok eerr -> let eok' a _ _ = eok a s mempty in unParser p s eok' cerr eok' eerr@@ -504,7 +504,7 @@ hs = case ml >>= NE.nonEmpty of Nothing -> mempty- Just l -> (Hints . pure . E.singleton . Label) l+ Just l -> (Hints . E.singleton . Label) l in if chunkEmpty pxy ts then eok ts (State input' (o + len) pst de) hs else cok ts (State input' (o + len) pst de) hs@@ -524,7 +524,7 @@ hs = case el of Nothing -> mempty- Just l -> (Hints . pure . E.singleton) l+ Just l -> (Hints . E.singleton) l in if chunkEmpty pxy ts then let us = pure $@@ -544,8 +544,9 @@ Maybe String -> Int -> ParsecT e s m (Tokens s)-pTakeP ml n = ParsecT $ \s@(State input o pst de) cok _ _ eerr ->- let pxy = Proxy :: Proxy s+pTakeP ml n' = ParsecT $ \s@(State input o pst de) cok _ _ eerr ->+ let n = max 0 n'+ pxy = Proxy :: Proxy s el = Label <$> (ml >>= NE.nonEmpty) ps = maybe E.empty E.singleton el in case takeN_ n input of@@ -561,11 +562,11 @@ else cok ts (State input' (o + len) pst de) mempty {-# INLINE pTakeP #-} -pGetParserState :: ParsecT e s m (State s e)+pGetParserState :: Stream s => ParsecT e s m (State s e) pGetParserState = ParsecT $ \s _ _ eok _ -> eok s s mempty {-# INLINE pGetParserState #-} -pUpdateParserState :: (State s e -> State s e) -> ParsecT e s m ()+pUpdateParserState :: Stream s => (State s e -> State s e) -> ParsecT e s m () pUpdateParserState f = ParsecT $ \s _ _ eok _ -> eok () (f s) mempty {-# INLINE pUpdateParserState #-} @@ -591,7 +592,7 @@ -- there might have been backtracking with 'try' and in that case we -- must not convert such a parse error to hints. if streamPos == errOffset- then Hints (if E.null ps then [] else [ps])+ then Hints (if E.null ps then E.empty else ps) else mempty FancyError _ _ -> mempty {-# INLINE toHints #-}@@ -613,30 +614,32 @@ m b withHints (Hints ps') c e = case e of- TrivialError pos us ps -> c (TrivialError pos us (E.unions (ps : ps')))+ TrivialError pos us ps -> c (TrivialError pos us (E.union ps ps')) _ -> c e {-# INLINE withHints #-} -- | @'accHints' hs c@ results in “OK” continuation that will add given -- hints @hs@ to third argument of original continuation @c@. accHints ::+ Stream s => -- | 'Hints' to add- Hints t ->+ Hints (Token s) -> -- | An “OK” continuation to alter- (a -> State s e -> Hints t -> m b) ->+ (a -> State s e -> Hints (Token s) -> m b) -> -- | Altered “OK” continuation- (a -> State s e -> Hints t -> m b)+ (a -> State s e -> Hints (Token s) -> m b) accHints hs1 c x s hs2 = c x s (hs1 <> hs2) {-# INLINE accHints #-} --- | Replace the most recent group of hints (if any) with the given--- 'ErrorItem' (or delete it if 'Nothing' is given). This is used in the--- 'label' primitive.-refreshLastHint :: Hints t -> Maybe (ErrorItem t) -> Hints t-refreshLastHint (Hints []) _ = Hints []-refreshLastHint (Hints (_ : xs)) Nothing = Hints xs-refreshLastHint (Hints (_ : xs)) (Just m) = Hints (E.singleton m : xs)-{-# INLINE refreshLastHint #-}+-- | Replace the hints with the given 'ErrorItem' (or delete it if 'Nothing'+-- is given). This is used in the 'label' primitive.+refreshHints :: Hints t -> Maybe (ErrorItem t) -> Hints t+refreshHints (Hints _) Nothing = Hints E.empty+refreshHints (Hints hs) (Just m) =+ if E.null hs+ then Hints hs+ else Hints (E.singleton m)+{-# INLINE refreshHints #-} -- | Low-level unpacking of the 'ParsecT' type. runParsecT ::
Text/Megaparsec/Stream.hs view
@@ -7,6 +7,7 @@ {-# LANGUAGE Safe #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-} -- | -- Module : Text.Megaparsec.Stream@@ -25,11 +26,14 @@ -- @since 6.0.0 module Text.Megaparsec.Stream ( Stream (..),+ ShareInput (..),+ NoShareInput (..), VisualStream (..), TraversableStream (..), ) where +import Data.Bifunctor (second) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Lazy as BL@@ -50,6 +54,12 @@ -- | Type class for inputs that can be consumed by the library. --+-- Note that the 'Stream' instances for 'Text' and 'ByteString' (strict and+-- lazy) default to "input sharing" (see 'ShareInput', 'NoShareInput'). We plan+-- to move away from input sharing in a future major release; if you want to+-- retain the current behaviour and are concerned with maximum performance you+-- should consider using the 'ShareInput' wrapper explicitly.+-- -- __Note__: before the version /9.0.0/ the class included the methods from -- 'VisualStream' and 'TraversableStream'. class (Ord (Token s), Ord (Tokens s)) => Stream s where@@ -154,65 +164,246 @@ | otherwise = Just (S.splitAt n s) takeWhile_ = S.spanl -instance Stream B.ByteString where- type Token B.ByteString = Word8- type Tokens B.ByteString = B.ByteString+-- | This wrapper selects the input-sharing 'Stream' implementation for+-- 'T.Text' ('TL.Text') and 'B.ByteString' ('BL.ByteString'). By input+-- sharing we mean that our parsers will use slices whenever possible to+-- avoid having to copy parts of the input. See also the documentation of+-- 'T.split'.+--+-- Note that using slices is in general faster than copying; on the other+-- hand it also has the potential for causing surprising memory leaks: if+-- any slice of the input survives in the output, holding on to the output+-- will force the entire input 'T.Text'/'B.ByteString' to stay in memory!+-- Even when using lazy 'TL.Text'/'BL.ByteString' we will hold on to whole+-- chunks at a time leading to to significantly worse memory residency in+-- some cases.+--+-- See 'NoShareInput' for a somewhat slower implementation that avoids this+-- memory leak scenario.+--+-- @since 9.3.0+newtype ShareInput a = ShareInput {unShareInput :: a}++instance Stream (ShareInput B.ByteString) where+ type Token (ShareInput B.ByteString) = Word8+ type Tokens (ShareInput B.ByteString) = B.ByteString tokenToChunk Proxy = B.singleton tokensToChunk Proxy = B.pack chunkToTokens Proxy = B.unpack chunkLength Proxy = B.length chunkEmpty Proxy = B.null- take1_ = B.uncons- takeN_ n s- | n <= 0 = Just (B.empty, s)+ take1_ (ShareInput s) = second ShareInput <$> B.uncons s+ takeN_ n (ShareInput s)+ | n <= 0 = Just (B.empty, ShareInput s) | B.null s = Nothing- | otherwise = Just (B.splitAt n s)- takeWhile_ = B.span+ | otherwise = Just . second ShareInput $ B.splitAt n s+ takeWhile_ p (ShareInput s) = second ShareInput $ B.span p s -instance Stream BL.ByteString where- type Token BL.ByteString = Word8- type Tokens BL.ByteString = BL.ByteString+instance Stream (ShareInput BL.ByteString) where+ type Token (ShareInput BL.ByteString) = Word8+ type Tokens (ShareInput BL.ByteString) = BL.ByteString tokenToChunk Proxy = BL.singleton tokensToChunk Proxy = BL.pack chunkToTokens Proxy = BL.unpack chunkLength Proxy = fromIntegral . BL.length chunkEmpty Proxy = BL.null- take1_ = BL.uncons- takeN_ n s- | n <= 0 = Just (BL.empty, s)+ take1_ (ShareInput s) = second ShareInput <$> BL.uncons s+ takeN_ n (ShareInput s)+ | n <= 0 = Just (BL.empty, ShareInput s) | BL.null s = Nothing- | otherwise = Just (BL.splitAt (fromIntegral n) s)- takeWhile_ = BL.span+ | otherwise = Just . second ShareInput $ BL.splitAt (fromIntegral n) s+ takeWhile_ p (ShareInput s) = second ShareInput $ BL.span p s -instance Stream T.Text where- type Token T.Text = Char- type Tokens T.Text = T.Text+instance Stream (ShareInput T.Text) where+ type Token (ShareInput T.Text) = Char+ type Tokens (ShareInput T.Text) = T.Text tokenToChunk Proxy = T.singleton tokensToChunk Proxy = T.pack chunkToTokens Proxy = T.unpack chunkLength Proxy = T.length chunkEmpty Proxy = T.null- take1_ = T.uncons- takeN_ n s- | n <= 0 = Just (T.empty, s)+ take1_ (ShareInput s) = second ShareInput <$> T.uncons s+ takeN_ n (ShareInput s)+ | n <= 0 = Just (T.empty, ShareInput s) | T.null s = Nothing- | otherwise = Just (T.splitAt n s)- takeWhile_ = T.span+ | otherwise = Just . second ShareInput $ T.splitAt n s+ takeWhile_ p (ShareInput s) = second ShareInput $ T.span p s -instance Stream TL.Text where- type Token TL.Text = Char- type Tokens TL.Text = TL.Text+instance Stream (ShareInput TL.Text) where+ type Token (ShareInput TL.Text) = Char+ type Tokens (ShareInput TL.Text) = TL.Text tokenToChunk Proxy = TL.singleton tokensToChunk Proxy = TL.pack chunkToTokens Proxy = TL.unpack chunkLength Proxy = fromIntegral . TL.length chunkEmpty Proxy = TL.null- take1_ = TL.uncons- takeN_ n s- | n <= 0 = Just (TL.empty, s)+ take1_ (ShareInput s) = second ShareInput <$> TL.uncons s+ takeN_ n (ShareInput s)+ | n <= 0 = Just (TL.empty, ShareInput s) | TL.null s = Nothing- | otherwise = Just (TL.splitAt (fromIntegral n) s)- takeWhile_ = TL.span+ | otherwise = Just . second ShareInput $ TL.splitAt (fromIntegral n) s+ takeWhile_ p (ShareInput s) = second ShareInput $ TL.span p s++-- | This wrapper selects the no-input-sharing 'Stream' implementation for+-- 'T.Text' ('TL.Text') and 'B.ByteString' ('BL.ByteString'). This means+-- that our parsers will create independent copies rather than using slices+-- of the input. See also the documentation of 'T.copy'.+--+-- More importantly, any parser output will be independent of the input, and+-- holding on to parts of the output will never prevent the input from being+-- garbage collected.+--+-- For maximum performance you might consider using 'ShareInput' instead,+-- but beware of its pitfalls!+--+-- @since 9.3.0+newtype NoShareInput a = NoShareInput {unNoShareInput :: a}++instance Stream (NoShareInput B.ByteString) where+ type Token (NoShareInput B.ByteString) = Word8+ type Tokens (NoShareInput B.ByteString) = B.ByteString+ tokenToChunk Proxy = B.singleton+ tokensToChunk Proxy = B.pack+ chunkToTokens Proxy = B.unpack+ chunkLength Proxy = B.length+ chunkEmpty Proxy = B.null+ take1_ (NoShareInput s) = second NoShareInput <$> B.uncons s+ takeN_ n (NoShareInput s)+ | n <= 0 = Just (B.empty, NoShareInput s)+ | B.null s = Nothing+ | otherwise =+ let (result, rest) = B.splitAt n s+ -- To avoid sharing the entire input we create a clean copy of the result.+ unSharedResult = B.copy result+ in Just (unSharedResult, NoShareInput rest)+ takeWhile_ p (NoShareInput s) =+ let (result, rest) = B.span p s+ -- Ditto.+ unSharedResult = B.copy result+ in (unSharedResult, NoShareInput rest)++instance Stream (NoShareInput BL.ByteString) where+ type Token (NoShareInput BL.ByteString) = Word8+ type Tokens (NoShareInput BL.ByteString) = BL.ByteString+ tokenToChunk Proxy = BL.singleton+ tokensToChunk Proxy = BL.pack+ chunkToTokens Proxy = BL.unpack+ chunkLength Proxy = fromIntegral . BL.length+ chunkEmpty Proxy = BL.null+ take1_ (NoShareInput s) = second NoShareInput <$> BL.uncons s+ takeN_ n (NoShareInput s)+ | n <= 0 = Just (BL.empty, NoShareInput s)+ | BL.null s = Nothing+ | otherwise =+ let (result, rest) = BL.splitAt (fromIntegral n) s+ -- To avoid sharing the entire input we create a clean copy of the result.+ unSharedResult = BL.copy result+ in Just (unSharedResult, NoShareInput rest)+ takeWhile_ p (NoShareInput s) =+ let (result, rest) = BL.span p s+ -- Ditto.+ unSharedResult = BL.copy result+ in (unSharedResult, NoShareInput rest)++instance Stream (NoShareInput T.Text) where+ type Token (NoShareInput T.Text) = Char+ type Tokens (NoShareInput T.Text) = T.Text+ tokenToChunk Proxy = T.singleton+ tokensToChunk Proxy = T.pack+ chunkToTokens Proxy = T.unpack+ chunkLength Proxy = T.length+ chunkEmpty Proxy = T.null+ take1_ (NoShareInput s) = second NoShareInput <$> T.uncons s+ takeN_ n (NoShareInput s)+ | n <= 0 = Just (T.empty, NoShareInput s)+ | T.null s = Nothing+ | otherwise =+ let (result, rest) = T.splitAt n s+ -- To avoid sharing the entire input we create a clean copy of the result.+ unSharedResult = T.copy result+ in Just (unSharedResult, NoShareInput rest)+ takeWhile_ p (NoShareInput s) =+ let (result, rest) = T.span p s+ unSharedResult = T.copy result+ in (unSharedResult, NoShareInput rest)++instance Stream (NoShareInput TL.Text) where+ type Token (NoShareInput TL.Text) = Char+ type Tokens (NoShareInput TL.Text) = TL.Text+ tokenToChunk Proxy = TL.singleton+ tokensToChunk Proxy = TL.pack+ chunkToTokens Proxy = TL.unpack+ chunkLength Proxy = fromIntegral . TL.length+ chunkEmpty Proxy = TL.null+ take1_ (NoShareInput s) = second NoShareInput <$> TL.uncons s+ takeN_ n (NoShareInput s)+ | n <= 0 = Just (TL.empty, NoShareInput s)+ | TL.null s = Nothing+ | otherwise =+ let (result, rest) = TL.splitAt (fromIntegral n) s+ -- To avoid sharing the entire input we create a clean copy of the result.+ unSharedResult = tlCopy result+ in Just (unSharedResult, NoShareInput rest)+ takeWhile_ p (NoShareInput s) =+ let (result, rest) = TL.span p s+ unSharedResult = tlCopy result+ in (unSharedResult, NoShareInput rest)++-- | Create an independent copy of a TL.Text, akin to BL.copy.+tlCopy :: TL.Text -> TL.Text+tlCopy = TL.fromStrict . T.copy . TL.toStrict+{-# INLINE tlCopy #-}++-- Since we are using @{-# LANGUAGE Safe #-}@ we can't use deriving via in+-- these cases.++instance Stream B.ByteString where+ type Token B.ByteString = Token (ShareInput B.ByteString)+ type Tokens B.ByteString = Tokens (ShareInput B.ByteString)+ tokenToChunk Proxy = tokenToChunk (Proxy :: Proxy (ShareInput B.ByteString))+ tokensToChunk Proxy = tokensToChunk (Proxy :: Proxy (ShareInput B.ByteString))+ chunkToTokens Proxy = chunkToTokens (Proxy :: Proxy (ShareInput B.ByteString))+ chunkLength Proxy = chunkLength (Proxy :: Proxy (ShareInput B.ByteString))+ chunkEmpty Proxy = chunkEmpty (Proxy :: Proxy (ShareInput B.ByteString))+ take1_ s = second unShareInput <$> take1_ (ShareInput s)+ takeN_ n s = second unShareInput <$> takeN_ n (ShareInput s)+ takeWhile_ p s = second unShareInput $ takeWhile_ p (ShareInput s)++instance Stream BL.ByteString where+ type Token BL.ByteString = Token (ShareInput BL.ByteString)+ type Tokens BL.ByteString = Tokens (ShareInput BL.ByteString)+ tokenToChunk Proxy = tokenToChunk (Proxy :: Proxy (ShareInput BL.ByteString))+ tokensToChunk Proxy = tokensToChunk (Proxy :: Proxy (ShareInput BL.ByteString))+ chunkToTokens Proxy = chunkToTokens (Proxy :: Proxy (ShareInput BL.ByteString))+ chunkLength Proxy = chunkLength (Proxy :: Proxy (ShareInput BL.ByteString))+ chunkEmpty Proxy = chunkEmpty (Proxy :: Proxy (ShareInput BL.ByteString))+ take1_ s = second unShareInput <$> take1_ (ShareInput s)+ takeN_ n s = second unShareInput <$> takeN_ n (ShareInput s)+ takeWhile_ p s = second unShareInput $ takeWhile_ p (ShareInput s)++instance Stream T.Text where+ type Token T.Text = Token (ShareInput T.Text)+ type Tokens T.Text = Tokens (ShareInput T.Text)+ tokenToChunk Proxy = tokenToChunk (Proxy :: Proxy (ShareInput T.Text))+ tokensToChunk Proxy = tokensToChunk (Proxy :: Proxy (ShareInput T.Text))+ chunkToTokens Proxy = chunkToTokens (Proxy :: Proxy (ShareInput T.Text))+ chunkLength Proxy = chunkLength (Proxy :: Proxy (ShareInput T.Text))+ chunkEmpty Proxy = chunkEmpty (Proxy :: Proxy (ShareInput T.Text))+ take1_ s = second unShareInput <$> take1_ (ShareInput s)+ takeN_ n s = second unShareInput <$> takeN_ n (ShareInput s)+ takeWhile_ p s = second unShareInput $ takeWhile_ p (ShareInput s)++instance Stream TL.Text where+ type Token TL.Text = Token (ShareInput TL.Text)+ type Tokens TL.Text = Tokens (ShareInput TL.Text)+ tokenToChunk Proxy = tokenToChunk (Proxy :: Proxy (ShareInput TL.Text))+ tokensToChunk Proxy = tokensToChunk (Proxy :: Proxy (ShareInput TL.Text))+ chunkToTokens Proxy = chunkToTokens (Proxy :: Proxy (ShareInput TL.Text))+ chunkLength Proxy = chunkLength (Proxy :: Proxy (ShareInput TL.Text))+ chunkEmpty Proxy = chunkEmpty (Proxy :: Proxy (ShareInput TL.Text))+ take1_ s = second unShareInput <$> take1_ (ShareInput s)+ takeN_ n s = second unShareInput <$> takeN_ n (ShareInput s)+ takeWhile_ p s = second unShareInput $ takeWhile_ p (ShareInput s) -- | Type class for inputs that can also be used for debugging. --
megaparsec.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: megaparsec-version: 9.2.2+version: 9.3.0 license: BSD-2-Clause license-file: LICENSE.md maintainer: Mark Karpov <markkarpov92@gmail.com>