simple-parser 0.3.0 → 0.5.0

raw patch · 5 files changed

+109/−72 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• simple-parser.cabal +49/−21
• src/SimpleParser/Examples/Json.hs +3/−6
• src/SimpleParser/Examples/Sexp.hs +4/−7
• src/SimpleParser/Explain.hs +43/−28
• src/SimpleParser/Parser.hs +10/−10

@@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.33.0.+-- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack ----- hash: 1d43d6b4332cdf22af4c6c459935317446659f1e7a3e9e1ff035e8447b877d50+-- hash: 9f3603d415ba39bde869cc248fafc793d22852c365bfe638986552697a10c988  name:           simple-parser-version:        0.3.0+version:        0.5.0 synopsis:       Simple parser combinators description:    Please see the README on GitHub at <https://github.com/ejconlon/simple-parser#readme> category:       Parsing@@ -44,18 +44,32 @@       Paths_simple_parser   hs-source-dirs:       src-  default-extensions: BangPatterns ConstraintKinds DeriveFunctor DeriveFoldable DeriveTraversable DerivingStrategies FlexibleContexts FlexibleInstances FunctionalDependencies GeneralizedNewtypeDeriving KindSignatures MultiParamTypeClasses TypeFamilies+  default-extensions:+      BangPatterns+      ConstraintKinds+      DeriveFunctor+      DeriveFoldable+      DeriveTraversable+      DerivingStrategies+      FlexibleContexts+      FlexibleInstances+      FunctionalDependencies+      GeneralizedNewtypeDeriving+      KindSignatures+      MultiParamTypeClasses+      StandaloneDeriving+      TypeFamilies   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints -fno-warn-unused-top-binds   build-depends:       base >=4.12 && <5-    , containers >=0.6 && <0.7-    , list-t >=1.0 && <1.1-    , mmorph >=1.1 && <1.2-    , mtl >=2.2 && <2.3-    , nonempty-containers >=0.3 && <0.4-    , scientific >=0.3 && <0.4-    , text >=1.2 && <1.3-    , text-builder >=0.6 && <0.7+    , containers ==0.6.*+    , list-t ==1.0.*+    , mmorph ==1.1.*+    , mtl ==2.2.*+    , nonempty-containers ==0.3.*+    , scientific ==0.3.*+    , text ==1.2.*+    , text-builder ==0.6.*   default-language: Haskell2010  test-suite simple-parser-test@@ -65,20 +79,34 @@       Paths_simple_parser   hs-source-dirs:       test-  default-extensions: BangPatterns ConstraintKinds DeriveFunctor DeriveFoldable DeriveTraversable DerivingStrategies FlexibleContexts FlexibleInstances FunctionalDependencies GeneralizedNewtypeDeriving KindSignatures MultiParamTypeClasses TypeFamilies+  default-extensions:+      BangPatterns+      ConstraintKinds+      DeriveFunctor+      DeriveFoldable+      DeriveTraversable+      DerivingStrategies+      FlexibleContexts+      FlexibleInstances+      FunctionalDependencies+      GeneralizedNewtypeDeriving+      KindSignatures+      MultiParamTypeClasses+      StandaloneDeriving+      TypeFamilies   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints -fno-warn-unused-top-binds -threaded -rtsopts -with-rtsopts=-N   build-depends:       base >=4.12 && <5-    , containers >=0.6 && <0.7-    , list-t >=1.0 && <1.1-    , mmorph >=1.1 && <1.2-    , mtl >=2.2 && <2.3-    , nonempty-containers >=0.3 && <0.4-    , scientific >=0.3 && <0.4+    , containers ==0.6.*+    , list-t ==1.0.*+    , mmorph ==1.1.*+    , mtl ==2.2.*+    , nonempty-containers ==0.3.*+    , scientific ==0.3.*     , simple-parser     , tasty     , tasty-hunit     , tasty-th-    , text >=1.2 && <1.3-    , text-builder >=0.6 && <0.7+    , text ==1.2.*+    , text-builder ==0.6.*   default-language: Haskell2010

