simple-parser 0.5.0 → 0.6.0

raw patch · 12 files changed

+225/−57 lines, 12 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• README.md +1/−1
• simple-parser.cabal +3/−2
• src/SimpleParser.hs +2/−0
• src/SimpleParser/Common.hs +3/−3
• src/SimpleParser/Examples/Json.hs +17/−14
• src/SimpleParser/Examples/Sexp.hs +16/−11
• src/SimpleParser/Explain.hs +2/−2
• src/SimpleParser/LookAhead.hs +97/−0
• src/SimpleParser/Parser.hs +10/−0
• src/SimpleParser/Result.hs +13/−4
• src/SimpleParser/Stream.hs +19/−18
• test/Main.hs +42/−2

@@ -13,4 +13,4 @@  ## License -This project is BSD-licenced. Some gnarly functions to parse numbers and such have been adapted from Megaparsec, which is also [BSD-licensed](https://github.com/mrkkrp/megaparsec/blob/master/LICENSE.md).+This project is BSD-licensed. Some gnarly functions to parse numbers and such have been adapted from Megaparsec, which is also [BSD-licensed](https://github.com/mrkkrp/megaparsec/blob/master/LICENSE.md).

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 9f3603d415ba39bde869cc248fafc793d22852c365bfe638986552697a10c988+-- hash: 4839c5f528bb2f3a48f2fbbcee91749ab73716791dc72efa365b56fefc75e6e6  name:           simple-parser-version:        0.5.0+version:        0.6.0 synopsis:       Simple parser combinators description:    Please see the README on GitHub at <https://github.com/ejconlon/simple-parser#readme> category:       Parsing@@ -36,6 +36,7 @@       SimpleParser.Explain       SimpleParser.Input       SimpleParser.Interactive+      SimpleParser.LookAhead       SimpleParser.Parser       SimpleParser.Result       SimpleParser.Stack

@@ -9,6 +9,7 @@   , module SimpleParser.Explain   , module SimpleParser.Input   , module SimpleParser.Interactive+  , module SimpleParser.LookAhead   , module SimpleParser.Parser   , module SimpleParser.Result   , module SimpleParser.Stack@@ -20,6 +21,7 @@ import SimpleParser.Explain import SimpleParser.Input import SimpleParser.Interactive+import SimpleParser.LookAhead import SimpleParser.Parser import SimpleParser.Result import SimpleParser.Stack

@@ -30,7 +30,7 @@ import SimpleParser.Chunked (Chunked (..)) import SimpleParser.Input (dropTokensWhile, dropTokensWhile1, foldTokensWhile, matchToken, takeTokensWhile1) import SimpleParser.Parser (ParserT, defaultParser, greedyStarParser, optionalParser, orParser)-import SimpleParser.Stream (Span (..), Stream (..))+import SimpleParser.Stream (PosStream (..), Span (..), Stream (..))  -- | Enumeration of common labels in textual parsing. data TextLabel =@@ -187,7 +187,7 @@   in betweenParser quoteParser quoteParser innerParser  -- | Adds span information to parsed values.-spanParser :: (Stream s, Monad m) => (Span (Pos s) -> a -> b) -> ParserT l s e m a -> ParserT l s e m b+spanParser :: (PosStream s, Monad m) => (Span (Pos s) -> a -> b) -> ParserT l s e m a -> ParserT l s e m b spanParser f p = do   start <- get   val <- p@@ -195,5 +195,5 @@   pure (f (Span (streamViewPos start) (streamViewPos end)) val)  -- | Gets the current stream position-getStreamPos :: (Stream s, Monad m) => ParserT l s e m (Pos s)+getStreamPos :: (PosStream s, Monad m) => ParserT l s e m (Pos s) getStreamPos = gets streamViewPos

