looksee 0.5.2 → 0.5.3

raw patch · 4 files changed

+136/−6 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• looksee.cabal +6/−2
• src/Looksee.hs +57/−2
• src/Looksee/Examples.hs +18/−1
• test/Main.hs +55/−1

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           looksee-version:        0.5.2+version:        0.5.3 synopsis:       A simple text parser with decent errors description:    Please see the README on GitHub at <https://github.com/ejconlon/looksee#readme> category:       Parsing@@ -17,7 +17,7 @@ license:        BSD3 build-type:     Simple tested-with:-    GHC == 9.4.5+    GHC == 9.6.3 extra-source-files:     README.md @@ -51,6 +51,8 @@       LambdaCase       KindSignatures       MultiParamTypeClasses+      MultiWayIf+      PatternSynonyms       Rank2Types       ScopedTypeVariables       StandaloneDeriving@@ -97,6 +99,8 @@       LambdaCase       KindSignatures       MultiParamTypeClasses+      MultiWayIf+      PatternSynonyms       Rank2Types       ScopedTypeVariables       StandaloneDeriving

@@ -23,12 +23,15 @@   , parse   , parseI   , spanP+  , spanAroundP   , throwP   , altP   , emptyP   , endP   , optP   , lookP+  , branchP+  , commitP   , labelP   , textP   , textP_@@ -97,7 +100,7 @@   ) where -import Control.Applicative (Alternative (..), liftA2)+import Control.Applicative (Alternative (..)) import Control.Exception (Exception) import Control.Monad (ap, void) import Control.Monad.Except (ExceptT, MonadError (..), runExceptT)@@ -422,10 +425,18 @@ -- an `n`-character document. The start offset will increase as input is consumed, -- and the end offset will decrease as lookahead delimits the range. To evaluate -- the "real" range of characters consumed by a parser, construct a span with the--- starting offsets before and after executing a subparser.+-- starting offsets before and after executing a subparser (or use 'spanAroundP'). spanP :: (Monad m) => ParserT e m (Span Int) spanP = getsP stSpan +-- | Incorporate span information into a parsed object.+spanAroundP :: (Monad m) => (Span Int -> a -> b) -> ParserT e m a -> ParserT e m b+spanAroundP f p = do+  Span start _ <- spanP+  a <- p+  Span end _ <- spanP+  pure (f (Span start end) a)+ -- | Throw a custom parse error throwP :: (Monad m) => e -> ParserT e m a throwP = errP . ReasonCustom@@ -479,6 +490,50 @@ lookP (ParserT g) = ParserT $ \j -> do   st0 <- get   g (\ea -> put st0 >> j (first (Err . ErrF (stSpan st0) . ReasonLook) ea))++-- private+subBranchP+  :: (Monad m)+  => (Either (Err e) a -> T e m r)+  -> St+  -> Seq (AltPhase, Err e)+  -> [(ParserT e m (), ParserT e m a)]+  -> T e m r+subBranchP j st0 = go+ where+  go !errs = \case+    [] -> mkErrT (if Seq.null errs then ReasonEmpty else ReasonAlt errs) >>= j . Left+    (ParserT gl, ParserT gx) : rest -> gl $ \case+      Left _ -> put st0 >> go errs rest+      Right _ -> do+        put st0+        gx $ \case+          Left e -> put st0 >> go (errs :|> (AltPhaseBranch, e)) rest+          Right r -> do+            es <- tryT (j (Right r))+            case es of+              Left e -> put st0 >> go (errs :|> (AltPhaseCont, e)) rest+              Right s -> pure s++-- | Branches guarded by lookahead. Use this for more concise errors.+-- 'altP' will happily tell you about each of the errors it encountered in+-- every branch, but this will quietly prune non-matching branches.+-- Tries until first success (in order), so you can tack on a fallthrough case even if+-- you tried a branch earlier.+branchP :: (Monad m, Foldable f) => f (ParserT e m (), ParserT e m a) -> ParserT e m a+branchP falts = ParserT (\j -> get >>= \st0 -> subBranchP j st0 Empty (toList falts))++-- | An alternative to 'branchP' that does not backtrack after committing to a branch.+commitP :: (Monad m, Foldable f) => f (ParserT e m (), ParserT e m a) -> ParserT e m a+commitP = go . toList+ where+  go = \case+    [] -> emptyP+    (p, q) : rest -> do+      mx <- optP (lookP p)+      case mx of+        Nothing -> go rest+        Just _ -> q  -- | Labels parse errors labelP :: (Monad m) => Label -> ParserT e m a -> ParserT e m a