@@ -15,12 +15,9 @@ import Data.Sequence (Seq) import Data.Text (Text) import Data.Void (Void)-import SimpleParser.Chunked (TextualChunked (..))-import SimpleParser.Common (TextLabel, betweenParser, escapedStringParser, lexemeParser, scientificParser, sepByParser,-                            signedNumStartPred, spaceParser)-import SimpleParser.Input (matchChunk, matchToken, satisfyToken)-import SimpleParser.Parser (Parser, commitParser, onEmptyParser, orParser)-import SimpleParser.Stream (Stream (..), TextualStream)+import SimpleParser (Parser, Stream (..), TextLabel, TextualChunked (..), TextualStream, betweenParser, commitParser,+                     escapedStringParser, lexemeParser, matchChunk, matchToken, onEmptyParser, orParser, satisfyToken,+                     scientificParser, sepByParser, signedNumStartPred, spaceParser)  data JsonF a =     JsonObject !(Seq (Text, a))

@@ -18,13 +18,10 @@ import Data.Sequence (Seq) import Data.Text (Text) import Data.Void (Void)-import SimpleParser.Chunked (Chunked (..), packChunk)-import SimpleParser.Common (EmbedTextLabel (..), TextLabel, betweenParser, decimalParser, escapedStringParser,-                            lexemeParser, scientificParser, sepByParser, signedNumStartPred, signedParser, spaceParser)-import SimpleParser.Explain (ExplainLabel (..))-import SimpleParser.Input (matchToken, satisfyToken, takeTokensWhile)-import SimpleParser.Parser (Parser, commitParser, onEmptyParser, orParser)-import SimpleParser.Stream (TextualStream)+import SimpleParser (Chunked (..), EmbedTextLabel (..), ExplainLabel (..), Parser, TextLabel, TextualStream,+                     betweenParser, commitParser, decimalParser, escapedStringParser, lexemeParser, matchToken,+                     onEmptyParser, orParser, packChunk, satisfyToken, scientificParser, sepByParser,+                     signedNumStartPred, signedParser, spaceParser, takeTokensWhile)  data Atom =     AtomIdent !Text