@@ -10,14 +10,14 @@   ) where  import Control.Monad (void)-import Data.Foldable (asum) import Data.Scientific (Scientific) import Data.Sequence (Seq) import Data.Text (Text) import Data.Void (Void)-import SimpleParser (Parser, Stream (..), TextLabel, TextualChunked (..), TextualStream, betweenParser, commitParser,-                     escapedStringParser, lexemeParser, matchChunk, matchToken, onEmptyParser, orParser, satisfyToken,-                     scientificParser, sepByParser, signedNumStartPred, spaceParser)+import SimpleParser (DefaultCase (..), MatchBlock (..), MatchCase (..), Parser, PureMatchBlock, Stream (..), TextLabel,+                     TextualChunked (..), TextualStream, betweenParser, escapedStringParser, lexemeParser,+                     lookAheadMatch, matchChunk, matchToken, orParser, satisfyToken, scientificParser, sepByParser,+                     signedNumStartPred, spaceParser)  data JsonF a =     JsonObject !(Seq (Text, a))@@ -32,6 +32,8 @@  type JsonParserC s = (TextualStream s, Eq (Chunk s)) +type JsonParserB s a = PureMatchBlock TextLabel s Void a+ type JsonParserM s a = Parser TextLabel s Void a  jsonParser :: JsonParserC s => JsonParserM s Json@@ -40,17 +42,18 @@ isBoolStartPred :: Char -> Bool isBoolStartPred c = c == 't' || c == 'f' +recJsonB :: JsonParserC s => JsonParserM s a -> JsonParserB s (JsonF a)+recJsonB root = MatchBlock (DefaultCase Nothing (const (fail "failed to parse json document")))+  [ MatchCase Nothing openBraceP (objectP (objectPairP root))+  , MatchCase Nothing openBracketP (arrayP root)+  , MatchCase Nothing openQuoteP stringP+  , MatchCase Nothing (void (satisfyToken Nothing signedNumStartPred)) numP+  , MatchCase Nothing (void (satisfyToken Nothing isBoolStartPred)) boolP+  , MatchCase Nothing (void (matchToken 'n')) nullP+  ]+ recJsonParser :: JsonParserC s => JsonParserM s a -> JsonParserM s (JsonF a)-recJsonParser root = onEmptyParser (asum opts) (fail "failed to parse json document") where-  pairP = objectPairP root-  opts =-    [ commitParser openBraceP (objectP pairP)-    , commitParser openBracketP (arrayP root)-    , commitParser openQuoteP stringP-    , commitParser (void (satisfyToken Nothing signedNumStartPred)) numP-    , commitParser (void (satisfyToken Nothing isBoolStartPred)) boolP-    , commitParser (void (matchToken 'n')) nullP-    ]+recJsonParser root = lookAheadMatch (recJsonB root)  spaceP :: JsonParserC s => JsonParserM s () spaceP = spaceParser

