Copyright | © 2015–present Megaparsec contributors |
---|---|
License | FreeBSD |
Maintainer | Mark Karpov <markkarpov92@gmail.com> |
Stability | experimental |
Portability | portable |
Safe Haskell | Safe |
Language | Haskell2010 |
Text.Megaparsec.Error
Contents
Description
Parse errors. The current version of Megaparsec supports typed errors
instead of String
-based ones. This gives a lot of flexibility in
describing what exactly went wrong as well as a way to return arbitrary
data in case of failure.
You probably do not want to import this module directly because Text.Megaparsec re-exports it anyway.
Synopsis
- data ErrorItem t
- = Tokens (NonEmpty t)
- | Label (NonEmpty Char)
- | EndOfInput
- data ErrorFancy e
- = ErrorFail String
- | ErrorIndentation Ordering Pos Pos
- | ErrorCustom e
- data ParseError s e
- = TrivialError Int (Maybe (ErrorItem (Token s))) (Set (ErrorItem (Token s)))
- | FancyError Int (Set (ErrorFancy e))
- mapParseError :: Ord e' => (e -> e') -> ParseError s e -> ParseError s e'
- errorOffset :: ParseError s e -> Int
- setErrorOffset :: Int -> ParseError s e -> ParseError s e
- data ParseErrorBundle s e = ParseErrorBundle {
- bundleErrors :: NonEmpty (ParseError s e)
- bundlePosState :: PosState s
- attachSourcePos :: (Traversable t, TraversableStream s) => (a -> Int) -> t a -> PosState s -> (t (a, SourcePos), PosState s)
- class Ord a => ShowErrorComponent a where
- showErrorComponent :: a -> String
- errorComponentLen :: a -> Int
- errorBundlePretty :: forall s e. (VisualStream s, TraversableStream s, ShowErrorComponent e) => ParseErrorBundle s e -> String
- parseErrorPretty :: (VisualStream s, ShowErrorComponent e) => ParseError s e -> String
- parseErrorTextPretty :: forall s e. (VisualStream s, ShowErrorComponent e) => ParseError s e -> String
- showErrorItem :: VisualStream s => Proxy s -> ErrorItem (Token s) -> String
Parse error type
A data type that is used to represent “unexpected/expected” items in
ParseError
. It is parametrized over the token type t
.
Since: 5.0.0
Constructors
Tokens (NonEmpty t) | Non-empty stream of tokens |
Label (NonEmpty Char) | Label (cannot be empty) |
EndOfInput | End of input |
Instances
Functor ErrorItem # | |
Data t => Data (ErrorItem t) # | |
Defined in Text.Megaparsec.Error Methods gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> ErrorItem t -> c (ErrorItem t) gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (ErrorItem t) toConstr :: ErrorItem t -> Constr dataTypeOf :: ErrorItem t -> DataType dataCast1 :: Typeable t0 => (forall d. Data d => c (t0 d)) -> Maybe (c (ErrorItem t)) dataCast2 :: Typeable t0 => (forall d e. (Data d, Data e) => c (t0 d e)) -> Maybe (c (ErrorItem t)) gmapT :: (forall b. Data b => b -> b) -> ErrorItem t -> ErrorItem t gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> ErrorItem t -> r gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> ErrorItem t -> r gmapQ :: (forall d. Data d => d -> u) -> ErrorItem t -> [u] gmapQi :: Int -> (forall d. Data d => d -> u) -> ErrorItem t -> u gmapM :: Monad m => (forall d. Data d => d -> m d) -> ErrorItem t -> m (ErrorItem t) gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> ErrorItem t -> m (ErrorItem t) gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> ErrorItem t -> m (ErrorItem t) | |
Generic (ErrorItem t) # | |
Read t => Read (ErrorItem t) # | |
Defined in Text.Megaparsec.Error | |
Show t => Show (ErrorItem t) # | |
NFData t => NFData (ErrorItem t) # | |
Defined in Text.Megaparsec.Error | |
Eq t => Eq (ErrorItem t) # | |
Ord t => Ord (ErrorItem t) # | |
Defined in Text.Megaparsec.Error | |
type Rep (ErrorItem t) # | |
Defined in Text.Megaparsec.Error type Rep (ErrorItem t) = D1 ('MetaData "ErrorItem" "Text.Megaparsec.Error" "megaparsec-9.6.0-6cDk6wja3Qf4Glh1AI6lFI" 'False) (C1 ('MetaCons "Tokens" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (NonEmpty t))) :+: (C1 ('MetaCons "Label" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (NonEmpty Char))) :+: C1 ('MetaCons "EndOfInput" 'PrefixI 'False) (U1 :: Type -> Type))) |
data ErrorFancy e #
Additional error data, extendable by user. When no custom data is
necessary, the type is typically indexed by Void
to “cancel” the
ErrorCustom
constructor.
Since: 6.0.0
Constructors
ErrorFail String |
|
ErrorIndentation Ordering Pos Pos | Incorrect indentation error: desired ordering between reference level and actual level, reference indentation level, actual indentation level |
ErrorCustom e | Custom error data |
Instances
Functor ErrorFancy # | |
Defined in Text.Megaparsec.Error | |
Data e => Data (ErrorFancy e) # | |
Defined in Text.Megaparsec.Error Methods gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> ErrorFancy e -> c (ErrorFancy e) gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (ErrorFancy e) toConstr :: ErrorFancy e -> Constr dataTypeOf :: ErrorFancy e -> DataType dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (ErrorFancy e)) dataCast2 :: Typeable t => (forall d e0. (Data d, Data e0) => c (t d e0)) -> Maybe (c (ErrorFancy e)) gmapT :: (forall b. Data b => b -> b) -> ErrorFancy e -> ErrorFancy e gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> ErrorFancy e -> r gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> ErrorFancy e -> r gmapQ :: (forall d. Data d => d -> u) -> ErrorFancy e -> [u] gmapQi :: Int -> (forall d. Data d => d -> u) -> ErrorFancy e -> u gmapM :: Monad m => (forall d. Data d => d -> m d) -> ErrorFancy e -> m (ErrorFancy e) gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> ErrorFancy e -> m (ErrorFancy e) gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> ErrorFancy e -> m (ErrorFancy e) | |
Generic (ErrorFancy e) # | |
Defined in Text.Megaparsec.Error Associated Types type Rep (ErrorFancy e) :: Type -> Type | |
Read e => Read (ErrorFancy e) # | |
Defined in Text.Megaparsec.Error Methods readsPrec :: Int -> ReadS (ErrorFancy e) readList :: ReadS [ErrorFancy e] readPrec :: ReadPrec (ErrorFancy e) readListPrec :: ReadPrec [ErrorFancy e] | |
Show e => Show (ErrorFancy e) # | |
Defined in Text.Megaparsec.Error Methods showsPrec :: Int -> ErrorFancy e -> ShowS show :: ErrorFancy e -> String showList :: [ErrorFancy e] -> ShowS | |
NFData a => NFData (ErrorFancy a) # | |
Defined in Text.Megaparsec.Error Methods rnf :: ErrorFancy a -> () | |
Eq e => Eq (ErrorFancy e) # | |
Defined in Text.Megaparsec.Error | |
Ord e => Ord (ErrorFancy e) # | |
Defined in Text.Megaparsec.Error Methods compare :: ErrorFancy e -> ErrorFancy e -> Ordering (<) :: ErrorFancy e -> ErrorFancy e -> Bool (<=) :: ErrorFancy e -> ErrorFancy e -> Bool (>) :: ErrorFancy e -> ErrorFancy e -> Bool (>=) :: ErrorFancy e -> ErrorFancy e -> Bool max :: ErrorFancy e -> ErrorFancy e -> ErrorFancy e min :: ErrorFancy e -> ErrorFancy e -> ErrorFancy e | |
type Rep (ErrorFancy e) # | |
Defined in Text.Megaparsec.Error type Rep (ErrorFancy e) = D1 ('MetaData "ErrorFancy" "Text.Megaparsec.Error" "megaparsec-9.6.0-6cDk6wja3Qf4Glh1AI6lFI" 'False) (C1 ('MetaCons "ErrorFail" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 String)) :+: (C1 ('MetaCons "ErrorIndentation" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Ordering) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Pos) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Pos))) :+: C1 ('MetaCons "ErrorCustom" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 e)))) |
data ParseError s e #
represents a parse error parametrized over the
stream type ParseError
s es
and the custom data e
.
Semigroup
and Monoid
instances of the data type allow us to merge
parse errors from different branches of parsing. When merging two
ParseError
s, the longest match is preferred; if positions are the same,
custom data sets and collections of message items are combined. Note that
fancy errors take precedence over trivial errors in merging.
Since: 7.0.0
Constructors
TrivialError Int (Maybe (ErrorItem (Token s))) (Set (ErrorItem (Token s))) | Trivial errors, generated by the Megaparsec's machinery. The data constructor includes the offset of error, unexpected token (if any), and expected tokens. Type of the first argument was changed in the version 7.0.0. |
FancyError Int (Set (ErrorFancy e)) | Fancy, custom errors. Type of the first argument was changed in the version 7.0.0. |
Instances
(Data s, Data (Token s), Ord (Token s), Data e, Ord e) => Data (ParseError s e) # | |
Defined in Text.Megaparsec.Error Methods gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> ParseError s e -> c (ParseError s e) gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (ParseError s e) toConstr :: ParseError s e -> Constr dataTypeOf :: ParseError s e -> DataType dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (ParseError s e)) dataCast2 :: Typeable t => (forall d e0. (Data d, Data e0) => c (t d e0)) -> Maybe (c (ParseError s e)) gmapT :: (forall b. Data b => b -> b) -> ParseError s e -> ParseError s e gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> ParseError s e -> r gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> ParseError s e -> r gmapQ :: (forall d. Data d => d -> u) -> ParseError s e -> [u] gmapQi :: Int -> (forall d. Data d => d -> u) -> ParseError s e -> u gmapM :: Monad m => (forall d. Data d => d -> m d) -> ParseError s e -> m (ParseError s e) gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> ParseError s e -> m (ParseError s e) gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> ParseError s e -> m (ParseError s e) | |
(Stream s, Ord e) => Monoid (ParseError s e) # | |
Defined in Text.Megaparsec.Error Methods mempty :: ParseError s e mappend :: ParseError s e -> ParseError s e -> ParseError s e mconcat :: [ParseError s e] -> ParseError s e | |
(Stream s, Ord e) => Semigroup (ParseError s e) # | |
Defined in Text.Megaparsec.Error Methods (<>) :: ParseError s e -> ParseError s e -> ParseError s e sconcat :: NonEmpty (ParseError s e) -> ParseError s e stimes :: Integral b => b -> ParseError s e -> ParseError s e | |
(Show s, Show (Token s), Show e, ShowErrorComponent e, VisualStream s, Typeable s, Typeable e) => Exception (ParseError s e) # | |
Defined in Text.Megaparsec.Error Methods toException :: ParseError s e -> SomeException fromException :: SomeException -> Maybe (ParseError s e) displayException :: ParseError s e -> String | |
Generic (ParseError s e) # | |
Defined in Text.Megaparsec.Error Associated Types type Rep (ParseError s e) :: Type -> Type Methods from :: ParseError s e -> Rep (ParseError s e) x to :: Rep (ParseError s e) x -> ParseError s e | |
(Show (Token s), Show e) => Show (ParseError s e) # | |
Defined in Text.Megaparsec.Error Methods showsPrec :: Int -> ParseError s e -> ShowS show :: ParseError s e -> String showList :: [ParseError s e] -> ShowS | |
(NFData (Token s), NFData e) => NFData (ParseError s e) # | |
Defined in Text.Megaparsec.Error Methods rnf :: ParseError s e -> () | |
(Eq (Token s), Eq e) => Eq (ParseError s e) # | |
Defined in Text.Megaparsec.Error Methods (==) :: ParseError s e -> ParseError s e -> Bool (/=) :: ParseError s e -> ParseError s e -> Bool | |
type Rep (ParseError s e) # | |
Defined in Text.Megaparsec.Error type Rep (ParseError s e) = D1 ('MetaData "ParseError" "Text.Megaparsec.Error" "megaparsec-9.6.0-6cDk6wja3Qf4Glh1AI6lFI" 'False) (C1 ('MetaCons "TrivialError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Int) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ErrorItem (Token s)))) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Set (ErrorItem (Token s)))))) :+: C1 ('MetaCons "FancyError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Int) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Set (ErrorFancy e))))) |
mapParseError :: Ord e' => (e -> e') -> ParseError s e -> ParseError s e' #
Modify the custom data component in a parse error. This could be done
via fmap
if not for the Ord
constraint.
Since: 7.0.0
errorOffset :: ParseError s e -> Int #
Get the offset of a ParseError
.
Since: 7.0.0
setErrorOffset :: Int -> ParseError s e -> ParseError s e #
Set the offset of a ParseError
.
Since: 8.0.0
data ParseErrorBundle s e #
A non-empty collection of ParseError
s equipped with PosState
that
allows us to pretty-print the errors efficiently and correctly.
Since: 7.0.0
Constructors
ParseErrorBundle | |
Fields
|
Instances
(Data s, Data (Token s), Ord (Token s), Data e, Ord e) => Data (ParseErrorBundle s e) # | |
Defined in Text.Megaparsec.Error Methods gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> ParseErrorBundle s e -> c (ParseErrorBundle s e) gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (ParseErrorBundle s e) toConstr :: ParseErrorBundle s e -> Constr dataTypeOf :: ParseErrorBundle s e -> DataType dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (ParseErrorBundle s e)) dataCast2 :: Typeable t => (forall d e0. (Data d, Data e0) => c (t d e0)) -> Maybe (c (ParseErrorBundle s e)) gmapT :: (forall b. Data b => b -> b) -> ParseErrorBundle s e -> ParseErrorBundle s e gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> ParseErrorBundle s e -> r gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> ParseErrorBundle s e -> r gmapQ :: (forall d. Data d => d -> u) -> ParseErrorBundle s e -> [u] gmapQi :: Int -> (forall d. Data d => d -> u) -> ParseErrorBundle s e -> u gmapM :: Monad m => (forall d. Data d => d -> m d) -> ParseErrorBundle s e -> m (ParseErrorBundle s e) gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> ParseErrorBundle s e -> m (ParseErrorBundle s e) gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> ParseErrorBundle s e -> m (ParseErrorBundle s e) | |
(Show s, Show (Token s), Show e, ShowErrorComponent e, VisualStream s, TraversableStream s, Typeable s, Typeable e) => Exception (ParseErrorBundle s e) # | |
Defined in Text.Megaparsec.Error Methods toException :: ParseErrorBundle s e -> SomeException fromException :: SomeException -> Maybe (ParseErrorBundle s e) displayException :: ParseErrorBundle s e -> String | |
Generic (ParseErrorBundle s e) # | |
Defined in Text.Megaparsec.Error Associated Types type Rep (ParseErrorBundle s e) :: Type -> Type Methods from :: ParseErrorBundle s e -> Rep (ParseErrorBundle s e) x to :: Rep (ParseErrorBundle s e) x -> ParseErrorBundle s e | |
(Show s, Show (Token s), Show e) => Show (ParseErrorBundle s e) # | |
Defined in Text.Megaparsec.Error Methods showsPrec :: Int -> ParseErrorBundle s e -> ShowS show :: ParseErrorBundle s e -> String showList :: [ParseErrorBundle s e] -> ShowS | |
(NFData s, NFData (Token s), NFData e) => NFData (ParseErrorBundle s e) # | |
Defined in Text.Megaparsec.Error Methods rnf :: ParseErrorBundle s e -> () | |
(Eq s, Eq (Token s), Eq e) => Eq (ParseErrorBundle s e) # | |
Defined in Text.Megaparsec.Error Methods (==) :: ParseErrorBundle s e -> ParseErrorBundle s e -> Bool (/=) :: ParseErrorBundle s e -> ParseErrorBundle s e -> Bool | |
type Rep (ParseErrorBundle s e) # | |
Defined in Text.Megaparsec.Error type Rep (ParseErrorBundle s e) = D1 ('MetaData "ParseErrorBundle" "Text.Megaparsec.Error" "megaparsec-9.6.0-6cDk6wja3Qf4Glh1AI6lFI" 'False) (C1 ('MetaCons "ParseErrorBundle" 'PrefixI 'True) (S1 ('MetaSel ('Just "bundleErrors") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (NonEmpty (ParseError s e))) :*: S1 ('MetaSel ('Just "bundlePosState") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (PosState s)))) |
Arguments
:: (Traversable t, TraversableStream s) | |
=> (a -> Int) | How to project offset from an item (e.g. |
-> t a | The collection of items |
-> PosState s | Initial |
-> (t (a, SourcePos), PosState s) | The collection with |
Attach SourcePos
es to items in a Traversable
container given that
there is a projection allowing us to get an offset per item.
Items must be in ascending order with respect to their offsets.
Since: 7.0.0
Pretty-printing
class Ord a => ShowErrorComponent a where #
The type class defines how to print a custom component of ParseError
.
Since: 5.0.0
Minimal complete definition
Methods
showErrorComponent :: a -> String #
Pretty-print a component of ParseError
.
errorComponentLen :: a -> Int #
Length of the error component in characters, used for highlighting of parse errors in input string.
Since: 7.0.0
Instances
ShowErrorComponent Void # | |
Defined in Text.Megaparsec.Error |
Arguments
:: forall s e. (VisualStream s, TraversableStream s, ShowErrorComponent e) | |
=> ParseErrorBundle s e | Parse error bundle to display |
-> String | Textual rendition of the bundle |
Pretty-print a ParseErrorBundle
. All ParseError
s in the bundle will
be pretty-printed in order together with the corresponding offending
lines by doing a single pass over the input stream. The rendered String
always ends with a newline.
Since: 7.0.0
Arguments
:: (VisualStream s, ShowErrorComponent e) | |
=> ParseError s e | Parse error to render |
-> String | Result of rendering |
Pretty-print a ParseError
. The rendered String
always ends with a
newline.
Since: 5.0.0
Arguments
:: forall s e. (VisualStream s, ShowErrorComponent e) | |
=> ParseError s e | Parse error to render |
-> String | Result of rendering |
Pretty-print a textual part of a ParseError
, that is, everything
except for its position. The rendered String
always ends with a
newline.
Since: 5.1.0
showErrorItem :: VisualStream s => Proxy s -> ErrorItem (Token s) -> String #
Pretty-print an ErrorItem
.
Since: 9.4.0