@@ -1,7 +1,16 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE UndecidableInstances #-} -module SimpleParser.Explain where+module SimpleParser.Explain+  ( ExplainLabel (..)+  , ErrorExplanation (..)+  , ExplainError (..)+  , Explainable+  , ParseErrorExplanation (..)+  , explainParseError+  , buildParseErrorExplanation+  , buildAllParseErrorExplanations+  ) where  import Control.Monad (join) import Data.Foldable (toList)@@ -39,11 +48,11 @@       CompoundTextLabelText l -> explainLabel l       CompoundTextLabelCustom l -> explainLabel l -data ErrorExplanation = ErrorExplanation-  { eeReason :: !Builder-  , eeExpected :: !(Maybe Builder)-  , eeActual :: !(Maybe Builder)-  }+data ErrorExplanation  = ErrorExplanation+  { eeReason :: !Text+  , eeExpected :: !(Maybe Text)+  , eeActual :: !(Maybe Text)+  } deriving (Eq, Show)  class ExplainError e where   explainError :: e -> ErrorExplanation@@ -51,62 +60,68 @@ instance ExplainError Void where   explainError = absurd -endMsg :: Builder+endMsg :: Text endMsg = "end of stream"  tokB :: Char -> Builder tokB t = "token '" <> TB.char t <> "'" -mayTokB :: Maybe Char -> Builder-mayTokB = maybe endMsg tokB+tokT :: Char -> Text+tokT = TB.run . tokB +mayTokT :: Maybe Char -> Text+mayTokT = maybe endMsg tokT+ chunkB :: TextualChunked chunk => chunk -> Builder chunkB k = "chunk \"" <> buildChunk k <> "\"" -mayChunkB :: TextualChunked chunk => Maybe chunk -> Builder-mayChunkB = maybe endMsg chunkB+chunkT :: TextualChunked chunk => chunk -> Text+chunkT = TB.run . chunkB +mayChunkT :: TextualChunked chunk => Maybe chunk -> Text+mayChunkT = maybe endMsg chunkT+ instance (Token s ~ Char, TextualChunked (Chunk s)) => ExplainError (StreamError s) where   explainError (StreamError re) =     case re of       RawErrorMatchEnd actTok ->-        ErrorExplanation "failed to match end of stream" (Just endMsg) (Just (tokB actTok))+        ErrorExplanation "failed to match end of stream" (Just endMsg) (Just (tokT actTok))       RawErrorAnyToken ->         ErrorExplanation "failed to match any token" (Just "any token") (Just endMsg)       RawErrorAnyChunk ->         ErrorExplanation "failed to match any chunk" (Just "any chunk") (Just endMsg)       RawErrorSatisfyToken mayActTok ->-        ErrorExplanation "failed to satisfy token predicate" Nothing (Just (mayTokB mayActTok))+        ErrorExplanation "failed to satisfy token predicate" Nothing (Just (mayTokT mayActTok))       RawErrorMatchToken expTok mayActTok ->-        ErrorExplanation "failed to match token" (Just (tokB expTok)) (Just (mayTokB mayActTok))+        ErrorExplanation "failed to match token" (Just (tokT expTok)) (Just (mayTokT mayActTok))       RawErrorMatchChunk expChunk mayActChunk ->-        ErrorExplanation "failed to match chunk" (Just (chunkB expChunk)) (Just (mayChunkB mayActChunk))+        ErrorExplanation "failed to match chunk" (Just (chunkT expChunk)) (Just (mayChunkT mayActChunk))       RawErrorTakeTokensWhile1 mayActTok ->-        ErrorExplanation "failed to take 1 or more tokens" Nothing (Just (mayTokB mayActTok))+        ErrorExplanation "failed to take 1 or more tokens" Nothing (Just (mayTokT mayActTok))       RawErrorDropTokensWhile1 mayActTok ->-        ErrorExplanation "failed to drop 1 or more tokens" Nothing (Just (mayTokB mayActTok))+        ErrorExplanation "failed to drop 1 or more tokens" Nothing (Just (mayTokT mayActTok))  instance (Token s ~ Char, TextualChunked (Chunk s), ExplainError e) => ExplainError (CompoundError s e) where   explainError ce =     case ce of       CompoundErrorStream se -> explainError se-      CompoundErrorFail msg -> ErrorExplanation (TB.text msg) Nothing Nothing+      CompoundErrorFail msg -> ErrorExplanation msg Nothing Nothing       CompoundErrorCustom e -> explainError e  type Explainable l s e = (TextualStream s, ExplainLabel l, ExplainError e)  data ParseErrorExplanation p = ParseErrorExplanation   { peeSpan :: !(Span p)-  , peeContext :: !(Seq Builder)-  , peeDetails :: !(Maybe Builder)+  , peeContext :: !(Seq Text)+  , peeDetails :: !(Maybe Text)   , peeErrExp :: !ErrorExplanation-  }+  } deriving (Eq, Show)  explainParseError :: Explainable l s e => ParseError l s e -> ParseErrorExplanation (Pos s) explainParseError pe =   let (mayLab, sp) = parseErrorNarrowestSpan pe-      context = fmap explainLabel (parseErrorEnclosingLabels pe)-      mayDetails = fmap explainLabel mayLab+      context = fmap explainLabelText (parseErrorEnclosingLabels pe)+      mayDetails = fmap explainLabelText mayLab       errExp = explainError (peError pe)   in ParseErrorExplanation sp context mayDetails errExp @@ -116,19 +131,19 @@  buildErrorExplanation :: Maybe Builder -> ErrorExplanation -> [Builder] buildErrorExplanation mayDetails (ErrorExplanation reason mayExpected mayActual) = join-  [ ["[Reason  ] " <> reason]+  [ ["[Reason  ] " <> TB.text reason]   , maybe [] (\de -> ["[Details ] " <> de]) mayDetails-  , maybe [] (\ex -> ["[Expected] " <> ex]) mayExpected-  , maybe [] (\ac -> ["[Actual  ] " <> ac]) mayActual+  , maybe [] (\ex -> ["[Expected] " <> TB.text ex]) mayExpected+  , maybe [] (\ac -> ["[Actual  ] " <> TB.text ac]) mayActual   ]  buildParseErrorExplanation :: ParseErrorExplanation LinePos -> Builder buildParseErrorExplanation (ParseErrorExplanation sp context mayDetails errExp) =   let hd = join         [ ["[Pos       ] " <> buildSpan sp]-        , ["[Context   ] || " <> TB.intercalate " |> " context | not (Seq.null context)]+        , ["[Context   ] || " <> TB.intercalate " |> " (fmap TB.text (toList context)) | not (Seq.null context)]         ]-      tl = buildErrorExplanation mayDetails errExp+      tl = buildErrorExplanation (fmap TB.text mayDetails) errExp   in TB.intercalate "\n" (hd ++ tl)  buildAllParseErrorExplanations :: Foldable f => f (ParseErrorExplanation LinePos) -> Builder