@@ -13,15 +13,15 @@  import Control.Monad (void) import Data.Char (isDigit, isSpace)-import Data.Foldable (asum) import Data.Scientific (Scientific) import Data.Sequence (Seq) import Data.Text (Text) import Data.Void (Void)-import SimpleParser (Chunked (..), EmbedTextLabel (..), ExplainLabel (..), Parser, TextLabel, TextualStream,-                     betweenParser, commitParser, decimalParser, escapedStringParser, lexemeParser, matchToken,-                     onEmptyParser, orParser, packChunk, satisfyToken, scientificParser, sepByParser,-                     signedNumStartPred, signedParser, spaceParser, takeTokensWhile)+import SimpleParser (Chunked (..), DefaultCase (..), EmbedTextLabel (..), ExplainLabel (..), MatchBlock (..),+                     MatchCase (..), Parser, PureMatchBlock, TextLabel, TextualStream, betweenParser, commitParser,+                     decimalParser, escapedStringParser, lexemeParser, lookAheadMatch, matchToken, onEmptyParser,+                     orParser, packChunk, satisfyToken, scientificParser, sepByParser, signedNumStartPred, signedParser,+                     spaceParser, takeTokensWhile)  data Atom =     AtomIdent !Text@@ -54,6 +54,8 @@  type SexpParserC s = TextualStream s +type SexpParserB s a = PureMatchBlock SexpLabel s Void a+ type SexpParserM s a = Parser SexpLabel s Void a  sexpParser :: SexpParserC s => SexpParserM s Sexp@@ -100,13 +102,16 @@ floatP :: SexpParserC s => SexpParserM s Scientific floatP = signedParser (pure ()) scientificParser -atomP :: SexpParserC s => SexpParserM s Atom-atomP = lexP $ asum-  [ commitParser (void (matchToken '"')) (fmap AtomString stringP)-  , commitParser (void (satisfyToken Nothing signedNumStartPred)) (fmap AtomInt intP)-  , commitParser (void (satisfyToken Nothing signedNumStartPred)) (fmap AtomFloat floatP)-  , commitParser (void (satisfyToken Nothing identStartPred)) (fmap AtomIdent identifierP)+atomB :: SexpParserC s => SexpParserB s Atom+atomB = MatchBlock (DefaultCase Nothing (const (fail "failed to parse sexp atom")))+  [ MatchCase Nothing (void (matchToken '"')) (fmap AtomString stringP)+  , MatchCase Nothing (void (satisfyToken Nothing signedNumStartPred)) (fmap AtomInt intP)+  , MatchCase Nothing (void (satisfyToken Nothing signedNumStartPred)) (fmap AtomFloat floatP)+  , MatchCase Nothing (void (satisfyToken Nothing identStartPred)) (fmap AtomIdent identifierP)   ]++atomP :: SexpParserC s => SexpParserM s Atom+atomP = lexP (lookAheadMatch atomB)  listP :: SexpParserC s => SexpParserM s a -> SexpParserM s (Seq a) listP root = lexP (betweenParser openParenP closeParenP (sepByParser root spaceP))

@@ -22,7 +22,7 @@ import SimpleParser.Common (CompoundTextLabel (..), TextLabel (..)) import SimpleParser.Result (CompoundError (..), ParseError (..), RawError (..), StreamError (..),                             parseErrorEnclosingLabels, parseErrorNarrowestSpan)-import SimpleParser.Stream (LinePos (..), Span (..), Stream (..), TextualStream)+import SimpleParser.Stream (LinePos (..), PosStream (..), Span (..), Stream (..), TextualStream) import Text.Builder (Builder) import qualified Text.Builder as TB @@ -108,7 +108,7 @@       CompoundErrorFail msg -> ErrorExplanation msg Nothing Nothing       CompoundErrorCustom e -> explainError e -type Explainable l s e = (TextualStream s, ExplainLabel l, ExplainError e)+type Explainable l s e = (TextualStream s, PosStream s, ExplainLabel l, ExplainError e)  data ParseErrorExplanation p = ParseErrorExplanation   { peeSpan :: !(Span p)

@@ -0,0 +1,97 @@+{-# LANGUAGE UndecidableInstances #-}++module SimpleParser.LookAhead+  ( MatchCase (..)+  , PureMatchCase+  , DefaultCase (..)+  , PureDefaultCase+  , MatchBlock (..)+  , PureMatchBlock+  , lookAheadMatch+  , MatchPos (..)+  , LookAheadTestResult (..)+  , lookAheadTest+  , pureLookAheadTest+  , lookAheadChunk+  ) where++import Control.Monad (void)+import Control.Monad.Identity (Identity (runIdentity))+import Data.Sequence (Seq (..))+import Data.Sequence.NonEmpty (NESeq)+import qualified Data.Sequence.NonEmpty as NESeq+import SimpleParser.Input (matchChunk)+import SimpleParser.Parser (ParserT (..), markParser)+import SimpleParser.Result (ParseError, ParseResult (..))+import SimpleParser.Stream (Stream (..))++data MatchCase l s e m a = MatchCase+  { matchCaseLabel :: !(Maybe l)+  , matchCaseGuard :: !(ParserT l s e m ())+  , matchCaseBody :: !(ParserT l s e m a)+  }++type PureMatchCase l s e a = MatchCase l s e Identity a++data MatchMiss l s e = MatchMiss+  { matchMissLabel :: !(Maybe l)+  , matchMissErrors :: !(Maybe (NESeq (ParseError l s e)))+  }++deriving instance (Eq l, Eq s, Eq (Token s), Eq (Chunk s), Eq e) => Eq (MatchMiss l s e)+deriving instance (Show l, Show s, Show (Token s), Show (Chunk s), Show e) => Show (MatchMiss l s e)++data DefaultCase l s e m a = DefaultCase+  { defaultCaseLabel :: !(Maybe l)+  , defaultCaseHandle :: !(Seq (MatchMiss l s e) -> ParserT l s e m a)+  }++type PureDefaultCase l s e a = DefaultCase l s e Identity a++data MatchBlock l s e m a = MatchBlock+  { matchBlockDefault :: !(DefaultCase l s e m a)+  , matchBlockElems :: ![MatchCase l s e m a]+  }++type PureMatchBlock l s e a = MatchBlock l s e Identity a++-- | Parse with look-ahead for each case and follow the first that matches (or follow the default if none do).+lookAheadMatch :: Monad m => MatchBlock l s e m a -> ParserT l s e m a+lookAheadMatch (MatchBlock (DefaultCase dcl dch) mcs) = ParserT (go Empty mcs) where+  go !macc [] s = runParserT (markParser dcl (dch macc)) s+  go !macc ((MatchCase mcl mcg mcb):mcs') s = do+    mres <- runParserT mcg s+    case mres of+      Nothing -> go (macc :|> MatchMiss mcl Nothing) mcs' s+      Just (ParseResultError es) -> go (macc :|> MatchMiss mcl (Just es)) mcs' s+      Just (ParseResultSuccess _) -> runParserT (markParser mcl mcb) s++data MatchPos l = MatchPos+  { matchPosIndex :: !Int+  , matchPosLabel :: !(Maybe l)+  } deriving stock (Eq, Show)++data LookAheadTestResult l =+    LookAheadTestDefault !(Maybe l)+  | LookAheadTestMatches !(NESeq (MatchPos l))+  deriving stock (Eq, Show)++-- | Test which branches match the look-ahead. Useful to assert that your parser makes exclusive choices.+lookAheadTest :: Monad m => MatchBlock l s e m a -> s -> m (LookAheadTestResult l)+lookAheadTest (MatchBlock (DefaultCase dcl _) mcs) = go Empty 0 mcs where+  go !acc _ [] _ =+    case NESeq.nonEmptySeq acc of+      Nothing -> pure (LookAheadTestDefault dcl)+      Just ms -> pure (LookAheadTestMatches ms)+  go !acc !i ((MatchCase mcl mcg _):mcs') s = do+    mres <- runParserT mcg s+    case mres of+      Just (ParseResultSuccess _) -> go (acc :|> MatchPos i mcl) (i + 1) mcs' s+      _ -> go acc (i + 1) mcs' s++pureLookAheadTest :: PureMatchBlock l s e a -> s -> LookAheadTestResult l+pureLookAheadTest mb = runIdentity . lookAheadTest mb++-- | Simple look-ahead that matches by chunk.+lookAheadChunk :: (Stream s, Monad m, Eq (Chunk s)) => [(Chunk s, ParserT l s e m a)] -> ParserT l s e m a -> ParserT l s e m a+lookAheadChunk ps d = lookAheadMatch (MatchBlock (DefaultCase Nothing (const d)) (fmap (\(c, p) -> MatchCase Nothing (void (matchChunk c)) p) ps))

@@ -21,6 +21,7 @@   , greedyPlusParser_   , defaultParser   , optionalParser+  , reflectParser   , silenceParser   , lookAheadParser   , markParser@@ -184,6 +185,8 @@           -- Not handling error;  - find next custom error           goSplit s0 (beforeEs <> (targetE :<| nextBeforeEs)) afterEs         Just b -> do+          -- NOTE(ejconlon) We resume parsing at the start state s0 (captured at catchError invocation)+          -- Is it reasonable to support parsing at the error state? (This is in the SeqPartition wildcard above)           mres <- runParserT (handler b) s0           case mres of             Nothing ->@@ -235,6 +238,13 @@ -- wraps success in 'Just'. optionalParser :: Monad m => ParserT l s e m a -> ParserT l s e m (Maybe a) optionalParser parser = defaultParser Nothing (fmap Just parser)++-- | Run the parser speculatively and return results. Does not advance state or throw errors.+reflectParser :: Monad m => ParserT l s e m a -> ParserT l s e m (Maybe (ParseResult l s e a))+reflectParser parser = ParserT go where+  go s0 = do+    mres <- runParserT parser s0+    pure (Just (ParseResultSuccess (ParseSuccess s0 mres)))  -- | Removes all failures from the parse results. Catches more errors than 'catchError (const empty)' -- because this includes stream errors, not just custom errors.

@@ -1,4 +1,3 @@-{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE UndecidableInstances #-}  module SimpleParser.Result@@ -14,14 +13,15 @@   , parseErrorNarrowestSpan   , ParseSuccess (..)   , ParseResult (..)+  , matchSoleParseError   ) where  import Data.Sequence (Seq (..)) import qualified Data.Sequence as Seq-import Data.Sequence.NonEmpty (NESeq)+import Data.Sequence.NonEmpty (NESeq (..)) import Data.Text (Text) import SimpleParser.Stack (Stack (..), bottomStack, emptyStack, pushStack, topStack)-import SimpleParser.Stream (Span (..), Stream (..))+import SimpleParser.Stream (PosStream (..), Span (..), Stream (..))  data RawError chunk token =     RawErrorMatchEnd !token@@ -79,7 +79,7 @@ unmarkParseError pe = pe { peMarkStack = emptyStack }  -- | Returns the narrowest span-parseErrorNarrowestSpan :: Stream s => ParseError l s e -> (Maybe l, Span (Pos s))+parseErrorNarrowestSpan :: PosStream s => ParseError l s e -> (Maybe l, Span (Pos s)) parseErrorNarrowestSpan pe = (ml, Span startPos endPos) where   endPos = streamViewPos (peEndState pe)   (ml, startPos) = maybe (Nothing, endPos) (\(Mark mx s) -> (mx, streamViewPos s)) (bottomStack (peMarkStack pe))@@ -106,3 +106,12 @@  deriving instance (Eq l, Eq s, Eq (Token s), Eq (Chunk s), Eq e, Eq a) => Eq (ParseResult l s e a) deriving instance (Show l, Show s, Show (Token s), Show (Chunk s), Show e, Show a) => Show (ParseResult l s e a)++-- | If there is one parse error, return it, otherwise return nothing.+-- Errors can accumulate if you use unrestricted branching (with 'orParser' or 'Alternative' '<|>') or manual 'Parser' constructor application.+-- However, if you always branch with 'lookAheadMatch' then you will have singleton parse errors, and this will always return 'Just'.+matchSoleParseError :: NESeq (ParseError l s e) -> Maybe (ParseError l s e)+matchSoleParseError es =+  case es of+    e :<|| Empty -> Just e+    _ -> Nothing

@@ -2,9 +2,10 @@ -- See <https://hackage.haskell.org/package/megaparsec-9.0.1/docs/Text-Megaparsec-Stream.html Text.Megaparsec.Stream>. module SimpleParser.Stream   ( Stream (..)-  , TextualStream   , defaultStreamDropN   , defaultStreamDropWhile+  , TextualStream+  , PosStream (..)   , Offset (..)   , OffsetStream (..)   , newOffsetStream@@ -25,15 +26,11 @@ import qualified Data.Text as T import SimpleParser.Chunked (Chunked (..), TextualChunked (..)) --- | 'Stream' lets us peel off tokens and chunks for parsing--- with explicit state passing.+-- | 'Stream' lets us peel off tokens and chunks for parsing with explicit state passing. class Chunked (Chunk s) (Token s) => Stream s where   type family Chunk s :: Type   type family Token s :: Type-  type family Pos s :: Type -  streamViewPos :: s -> Pos s-   streamTake1 :: s -> Maybe (Token s, s)   streamTakeN :: Int -> s -> Maybe (Chunk s, s)   streamTakeWhile :: (Token s -> Bool) -> s -> (Chunk s, s)@@ -55,9 +52,7 @@ instance Stream [a] where   type instance Chunk [a] = [a]   type instance Token [a] = a-  type instance Pos [a] = () -  streamViewPos = const ()   streamTake1 = unconsChunk   streamTakeN n s     | n <= 0 = Just ([], s)@@ -68,9 +63,7 @@ instance Stream (Seq a) where   type instance Chunk (Seq a) = Seq a   type instance Token (Seq a) = a-  type instance Pos (Seq a) = () -  streamViewPos = const ()   streamTake1 = unconsChunk   streamTakeN n s     | n <= 0 = Just (Seq.empty, s)@@ -83,9 +76,7 @@ instance Stream Text where   type instance Chunk Text = Text   type instance Token Text = Char-  type instance Pos Text = () -  streamViewPos = const ()   streamTake1 = T.uncons   streamTakeN n s     | n <= 0 = Just (T.empty, s)@@ -93,6 +84,12 @@     | otherwise = Just (T.splitAt n s)   streamTakeWhile = T.span +-- | 'PosStream' adds position tracking to a 'Stream'.+class Stream s => PosStream s where+  type family Pos s :: Type++  streamViewPos :: s -> Pos s+ newtype Offset = Offset { unOffset :: Int }   deriving newtype (Eq, Show, Ord, Enum, Num, Real, Integral) @@ -105,9 +102,6 @@ instance Stream s => Stream (OffsetStream s) where   type instance Chunk (OffsetStream s) = Chunk s   type instance Token (OffsetStream s) = Token s-  type instance Pos (OffsetStream s) = Offset--  streamViewPos (OffsetStream o _) = o   streamTake1 (OffsetStream o s) = fmap (second (OffsetStream (succ o))) (streamTake1 s)   streamTakeN n (OffsetStream (Offset x) s) = fmap go (streamTakeN n s) where     go (a, b) = (a, OffsetStream (Offset (x + chunkLength a)) b)@@ -120,6 +114,11 @@     let (m, b) = streamDropWhile pcate s     in (m, OffsetStream (Offset (x + m)) b) +instance Stream s => PosStream (OffsetStream s) where+  type instance Pos (OffsetStream s) = Offset++  streamViewPos (OffsetStream o _) = o+ newOffsetStream :: s -> OffsetStream s newOffsetStream = OffsetStream 0 @@ -157,9 +156,6 @@ instance (Stream s, Token s ~ Char) => Stream (LinePosStream s) where   type instance Chunk (LinePosStream s) = Chunk s   type instance Token (LinePosStream s) = Token s-  type instance Pos (LinePosStream s) = LinePos--  streamViewPos (LinePosStream p _) = p   streamTake1 (LinePosStream p s) = fmap (\(a, b) -> (a, LinePosStream (incrLinePosToken p a) b)) (streamTake1 s)   streamTakeN n (LinePosStream p s) = fmap go (streamTakeN n s) where     go (a, b) = (a, LinePosStream (incrLinePosChunk p (chunkToTokens a)) b)@@ -168,6 +164,11 @@     in (a, LinePosStream (incrLinePosChunk p (chunkToTokens a)) b)    -- Drops can't be specialized because we need to examine each character for newlines.++instance (Stream s, Token s ~ Char) => PosStream (LinePosStream s) where+  type instance Pos (LinePosStream s) = LinePos++  streamViewPos (LinePosStream p _) = p  newLinePosStream :: s -> LinePosStream s newLinePosStream = LinePosStream initLinePos

@@ -5,6 +5,7 @@  import Control.Monad (void) import Data.Foldable (asum)+import Data.Functor (($>)) import qualified Data.Sequence as Seq import qualified Data.Sequence.NonEmpty as NESeq import Data.String (IsString)@@ -22,6 +23,8 @@  type TestState = OffsetStream Text +type TestBlock a = PureMatchBlock Label TestState Error a+ type TestParser a = Parser Label TestState Error a  type TestResult a = ParseResult Label TestState Error a@@ -32,6 +35,8 @@  data ParserCase a = ParserCase !TestName !(TestParser a) !Text !(Maybe (TestResult a)) +data ExamineCase a = ExamineCase !TestName !(TestBlock a) !Text !(LookAheadTestResult Label)+ fwd :: Int -> TestState -> TestState fwd n (OffsetStream (Offset i) t) =   let m = min n (T.length t)@@ -81,6 +86,11 @@   let actual = runParser parser (newOffsetStream input)   actual @?= expected +testExamineCase :: ExamineCase a -> TestTree+testExamineCase (ExamineCase name block input expected) = testCase name $ do+  let actual = pureLookAheadTest block (newOffsetStream input)+  actual @?= expected+ test_empty :: [TestTree] test_empty =   let parser = emptyParser :: TestParser Int@@ -103,8 +113,8 @@ test_fail =   let parser = fail "i give up" :: TestParser Int       cases =-        [ ParserCase "empty" parser "" (errRes [(failErr (OffsetStream 0 "") "i give up")])-        , ParserCase "non-empty" parser "hi" (errRes [(failErr (OffsetStream 0 "hi") "i give up")])+        [ ParserCase "empty" parser "" (errRes [failErr (OffsetStream 0 "") "i give up"])+        , ParserCase "non-empty" parser "hi" (errRes [failErr (OffsetStream 0 "hi") "i give up"])         ]   in fmap testParserCase cases @@ -534,6 +544,36 @@         , ParserCase "match end" parser "hh" (sucRes (OffsetStream 2 "") 2)         ]   in fmap testParserCase cases++simpleBlock :: TestBlock Text+simpleBlock = MatchBlock (DefaultCase (Just (Label "default")) (\misses -> pure ("n misses: " <> T.pack (show (Seq.length misses)))))+  [ MatchCase (Just (Label "match x")) (void (matchToken 'x')) (anyToken $> "found x - consuming")+  , MatchCase (Just (Label "match x dupe")) (void (matchToken 'x')) (pure "dupe x - leaving")+  , MatchCase (Just (Label "match y")) (void (matchToken 'y')) (pure "found y - leaving")+  ]++test_look_ahead_match :: [TestTree]+test_look_ahead_match =+  let parser = lookAheadMatch simpleBlock+      cases =+        [ ParserCase "empty" parser "" (sucRes (OffsetStream 0 "") "n misses: 3")+        , ParserCase "non-match" parser "wz" (sucRes (OffsetStream 0 "wz") "n misses: 3")+        , ParserCase "match x" parser "xz" (sucRes (OffsetStream 1 "z") "found x - consuming")+        , ParserCase "match y" parser "yz" (sucRes (OffsetStream 0 "yz") "found y - leaving")+        ]+  in fmap testParserCase cases++test_look_ahead_examine :: [TestTree]+test_look_ahead_examine =+  let xpositions = [MatchPos 0 (Just (Label "match x")), MatchPos 1 (Just (Label "match x dupe"))]+      ypositions = [MatchPos 2 (Just (Label "match y"))]+      cases =+        [ ExamineCase "empty" simpleBlock "" (LookAheadTestDefault (Just (Label "default")))+        , ExamineCase "non-match" simpleBlock "wz" (LookAheadTestDefault (Just (Label "default")))+        , ExamineCase "match x" simpleBlock "xz" (LookAheadTestMatches (NESeq.unsafeFromSeq (Seq.fromList xpositions)))+        , ExamineCase "match y" simpleBlock "yz" (LookAheadTestMatches (NESeq.unsafeFromSeq (Seq.fromList ypositions)))+        ]+  in fmap testExamineCase cases  type JsonResult = Maybe Json