@@ -18,7 +18,24 @@ import Data.Sequence (Seq) import Data.Text (Text) import Data.Void (Void)-import Looksee (Parser, altP, betweenP, decP, doubleStrP, infixRP, intP, labelP, sciP, sepByP, space1P, stripEndP, stripP, stripStartP, takeWhile1P, textP_)+import Looksee+  ( Parser+  , altP+  , betweenP+  , decP+  , doubleStrP+  , infixRP+  , intP+  , labelP+  , sciP+  , sepByP+  , space1P+  , stripEndP+  , stripP+  , stripStartP+  , takeWhile1P+  , textP_+  )  -- | A JSON value data Json

@@ -3,7 +3,7 @@  module Main (main) where -import Control.Applicative (Alternative (..), liftA2)+import Control.Applicative (Alternative (..)) import Control.Exception (throwIO) import Control.Monad (join) import Data.Foldable (for_, toList)@@ -69,6 +69,8 @@       , ("repeat1", testRepeat1)       , ("or", testOr)       , ("alt", testAlt)+      , ("branch", testBranch)+      , ("commit", testCommit)       , ("opt (empty)", testOptEmpty)       , ("opt", testOpt)       , ("bind (1)", testBind1)@@ -249,6 +251,58 @@     , ParserCase "first" parser "hi" (suc "h" 1)     , ParserCase "middle" parser "zi" (suc "y" 1)     , ParserCase "last" parser "xi" (suc "y" 1)+    ]++testBranch :: [TestTree]+testBranch = fmap testParserCase cases+ where+  parser =+    branchP+      [ (charP_ 'h', textP "hi")+      , (charP_ 'y', textP "yi")+      , (charP_ 'y', textP "ya")+      ]+      :: TestParser Text+  cases =+    [ ParserCase "empty" parser "" $+        err (Span 0 0) ReasonEmpty+    , ParserCase "first" parser "hi" (suc "hi" 0)+    , ParserCase "fail first" parser "ho" $+        errAlt+          (Span 0 2)+          [ (AltPhaseBranch, Span 2 2, ReasonExpect "hi" "ho")+          ]+    , ParserCase "middle" parser "yi" (suc "yi" 0)+    , ParserCase "last" parser "ya" (suc "ya" 0)+    , ParserCase "fail rest" parser "yo" $+        errAlt+          (Span 0 2)+          [ (AltPhaseBranch, Span 2 2, ReasonExpect "yi" "yo")+          , (AltPhaseBranch, Span 2 2, ReasonExpect "ya" "yo")+          ]+    ]++testCommit :: [TestTree]+testCommit = fmap testParserCase cases+ where+  parser =+    commitP+      [ (charP_ 'h', textP "hi")+      , (charP_ 'y', textP "yi")+      , (charP_ 'y', textP "ya")+      ]+      :: TestParser Text+  cases =+    [ ParserCase "empty" parser "" $+        err (Span 0 0) ReasonEmpty+    , ParserCase "first" parser "hi" (suc "hi" 0)+    , ParserCase "fail first" parser "ho" $+        err (Span 2 2) (ReasonExpect "hi" "ho")+    , ParserCase "middle" parser "yi" (suc "yi" 0)+    , ParserCase "fail last" parser "ya" $+        err (Span 2 2) (ReasonExpect "yi" "ya")+    , ParserCase "fail rest" parser "yo" $+        err (Span 2 2) (ReasonExpect "yi" "yo")     ]  testOptEmpty :: [TestTree]