@@ -156,8 +156,8 @@  -- | Catch only a subset of custom errors. This preserves label information vs rethrowing. catchJustParser :: Monad m => (e -> Maybe b) -> ParserT l s e m a -> (b -> ParserT l s e m a) -> ParserT l s e m a-catchJustParser filterer parser handler = ParserT (runParserT parser >=> go) where-    go mres =+catchJustParser filterer parser handler = ParserT (\s0 -> runParserT parser s0 >>= go s0) where+    go s0 mres =       case mres of         Nothing -> pure Nothing         Just res ->@@ -167,34 +167,34 @@               pure mres             ParseResultError es ->               -- Find first custom error to handle-              goSplit Empty (NESeq.toSeq es)+              goSplit s0 Empty (NESeq.toSeq es) -    goSplit beforeEs afterEs =+    goSplit s0 beforeEs afterEs =       case seqPartition extractCustomError afterEs of         Nothing ->           -- No next custom error, finally yield all other errors           pure (maybe empty (pure . ParseResultError) (NESeq.nonEmptySeq (beforeEs <> afterEs)))         Just sep ->           -- Found custom error - handle it-          goHandle beforeEs sep+          goHandle s0 beforeEs sep -    goHandle beforeEs (SeqPartition nextBeforeEs targetE (s, e) afterEs) =+    goHandle s0 beforeEs (SeqPartition nextBeforeEs targetE (_, e) afterEs) =       case filterer e of         Nothing ->           -- Not handling error;  - find next custom error-          goSplit (beforeEs <> (targetE :<| nextBeforeEs)) afterEs+          goSplit s0 (beforeEs <> (targetE :<| nextBeforeEs)) afterEs         Just b -> do-          mres <- runParserT (handler b) s+          mres <- runParserT (handler b) s0           case mres of             Nothing ->               -- No results from handled error - find next custom error-              goSplit (beforeEs <> nextBeforeEs) afterEs+              goSplit s0 (beforeEs <> nextBeforeEs) afterEs             Just res ->               case res of                 ParseResultSuccess _ -> pure mres                 ParseResultError es ->                   -- Add to list of errors and find next custom error-                  goSplit (beforeEs <> nextBeforeEs <> NESeq.toSeq es) afterEs+                  goSplit s0 (beforeEs <> nextBeforeEs <> NESeq.toSeq es) afterEs  -- | Throws a custom error throwParser :: Monad m => e -> ParserT l s e m a