gigaparsec 0.2.4.1 → 0.2.5.0

raw patch · 4 files changed

+255/−16 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• gigaparsec.cabal +2/−4
• src/Text/Gigaparsec/Errors/ErrorBuilder.hs +73/−1
• src/Text/Gigaparsec/Errors/TokenExtractors.hs +176/−11

@@ -1,5 +1,9 @@ # Revision history for gigaparsec +## 0.2.5.0 -- 2024-02-04+* Supported `Text.Gigaparsec.Errors.TokenExtractors`, which allows for recipes for token extraction+  during error message creation.+ ## 0.2.4.1 -- 2024-02-04 * Fixed infinite loop in lexer arising from forcing a knot-tie, the knot has been massaged out. 

@@ -20,7 +20,7 @@ -- PVP summary:     +-+------- breaking API changes --                  | | +----- non-breaking API additions --                  | | | +--- code changes with no API change-version:            0.2.4.1+version:            0.2.5.0  -- A short (one-line) description of the package. synopsis:@@ -78,8 +78,6 @@ library     import:           warnings, extensions, base -    other-modules:    Text.Gigaparsec.Errors.TokenExtractors-     -- Modules exported by the library.     exposed-modules:  Text.Gigaparsec,                       Text.Gigaparsec.Char,@@ -91,7 +89,7 @@                       Text.Gigaparsec.Errors.ErrorBuilder,                       Text.Gigaparsec.Errors.ErrorGen,                       Text.Gigaparsec.Errors.Patterns,-+                      Text.Gigaparsec.Errors.TokenExtractors,                       Text.Gigaparsec.Expr,                       Text.Gigaparsec.Expr.Chain,                       Text.Gigaparsec.Expr.Infix,

@@ -114,6 +114,7 @@  @since 0.2.0.0 -}+-- TODO: at 0.3.0.0, remove the Token re-export, because hs-boot doesn't carry docs module Text.Gigaparsec.Errors.ErrorBuilder (ErrorBuilder(..), Token(..)) where  import Text.Gigaparsec.Errors.DefaultErrorBuilder ( StringBuilder, formatDefault@@ -131,6 +132,7 @@ import Data.Set (Set) import Data.Set qualified as Set (toList) import Data.String (IsString(fromString))+import Data.Void (Void)  {-| This class describes how to format an error message generated by a parser into@@ -277,7 +279,8 @@   can be reported instead. This can take many forms, for instance trimming the token to the   next whitespace, only taking one character, or even trying to lex a token out of the stream. -  TODO: talk about the token extractors when they are added.+  This method can be easily implemented by using an appropriate /token extractor/ from+  "Text.Gigaparsec.Errors.TokenExtractors".   -}   unexpectedToken :: NonEmpty Char -- ^ the remaining input, @cs@, at point of failure.                   -> Word          -- ^ the input the parser tried to read when it failed@@ -349,3 +352,72 @@    {-# INLINABLE unexpectedToken #-}   unexpectedToken = tillNextWhitespace True isSpace++{-|+Can be used to ignore error messages, by just returning a @()@.+-}+instance ErrorBuilder () where+  format _ _ _ = ()+  type Position () = ()+  type Source () = ()+  type ErrorInfoLines () = ()+  type ExpectedItems () = ()+  type Messages () = ()+  type UnexpectedLine () = ()+  type ExpectedLine () = ()+  type Message () = ()+  type LineInfo () = ()+  type Item () = ()++  pos = undefined+  source = undefined+  vanillaError = undefined+  specialisedError = undefined+  combineExpectedItems = undefined+  combineMessages = undefined+  unexpected = undefined+  expected = undefined+  reason = undefined+  message = undefined+  lineInfo = undefined+  numLinesBefore = undefined+  numLinesAfter = undefined+  raw = undefined+  named = undefined+  endOfInput = undefined+  unexpectedToken = undefined++{-|+This builder denotes that failure of a parser is impossible, as its errors are+uninhabited.+-}+instance ErrorBuilder Void where+  format = undefined+  type Position Void = Void+  type Source Void = Void+  type ErrorInfoLines Void = Void+  type ExpectedItems Void = Void+  type Messages Void = Void+  type UnexpectedLine Void = Void+  type ExpectedLine Void = Void+  type Message Void = Void+  type LineInfo Void = Void+  type Item Void = Void++  pos = undefined+  source = undefined+  vanillaError = undefined+  specialisedError = undefined+  combineExpectedItems = undefined+  combineMessages = undefined+  unexpected = undefined+  expected = undefined+  reason = undefined+  message = undefined+  lineInfo = undefined+  numLinesBefore = undefined+  numLinesAfter = undefined+  raw = undefined+  named = undefined+  endOfInput = undefined+  unexpectedToken = undefined

