{-# LANGUAGE Safe #-} {-# LANGUAGE TypeFamilies, AllowAmbiguousTypes, FlexibleInstances, FlexibleContexts #-} {-| Module : Text.Gigaparsec.Errors.ErrorBuilder Description : This typeclass specifies how to generate an error from a parser as a specified type. License : BSD-3-Clause Maintainer : Jamie Willis, Gigaparsec Maintainers Stability : stable This typeclass specifies how to generate an error from a parser as a specified type. An instance of this typeclass is required when calling 'Text.Gigaparsec.parse' (or similar). By default, @gigaparsec@ defines its own instance for @ErrorBuilder String@ found in this module. To implement @ErrorBuilder@, a number of methods must be defined, as well the representation types for a variety of different components; the relation between the various methods is closely linked to the types that they both produce and consume. To only change the basics of formatting without having to define the entire instance, use the methods found in "Text.Gigaparsec.Errors.DefaultErrorBuilder". = How an Error is Structured There are two kinds of error messages that are generated by @gigaparsec@: /Specialised/ and /Vanilla/. These are produced by different combinators and can be merged with other errors of the same type if both errors appear at the same offset. However, /Specialised/ errors will take precedence over /Vanilla/ errors if they appear at the same offset. The most common form of error is the /Vanilla/ variant, which is generated by most combinators, except for some in "Text.Gigaparsec.Errors.Combinator". Both types of error share some common structure, namely: - The error preamble, which has the file and the position. - The content lines, the specifics of which differ between the two types of error. - The context lines, which has the surrounding lines of input for contextualisation. == /Vanilla/ Errors There are three kinds of content line found in a /Vanilla/ error: 1. Unexpected info: this contains information about the kind of token that caused the error. 2. Expected info: this contains the information about what kinds of token could have avoided the error. 3. Reasons: these are the bespoke reasons that an error has occurred (as generated by 'Text.Gigaparsec.Errors.Combinator.explain'). There can be at most one unexpected line, at most one expected line, and zero or more reasons. Both of the unexpected and expected info are built up of /error items/, which are either: the end of input, a named token, raw input taken from the parser definition. These can all be formatted separately. The overall structure of a /Vanilla/ error is given in the following diagram: > ┌───────────────────────────────────────────────────────────────────────┐ > │ Vanilla Error │ > │ ┌────────────────┐◄──────── position │ > │ source │ │ │ > │ │ │ line col│ │ > │ ▼ │ │ ││ │ > │ ┌─────┐ │ ▼ ▼│ end of input │ > │ In foo.txt (line 1, column 5): │ │ > │ ┌─────────────────────┐ │ │ > │unexpected ─────►│ │ │ ┌───── expected │ > │ │ ┌──────────┐ ◄──────────┘ │ │ > │ unexpected end of input ▼ │ > │ ┌──────────────────────────────────────┐ │ > │ expected "(", "negate", digit, or letter │ > │ │ └──────┘ └───┘ └────┘ ◄────── named│ > │ │ ▲ └──────────┘ │ │ > │ │ │ │ │ > │ │ raw │ │ > │ └─────────────────┬───────────┘ │ > │ '-' is a binary operator │ │ > │ └──────────────────────┘ │ │ > │ ┌──────┐ ▲ │ │ > │ │>3+4- │ │ expected items │ > │ │ ^│ │ │ > │ └──────┘ └───────────────── reason │ > │ ▲ │ > │ │ │ > │ line info │ > └───────────────────────────────────────────────────────────────────────┘ == /Specialised/ Errors There is only one kind of content found in a /Specialised/ error: a message. These are completely free-form, and are generated by the 'Text.Gigaparsec.Errors.Combinator.failWide' combinator, as well as its derived combinators. There can be one or more messages in a /Specialised/ error. The overall structure of a /Specialised/ error is given in the following diagram: > ┌───────────────────────────────────────────────────────────────────────┐ > │ Specialised Error │ > │ ┌────────────────┐◄──────── position │ > │ source │ │ │ > │ │ │ line col │ > │ ▼ │ │ │ │ > │ ┌─────┐ │ ▼ ▼ │ > │ In foo.txt (line 1, column 5): │ > │ │ > │ ┌───► something went wrong │ > │ │ │ > │ message ──┼───► it looks like a binary operator has no argument │ > │ │ │ > │ └───► '-' is a binary operator │ > │ ┌──────┐ │ > │ │>3+4- │ │ > │ │ ^│ │ > │ └──────┘ │ > │ ▲ │ > │ │ │ > │ line info │ > └───────────────────────────────────────────────────────────────────────┘ @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, buildDefault , vanillaErrorDefault, specialisedErrorDefault , rawDefault, namedDefault, endOfInputDefault , expectedDefault, unexpectedDefault , disjunct, combineMessagesDefault , posDefault, lineInfoDefault ) import {-# SOURCE #-} Text.Gigaparsec.Errors.TokenExtractors (Token(Named, Raw), tillNextWhitespace) import Data.Char (isSpace) import Data.Kind (Constraint) import Data.List.NonEmpty (NonEmpty) 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 construct an error message generated by a parser in a represention the parser writer desires. -} type ErrorBuilder :: * -> Constraint class Ord (Item err) => ErrorBuilder err where {-| This is the top level function, which finally compiles all the built sub-parts into a finished value of type @err@. -} build :: Position err -- ^ the representation of the position of the error in the input (see the 'pos' method). -> Source err -- ^ the representation of the filename, if it exists (see the 'source' method). -> ErrorInfoLines err -- ^ the main body of the error message (see 'vanillaError' or 'specialisedError' methods). -> err -- ^ the final error message -- | The representation type of position information within the generated message. type Position err -- | The representation of the file information. type Source err {-| Converts a position into the representation type given by 'Position'. -} pos :: Word -- ^ the line the error occurred at. -> Word -- ^ the column the error occurred at. -> Position err -- ^ a representation of the position. {-| Converts the name of the file parsed from, if it exists, into the type given by 'Source'. -} source :: Maybe FilePath -- ^ the source name of the file, if any. -> Source err -- | The representation type of the main body within the error message. type ErrorInfoLines err {-| Vanilla errors are those produced such that they have information about both @expected@ and @unexpected@ tokens. These are usually the default, and are not produced by @fail@ (or any derivative) combinators. -} vanillaError :: UnexpectedLine err -- ^ information about which token(s) caused the error (see the 'unexpected' method). -> ExpectedLine err -- ^ information about which token(s) would have avoided the error (see the 'expected' method). -> Messages err -- ^ additional information about why the error occured (see the 'combineMessages' method). -> LineInfo err -- ^ representation of the line of input that this error occured on (see the 'lineInfo' method). -> ErrorInfoLines err {-| Specialised errors are triggered by @fail@ and any combinators that are implemented in terms of @fail@. These errors take precedence over the vanilla errors, and contain less, more specialised, information. -} specialisedError :: Messages err -- ^ information detailing the error (see the 'combineMessages' method). -> LineInfo err -- ^ representation of the line of input that this error occured on (see the 'lineInfo' method). -> ErrorInfoLines err -- | The representation of all the different possible tokens that could have prevented an error. type ExpectedItems err -- | The representation of the combined reasons or failure messages from the parser. type Messages err {-| Details how to combine the various expected items into a single representation. -} combineExpectedItems :: Set (Item err) -- ^ the possible items that fix the error. -> ExpectedItems err {-| Details how to combine any reasons or messages generated within a single error. Reasons are used by @vanilla@ messages and messages are used by @specialised@ messages. -} combineMessages :: [Message err] -- ^ the messages to combine (see the 'message' or 'reason' methods). -> Messages err -- | The representation of the information regarding the problematic token. type UnexpectedLine err -- | The representation of the information regarding the solving tokens. type ExpectedLine err -- | The representation of a reason or a message generated by the parser. type Message err -- | The representation of the line of input where the error occurred. type LineInfo err {-| Describes how to handle the (potentially missing) information about what token(s) caused the error. -} unexpected :: Maybe (Item err) -- ^ the @Item@ that caused this error. -> UnexpectedLine err {-| Describes how to handle the information about the tokens that could have avoided the error. -} expected :: ExpectedItems err -- ^ the tokens that could have prevented the error (see 'combineExpectedItems'). -> ExpectedLine err {-| Describes how to represent the reasons behind a parser fail. These reasons originate from the 'Text.Gigaparsec.Errors.Combinator.explain' combinator. -} reason :: String -- ^ the reason produced by the parser. -> Message err {-| Describes how to represent the messages produced by the 'Text.Gigaparsec.Errors.Combinator.fail' combinator (or any that are implemented using it). -} message :: String -- ^ the message produced by the parser. -> Message err {-| Describes how to process the information about the line that the error occured on, and its surrounding context. -} lineInfo :: String -- ^ the full line of input that produced this error message. -> [String] -- ^ the lines of input from just before the one that produced this message (up to 'numLinesBefore'). -> [String] -- ^ the lines of input from just after the one that produced this message (up to 'numLinesAfter'). -> Word -- ^ the line number of the error message -> Word -- ^ the offset into the line that the error points at. -> Word -- ^ how wide the caret in the message should be. -> LineInfo err -- | The number of lines of input to request before an error occured. numLinesBefore :: Int -- | The number of lines of input to request after an error occured. numLinesAfter :: Int -- | The type that represents the individual items within the error. It must be -- orderable, as it is used within @Set@. type Item err {-| Converts a raw item generated by either the input string or a input reading combinator without a label. -} raw :: String -- ^ the raw, unprocessed input. -> Item err -- | Converts a named item generated by a label. named :: String -- ^ the name given to the label. -> Item err -- | Value that represents the end of the input in the error message. endOfInput :: Item err {-| Extracts an unexpected token from the remaining input. When a parser fails, by default an error reports an unexpected token of a specific width. This works well for some parsers, but often it is nice to have the illusion of a dedicated lexing pass: instead of reporting the next few characters as unexpected, an unexpected token 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. 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 -- (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. {-| Builds error messages as @String@, using the functions found in "Text.Gigaparsec.Errors.DefaultErrorBuilder". -} instance ErrorBuilder String where {-# INLINE build #-} build = buildDefault type Position String = StringBuilder type Source String = Maybe StringBuilder {-# INLINE pos #-} pos = posDefault {-# INLINE source #-} source = fmap fromString type ErrorInfoLines String = [StringBuilder] {-# INLINE vanillaError #-} vanillaError = vanillaErrorDefault {-# INLINE specialisedError #-} specialisedError = specialisedErrorDefault type ExpectedItems String = Maybe StringBuilder type Messages String = [StringBuilder] {-# INLINE combineExpectedItems #-} combineExpectedItems = disjunct True . Set.toList {-# INLINE combineMessages #-} combineMessages = combineMessagesDefault type UnexpectedLine String = Maybe StringBuilder type ExpectedLine String = Maybe StringBuilder type Message String = String type LineInfo String = [StringBuilder] {-# INLINE unexpected #-} unexpected = unexpectedDefault {-# INLINE expected #-} expected = expectedDefault {-# INLINE reason #-} reason = id {-# INLINE message #-} message = id {-# INLINE lineInfo #-} lineInfo = lineInfoDefault {-# INLINE numLinesBefore #-} numLinesBefore = 1 {-# INLINE numLinesAfter #-} numLinesAfter = 1 type Item String = String {-# INLINE raw #-} raw = rawDefault {-# INLINE named #-} named = namedDefault {-# INLINE endOfInput #-} endOfInput = endOfInputDefault {-# INLINABLE unexpectedToken #-} unexpectedToken = tillNextWhitespace True isSpace {-| Can be used to ignore error messages, by just returning a @()@. -} instance ErrorBuilder () where build _ _ _ = () 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 build = 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