@@ -1,30 +1,73 @@ {-# LANGUAGE Safe #-} {-# LANGUAGE ViewPatterns #-}+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}+{-|+Module      : Text.Gigaparsec.Errors.TokenExtractors+Description : This module contains implementations of token extractors that can be used in the+              @ErrorBuilder@ to decide how to extract unexpected tokens from the residual input left+              over from a parse error.+License     : BSD-3-Clause+Maintainer  : Jamie Willis, Gigaparsec Maintainers+Stability   : stable++This module contains implementations of token extractors that can be used in the+"Text.Gigaparsec.Errors.ErrorBuilder" to decide how to extract unexpected tokens from the residual+input left over from a parse error.++These are common strategies, and something here is likely to be what is needed. They are all careful+to handle unprintable characters and whitespace in a sensible way, and account for unicode codepoints+that are wider than a single 16-bit character.++@since 0.2.5.0+-} module Text.Gigaparsec.Errors.TokenExtractors (     Token(..), TokenExtractor,     tillNextWhitespace,     singleChar,-    matchParserDemand--,-    --lexToken+    matchParserDemand,+    lexToken, lexTokenWithSelect   ) where -import Text.Gigaparsec (Parsec)+import Text.Gigaparsec (+    Parsec, Result(Success), parse,+    atomic, lookAhead, notFollowedBy, some, (<+>), (<~>), mapMaybeS+  )+import Text.Gigaparsec.Char (item)+import Text.Gigaparsec.Combinator (option)+import Text.Gigaparsec.Position (offset)  import Data.Char (generalCategory, ord, GeneralCategory(Format, Surrogate, PrivateUse, NotAssigned, Control)) import Data.Char qualified as Char (isSpace)-import Data.List.NonEmpty (NonEmpty((:|)))+import Data.List.NonEmpty (NonEmpty((:|)), nonEmpty)+import Data.List.NonEmpty qualified as NonEmpty (toList)+import Data.Void (Void) import Data.Foldable (maximumBy) import Numeric (showHex) import Data.Function (on)+import Data.Maybe (catMaybes) +{-|+Type alias for token extractors, matches the shape of+'Text.Gigaparsec.Errors.ErrorBuilder.unexpectedToken'.++@since 0.2.5.0+-} type TokenExtractor :: *-type TokenExtractor = NonEmpty Char -> Word -> Bool -> Token+type TokenExtractor = NonEmpty Char -- ^ the remaining input, @cs@, at point of failure.+                    -> Word         -- ^ the input the parser tried to read when it failed+                                    --   (this is __not__ guaranteed to be smaller than the length of+                                    --    @cs@, but is __guaranteed to be greater than 0__).+                    -> Bool         -- ^ was this error generated as part of \"lexing\", or in a wider parser (see 'Text.Gigaparsec.Errors.Combinator.markAsToken').+                    -> Token        -- ^ a token extracted from @cs@ that will be used as part of the unexpected message.  {-|-This type represents an extracted token returned by 'unexpectedToken' in 'ErrorBuilder'.+This type represents an extracted token returned by 'Text.Gigaparsec.Errors.ErrorBuilder.unexpectedToken'+in 'Text.Gigaparsec.Errors.ErrorBuilder.ErrorBuilder'.  There is deliberately no analogue for @EndOfInput@ because we guarantee that non-empty residual input is provided to token extraction.++@since 0.2.5.0 -} type Token :: * data Token = Raw                   -- ^ This is a token that is directly extracted from the residual input itself.@@ -34,22 +77,55 @@               {-# UNPACK #-} !Word -- ^ the amount of residual input this token ate.  {-# INLINABLE tillNextWhitespace #-}--- TillNextWhitespace with matches parser demand-tillNextWhitespace :: Bool -> (Char -> Bool) -> TokenExtractor+{-|+This extractor provides an implementation for 'Text.Gigaparsec.ErrorBuilder.unexpectedToken':+it will construct a token that extends to the next available whitespace in the remaining input.+It can be configured to constrict this token to the minimum of the next whitespace or whatever the+parser demanded.++In the case of unprintable characters or whitespace, this extractor will favour reporting a more+meaningful name.++@since 0.2.5.0+-}+tillNextWhitespace :: Bool           -- ^ should the extractor cap the token to the amount of input the parser demanded?+                   -> (Char -> Bool) -- ^ what counts as a space character+                   -> TokenExtractor tillNextWhitespace _ _ (whitespaceOrUnprintable -> Just tok) _ _ = tok tillNextWhitespace trimToDemand isSpace (c :| cs) parserDemanded _   | trimToDemand = Raw (take (fromIntegral parserDemanded) (tillSpace (c:cs)))   | otherwise    = Raw (tillSpace (c:cs))   where tillSpace = takeWhile (not . isSpace) +{-|+This extractor provides an implementation for 'Text.Gigaparsec.ErrorBuilder.unexpectedToken':+it will unconditionally report the first character in the remaining input as the problematic token.++In the case of unprintable characters or whitespace, this extractor will favour reporting+a more meaningful name.++@since 0.2.5.0+-}+{-# INLINABLE singleChar #-} singleChar :: TokenExtractor singleChar (whitespaceOrUnprintable -> Just tok) _ _ = tok singleChar (c :| _) _ _ = Raw [c] +{-|+This extractor provides an implementation for 'Text.Gigaparsec.ErrorBuilder.unexpectedToken':+it will make a token as wide as the amount of input the parser tried to consume when it failed.++In the case of unprintable characters or whitespace, this extractor will favour reporting a more+meaningful name.++@since 0.2.5.0+-}+{-# INLINABLE matchParserDemand #-} matchParserDemand :: TokenExtractor matchParserDemand (whitespaceOrUnprintable -> Just tok) _ _ = tok matchParserDemand (c :| cs) parserDemanded _ = Raw (take (fromIntegral parserDemanded) (c:cs)) +{-# INLINABLE whitespaceOrUnprintable #-} whitespaceOrUnprintable :: NonEmpty Char -> Maybe Token whitespaceOrUnprintable ('\n' :| _) = Just $ Named "newline" 1 whitespaceOrUnprintable ('\r' :| _) = Just $ Named "carriage return" 1@@ -66,8 +142,97 @@     _ -> Nothing   where unprintable = Just $ Named ("non-printable character (\\x" ++ showHex (ord c) ")") 1 -lexToken :: [Parsec String] -> TokenExtractor -> TokenExtractor+{-|+This extractor provides an implementation for 'Text.Gigaparsec.ErrorBuilder.unexpectedToken':+it will try and parse the residual input to identify a valid lexical token to report.++When parsing a grammar that as a dedicated lexical distinction, it is nice to be able to report+problematic tokens relevant to that grammar as opposed to generic input lifted straight from the+input stream. The easiest way of doing this would be having a pre-lexing pass and parsing based+on tokens, but this is deliberately not how Parsley is designed. Instead, this extractor can+try and parse the remaining input to try and identify a token on demand.++If the @lexicalError@ flag of the @unexpectedToken@ function is not set, which would indicate a+problem within a token reported by a classical lexer and not the parser, the extractor will+try to parse each of the provided @tokens@ in turn: whichever is the longest matched of these+tokens will be reported as the problematic one, where an earlier token arbitrates ties+('lexTokenWithSelect' can alter which is chosen). For best effect, these tokens should not consume+whitespace (which would otherwise be included at the end of the token!): this means that, if+using the @Lexer@, the functionality in __@nonlexeme@__ should be used. If one of the+givens tokens cannot be parsed, the input until the /next/ valid parsable token (or end of input)+is returned as a @Raw@.++If @lexicalError@ is true, then the given token extractor will be used instead to extract a+default token.++@since 0.2.5.0+-}+{-# INLINABLE lexToken #-}+lexToken :: [Parsec String] -- ^ The tokens that should be recognised by this extractor: each parser should return the+                            -- intended name of the token exactly as it should appear in the "Named" token.+                            --+                            -- This /should/ include a whitespace parser for "unexpected whitespace". However, with the+                            -- exception of the whitespace parser, these tokens should not consume trailing (and+                            -- certainly not leading) whitespace: if using definitions from "Text.Gigaparsec.Token.Lexer"+                            -- functionality, the @nonlexeme@ versions of the tokens should be used.+         -> TokenExtractor  -- ^ If the parser failed during the parsing of a token, this+                            -- function extracts the problematic item from the remaining input.+         -> TokenExtractor lexToken = lexTokenWithSelect (maximumBy (compare `on` snd)) -lexTokenWithSelect :: (NonEmpty (String, Word) -> (String, Word)) -> [Parsec String] -> TokenExtractor -> TokenExtractor-lexTokenWithSelect = undefined+{-|+This extractor provides an implementation for 'Text.Gigaparsec.ErrorBuilder.unexpectedToken':+it will try and parse the residual input to identify a valid lexical token to report.++When parsing a grammar that as a dedicated lexical distinction, it is nice to be able to report+problematic tokens relevant to that grammar as opposed to generic input lifted straight from the+input stream. The easiest way of doing this would be having a pre-lexing pass and parsing based+on tokens, but this is deliberately not how Parsley is designed. Instead, this extractor can+try and parse the remaining input to try and identify a token on demand.++If the @lexicalError@ flag of the @unexpectedToken@ function is not set, which would indicate a+problem within a token reported by a classical lexer and not the parser, the extractor will+try to parse each of the provided @tokens@ in turn: the given function is used to select which+is returned.+For best effect, these tokens should not consume+whitespace (which would otherwise be included at the end of the token!): this means that, if+using the @Lexer@, the functionality in __@nonlexeme@__ should be used. If one of the+givens tokens cannot be parsed, the input until the /next/ valid parsable token (or end of input)+is returned as a @Raw@.++If @lexicalError@ is true, then the given token extractor will be used instead to extract a+default token.++@since 0.2.5.0+-}+{-# INLINABLE lexTokenWithSelect #-}+lexTokenWithSelect :: (NonEmpty (String, Word) -> (String, Word))+                   -- ^ If the extractor is successful in identifying tokens that can be parsed from+                   -- the residual input, this function will select /one/ of them to report back.+                   -> [Parsec String]+                   -- ^ The tokens that should be recognised by this extractor: each parser should return the+                   -- intended name of the token exactly as it should appear in the "Named" token.+                   --+                   -- This /should/ include a whitespace parser for "unexpected whitespace". However, with the+                   -- exception of the whitespace parser, these tokens should not consume trailing (and+                   -- certainly not leading) whitespace: if using definitions from "Text.Gigaparsec.Token.Lexer"+                   -- functionality, the @nonlexeme@ versions of the tokens should be used.+                   -> TokenExtractor+                   -- ^ If the parser failed during the parsing of a token, this+                   -- function extracts the problematic item from the remaining input.+                   -> TokenExtractor+lexTokenWithSelect selectToken tokens extractItem cs parserDemanded lexical+  | lexical = extractItem cs parserDemanded True+  | otherwise = extractToken cs+  where+    extractToken :: NonEmpty Char -> Token+    extractToken inp =+      let Success rawOrToks = parse @Void parser (NonEmpty.toList inp)+      in either (uncurry Named . selectToken) Raw rawOrToks++    parser :: Parsec (Either (NonEmpty (String, Word)) String)+    parser =+      let toks = mapMaybeS (nonEmpty . catMaybes)+                           (traverse (\t -> option (lookAhead (atomic t <~> offset))) tokens)+          rawTok = some (traverse notFollowedBy tokens *> item)+      in toks <+> rawTok