{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}

-- |
-- Module      :  Text.Megaparsec.Error
-- Copyright   :  © 2015–present Megaparsec contributors
-- License     :  FreeBSD
--
-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- 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.
module Text.Megaparsec.Error
  ( -- * Parse error type
    ErrorItem (..),
    ErrorFancy (..),
    ParseError (..),
    mapParseError,
    errorOffset,
    setErrorOffset,
    ParseErrorBundle (..),
    attachSourcePos,

    -- * Pretty-printing
    ShowErrorComponent (..),
    errorBundlePretty,
    parseErrorPretty,
    parseErrorTextPretty,
    showErrorItem,
  )
where

import Control.DeepSeq
import Control.Exception
import Control.Monad.State.Strict
import Data.Data (Data)
import Data.List (intercalate)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import Data.Maybe (isNothing)
import Data.Proxy
import Data.Set (Set)
import qualified Data.Set as E
import Data.Typeable (Typeable)
import Data.Void
import GHC.Generics
import Text.Megaparsec.Pos
import Text.Megaparsec.State
import Text.Megaparsec.Stream

----------------------------------------------------------------------------
-- 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
data ErrorItem t
  = -- | Non-empty stream of tokens
    Tokens (NonEmpty t)
  | -- | Label (cannot be empty)
    Label (NonEmpty Char)
  | -- | End of input
    EndOfInput
  deriving (Int -> ErrorItem t -> ShowS
forall t. Show t => Int -> ErrorItem t -> ShowS
forall t. Show t => [ErrorItem t] -> ShowS
forall t. Show t => ErrorItem t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrorItem t] -> ShowS
$cshowList :: forall t. Show t => [ErrorItem t] -> ShowS
show :: ErrorItem t -> String
$cshow :: forall t. Show t => ErrorItem t -> String
showsPrec :: Int -> ErrorItem t -> ShowS
$cshowsPrec :: forall t. Show t => Int -> ErrorItem t -> ShowS
Show, ReadPrec [ErrorItem t]
ReadPrec (ErrorItem t)
ReadS [ErrorItem t]
forall t. Read t => ReadPrec [ErrorItem t]
forall t. Read t => ReadPrec (ErrorItem t)
forall t. Read t => Int -> ReadS (ErrorItem t)
forall t. Read t => ReadS [ErrorItem t]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ErrorItem t]
$creadListPrec :: forall t. Read t => ReadPrec [ErrorItem t]
readPrec :: ReadPrec (ErrorItem t)
$creadPrec :: forall t. Read t => ReadPrec (ErrorItem t)
readList :: ReadS [ErrorItem t]
$creadList :: forall t. Read t => ReadS [ErrorItem t]
readsPrec :: Int -> ReadS (ErrorItem t)
$creadsPrec :: forall t. Read t => Int -> ReadS (ErrorItem t)
Read, ErrorItem t -> ErrorItem t -> Bool
forall t. Eq t => ErrorItem t -> ErrorItem t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrorItem t -> ErrorItem t -> Bool
$c/= :: forall t. Eq t => ErrorItem t -> ErrorItem t -> Bool
== :: ErrorItem t -> ErrorItem t -> Bool
$c== :: forall t. Eq t => ErrorItem t -> ErrorItem t -> Bool
Eq, ErrorItem t -> ErrorItem t -> Bool
ErrorItem t -> ErrorItem t -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {t}. Ord t => Eq (ErrorItem t)
forall t. Ord t => ErrorItem t -> ErrorItem t -> Bool
forall t. Ord t => ErrorItem t -> ErrorItem t -> Ordering
forall t. Ord t => ErrorItem t -> ErrorItem t -> ErrorItem t
min :: ErrorItem t -> ErrorItem t -> ErrorItem t
$cmin :: forall t. Ord t => ErrorItem t -> ErrorItem t -> ErrorItem t
max :: ErrorItem t -> ErrorItem t -> ErrorItem t
$cmax :: forall t. Ord t => ErrorItem t -> ErrorItem t -> ErrorItem t
>= :: ErrorItem t -> ErrorItem t -> Bool
$c>= :: forall t. Ord t => ErrorItem t -> ErrorItem t -> Bool
> :: ErrorItem t -> ErrorItem t -> Bool
$c> :: forall t. Ord t => ErrorItem t -> ErrorItem t -> Bool
<= :: ErrorItem t -> ErrorItem t -> Bool
$c<= :: forall t. Ord t => ErrorItem t -> ErrorItem t -> Bool
< :: ErrorItem t -> ErrorItem t -> Bool
$c< :: forall t. Ord t => ErrorItem t -> ErrorItem t -> Bool
compare :: ErrorItem t -> ErrorItem t -> Ordering
$ccompare :: forall t. Ord t => ErrorItem t -> ErrorItem t -> Ordering
Ord, ErrorItem t -> DataType
ErrorItem t -> Constr
forall {t}. Data t => Typeable (ErrorItem t)
forall t. Data t => ErrorItem t -> DataType
forall t. Data t => ErrorItem t -> Constr
forall t.
Data t =>
(forall b. Data b => b -> b) -> ErrorItem t -> ErrorItem t
forall t u.
Data t =>
Int -> (forall d. Data d => d -> u) -> ErrorItem t -> u
forall t u.
Data t =>
(forall d. Data d => d -> u) -> ErrorItem t -> [u]
forall t r r'.
Data t =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ErrorItem t -> r
forall t r r'.
Data t =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ErrorItem t -> r
forall t (m :: * -> *).
(Data t, Monad m) =>
(forall d. Data d => d -> m d) -> ErrorItem t -> m (ErrorItem t)
forall t (m :: * -> *).
(Data t, MonadPlus m) =>
(forall d. Data d => d -> m d) -> ErrorItem t -> m (ErrorItem t)
forall t (c :: * -> *).
Data t =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ErrorItem t)
forall t (c :: * -> *).
Data t =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ErrorItem t -> c (ErrorItem t)
forall t (t :: * -> *) (c :: * -> *).
(Data t, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (ErrorItem t))
forall t (t :: * -> * -> *) (c :: * -> *).
(Data t, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ErrorItem t))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ErrorItem t)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ErrorItem t -> c (ErrorItem t)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (ErrorItem t))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ErrorItem t -> m (ErrorItem t)
$cgmapMo :: forall t (m :: * -> *).
(Data t, MonadPlus m) =>
(forall d. Data d => d -> m d) -> ErrorItem t -> m (ErrorItem t)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ErrorItem t -> m (ErrorItem t)
$cgmapMp :: forall t (m :: * -> *).
(Data t, MonadPlus m) =>
(forall d. Data d => d -> m d) -> ErrorItem t -> m (ErrorItem t)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ErrorItem t -> m (ErrorItem t)
$cgmapM :: forall t (m :: * -> *).
(Data t, Monad m) =>
(forall d. Data d => d -> m d) -> ErrorItem t -> m (ErrorItem t)
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ErrorItem t -> u
$cgmapQi :: forall t u.
Data t =>
Int -> (forall d. Data d => d -> u) -> ErrorItem t -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ErrorItem t -> [u]
$cgmapQ :: forall t u.
Data t =>
(forall d. Data d => d -> u) -> ErrorItem t -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ErrorItem t -> r
$cgmapQr :: forall t r r'.
Data t =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ErrorItem t -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ErrorItem t -> r
$cgmapQl :: forall t r r'.
Data t =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ErrorItem t -> r
gmapT :: (forall b. Data b => b -> b) -> ErrorItem t -> ErrorItem t
$cgmapT :: forall t.
Data t =>
(forall b. Data b => b -> b) -> ErrorItem t -> ErrorItem t
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ErrorItem t))
$cdataCast2 :: forall t (t :: * -> * -> *) (c :: * -> *).
(Data t, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ErrorItem t))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (ErrorItem t))
$cdataCast1 :: forall t (t :: * -> *) (c :: * -> *).
(Data t, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (ErrorItem t))
dataTypeOf :: ErrorItem t -> DataType
$cdataTypeOf :: forall t. Data t => ErrorItem t -> DataType
toConstr :: ErrorItem t -> Constr
$ctoConstr :: forall t. Data t => ErrorItem t -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ErrorItem t)
$cgunfold :: forall t (c :: * -> *).
Data t =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ErrorItem t)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ErrorItem t -> c (ErrorItem t)
$cgfoldl :: forall t (c :: * -> *).
Data t =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ErrorItem t -> c (ErrorItem t)
Data, Typeable, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall t x. Rep (ErrorItem t) x -> ErrorItem t
forall t x. ErrorItem t -> Rep (ErrorItem t) x
$cto :: forall t x. Rep (ErrorItem t) x -> ErrorItem t
$cfrom :: forall t x. ErrorItem t -> Rep (ErrorItem t) x
Generic, forall a b. a -> ErrorItem b -> ErrorItem a
forall a b. (a -> b) -> ErrorItem a -> ErrorItem b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> ErrorItem b -> ErrorItem a
$c<$ :: forall a b. a -> ErrorItem b -> ErrorItem a
fmap :: forall a b. (a -> b) -> ErrorItem a -> ErrorItem b
$cfmap :: forall a b. (a -> b) -> ErrorItem a -> ErrorItem b
Functor)

instance (NFData t) => NFData (ErrorItem t)

-- | 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
data ErrorFancy e
  = -- | 'fail' has been used in parser monad
    ErrorFail String
  | -- | Incorrect indentation error: desired ordering between reference
    -- level and actual level, reference indentation level, actual
    -- indentation level
    ErrorIndentation Ordering Pos Pos
  | -- | Custom error data
    ErrorCustom e
  deriving (Int -> ErrorFancy e -> ShowS
forall e. Show e => Int -> ErrorFancy e -> ShowS
forall e. Show e => [ErrorFancy e] -> ShowS
forall e. Show e => ErrorFancy e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrorFancy e] -> ShowS
$cshowList :: forall e. Show e => [ErrorFancy e] -> ShowS
show :: ErrorFancy e -> String
$cshow :: forall e. Show e => ErrorFancy e -> String
showsPrec :: Int -> ErrorFancy e -> ShowS
$cshowsPrec :: forall e. Show e => Int -> ErrorFancy e -> ShowS
Show, ReadPrec [ErrorFancy e]
ReadPrec (ErrorFancy e)
ReadS [ErrorFancy e]
forall e. Read e => ReadPrec [ErrorFancy e]
forall e. Read e => ReadPrec (ErrorFancy e)
forall e. Read e => Int -> ReadS (ErrorFancy e)
forall e. Read e => ReadS [ErrorFancy e]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ErrorFancy e]
$creadListPrec :: forall e. Read e => ReadPrec [ErrorFancy e]
readPrec :: ReadPrec (ErrorFancy e)
$creadPrec :: forall e. Read e => ReadPrec (ErrorFancy e)
readList :: ReadS [ErrorFancy e]
$creadList :: forall e. Read e => ReadS [ErrorFancy e]
readsPrec :: Int -> ReadS (ErrorFancy e)
$creadsPrec :: forall e. Read e => Int -> ReadS (ErrorFancy e)
Read, ErrorFancy e -> ErrorFancy e -> Bool
forall e. Eq e => ErrorFancy e -> ErrorFancy e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrorFancy e -> ErrorFancy e -> Bool
$c/= :: forall e. Eq e => ErrorFancy e -> ErrorFancy e -> Bool
== :: ErrorFancy e -> ErrorFancy e -> Bool
$c== :: forall e. Eq e => ErrorFancy e -> ErrorFancy e -> Bool
Eq, ErrorFancy e -> ErrorFancy e -> Bool
ErrorFancy e -> ErrorFancy e -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {e}. Ord e => Eq (ErrorFancy e)
forall e. Ord e => ErrorFancy e -> ErrorFancy e -> Bool
forall e. Ord e => ErrorFancy e -> ErrorFancy e -> Ordering
forall e. Ord e => ErrorFancy e -> ErrorFancy e -> ErrorFancy e
min :: ErrorFancy e -> ErrorFancy e -> ErrorFancy e
$cmin :: forall e. Ord e => ErrorFancy e -> ErrorFancy e -> ErrorFancy e
max :: ErrorFancy e -> ErrorFancy e -> ErrorFancy e
$cmax :: forall e. Ord e => ErrorFancy e -> ErrorFancy e -> ErrorFancy e
>= :: ErrorFancy e -> ErrorFancy e -> Bool
$c>= :: forall e. Ord e => ErrorFancy e -> ErrorFancy e -> Bool
> :: ErrorFancy e -> ErrorFancy e -> Bool
$c> :: forall e. Ord e => ErrorFancy e -> ErrorFancy e -> Bool
<= :: ErrorFancy e -> ErrorFancy e -> Bool
$c<= :: forall e. Ord e => ErrorFancy e -> ErrorFancy e -> Bool
< :: ErrorFancy e -> ErrorFancy e -> Bool
$c< :: forall e. Ord e => ErrorFancy e -> ErrorFancy e -> Bool
compare :: ErrorFancy e -> ErrorFancy e -> Ordering
$ccompare :: forall e. Ord e => ErrorFancy e -> ErrorFancy e -> Ordering
Ord, ErrorFancy e -> DataType
ErrorFancy e -> Constr
forall {e}. Data e => Typeable (ErrorFancy e)
forall e. Data e => ErrorFancy e -> DataType
forall e. Data e => ErrorFancy e -> Constr
forall e.
Data e =>
(forall b. Data b => b -> b) -> ErrorFancy e -> ErrorFancy e
forall e u.
Data e =>
Int -> (forall d. Data d => d -> u) -> ErrorFancy e -> u
forall e u.
Data e =>
(forall d. Data d => d -> u) -> ErrorFancy e -> [u]
forall e r r'.
Data e =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ErrorFancy e -> r
forall e r r'.
Data e =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ErrorFancy e -> r
forall e (m :: * -> *).
(Data e, Monad m) =>
(forall d. Data d => d -> m d) -> ErrorFancy e -> m (ErrorFancy e)
forall e (m :: * -> *).
(Data e, MonadPlus m) =>
(forall d. Data d => d -> m d) -> ErrorFancy e -> m (ErrorFancy e)
forall e (c :: * -> *).
Data e =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ErrorFancy e)
forall e (c :: * -> *).
Data e =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ErrorFancy e -> c (ErrorFancy e)
forall e (t :: * -> *) (c :: * -> *).
(Data e, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (ErrorFancy e))
forall e (t :: * -> * -> *) (c :: * -> *).
(Data e, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ErrorFancy e))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ErrorFancy e)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ErrorFancy e -> c (ErrorFancy e)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (ErrorFancy e))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ErrorFancy e -> m (ErrorFancy e)
$cgmapMo :: forall e (m :: * -> *).
(Data e, MonadPlus m) =>
(forall d. Data d => d -> m d) -> ErrorFancy e -> m (ErrorFancy e)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ErrorFancy e -> m (ErrorFancy e)
$cgmapMp :: forall e (m :: * -> *).
(Data e, MonadPlus m) =>
(forall d. Data d => d -> m d) -> ErrorFancy e -> m (ErrorFancy e)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ErrorFancy e -> m (ErrorFancy e)
$cgmapM :: forall e (m :: * -> *).
(Data e, Monad m) =>
(forall d. Data d => d -> m d) -> ErrorFancy e -> m (ErrorFancy e)
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ErrorFancy e -> u
$cgmapQi :: forall e u.
Data e =>
Int -> (forall d. Data d => d -> u) -> ErrorFancy e -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ErrorFancy e -> [u]
$cgmapQ :: forall e u.
Data e =>
(forall d. Data d => d -> u) -> ErrorFancy e -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ErrorFancy e -> r
$cgmapQr :: forall e r r'.
Data e =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ErrorFancy e -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ErrorFancy e -> r
$cgmapQl :: forall e r r'.
Data e =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ErrorFancy e -> r
gmapT :: (forall b. Data b => b -> b) -> ErrorFancy e -> ErrorFancy e
$cgmapT :: forall e.
Data e =>
(forall b. Data b => b -> b) -> ErrorFancy e -> ErrorFancy e
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ErrorFancy e))
$cdataCast2 :: forall e (t :: * -> * -> *) (c :: * -> *).
(Data e, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ErrorFancy e))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (ErrorFancy e))
$cdataCast1 :: forall e (t :: * -> *) (c :: * -> *).
(Data e, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (ErrorFancy e))
dataTypeOf :: ErrorFancy e -> DataType
$cdataTypeOf :: forall e. Data e => ErrorFancy e -> DataType
toConstr :: ErrorFancy e -> Constr
$ctoConstr :: forall e. Data e => ErrorFancy e -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ErrorFancy e)
$cgunfold :: forall e (c :: * -> *).
Data e =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ErrorFancy e)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ErrorFancy e -> c (ErrorFancy e)
$cgfoldl :: forall e (c :: * -> *).
Data e =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ErrorFancy e -> c (ErrorFancy e)
Data, Typeable, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall e x. Rep (ErrorFancy e) x -> ErrorFancy e
forall e x. ErrorFancy e -> Rep (ErrorFancy e) x
$cto :: forall e x. Rep (ErrorFancy e) x -> ErrorFancy e
$cfrom :: forall e x. ErrorFancy e -> Rep (ErrorFancy e) x
Generic, forall a b. a -> ErrorFancy b -> ErrorFancy a
forall a b. (a -> b) -> ErrorFancy a -> ErrorFancy b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> ErrorFancy b -> ErrorFancy a
$c<$ :: forall a b. a -> ErrorFancy b -> ErrorFancy a
fmap :: forall a b. (a -> b) -> ErrorFancy a -> ErrorFancy b
$cfmap :: forall a b. (a -> b) -> ErrorFancy a -> ErrorFancy b
Functor)

instance (NFData a) => NFData (ErrorFancy a) where
  rnf :: ErrorFancy a -> ()
rnf (ErrorFail String
str) = forall a. NFData a => a -> ()
rnf String
str
  rnf (ErrorIndentation Ordering
ord Pos
ref Pos
act) = Ordering
ord seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Pos
ref seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Pos
act
  rnf (ErrorCustom a
a) = forall a. NFData a => a -> ()
rnf a
a

-- | @'ParseError' s e@ represents a parse error parametrized over the
-- stream type @s@ 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
data ParseError s e
  = -- | 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/.
    TrivialError Int (Maybe (ErrorItem (Token s))) (Set (ErrorItem (Token s)))
  | -- | Fancy, custom errors.
    --
    -- Type of the first argument was changed in the version /7.0.0/.
    FancyError Int (Set (ErrorFancy e))
  deriving (Typeable, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall s e x. Rep (ParseError s e) x -> ParseError s e
forall s e x. ParseError s e -> Rep (ParseError s e) x
$cto :: forall s e x. Rep (ParseError s e) x -> ParseError s e
$cfrom :: forall s e x. ParseError s e -> Rep (ParseError s e) x
Generic)

deriving instance
  ( Show (Token s),
    Show e
  ) =>
  Show (ParseError s e)

deriving instance
  ( Eq (Token s),
    Eq e
  ) =>
  Eq (ParseError s e)

deriving instance
  ( Data s,
    Data (Token s),
    Ord (Token s),
    Data e,
    Ord e
  ) =>
  Data (ParseError s e)

instance
  ( NFData (Token s),
    NFData e
  ) =>
  NFData (ParseError s e)

instance (Stream s, Ord e) => Semigroup (ParseError s e) where
  <> :: ParseError s e -> ParseError s e -> ParseError s e
(<>) = forall s e.
(Stream s, Ord e) =>
ParseError s e -> ParseError s e -> ParseError s e
mergeError
  {-# INLINE (<>) #-}

instance (Stream s, Ord e) => Monoid (ParseError s e) where
  mempty :: ParseError s e
mempty = forall s e.
Int
-> Maybe (ErrorItem (Token s))
-> Set (ErrorItem (Token s))
-> ParseError s e
TrivialError Int
0 forall a. Maybe a
Nothing forall a. Set a
E.empty
  mappend :: ParseError s e -> ParseError s e -> ParseError s e
mappend = forall a. Semigroup a => a -> a -> a
(<>)
  {-# INLINE mappend #-}

instance
  ( Show s,
    Show (Token s),
    Show e,
    ShowErrorComponent e,
    VisualStream s,
    Typeable s,
    Typeable e
  ) =>
  Exception (ParseError s e)
  where
  displayException :: ParseError s e -> String
displayException = forall s e.
(VisualStream s, ShowErrorComponent e) =>
ParseError s e -> String
parseErrorPretty

-- | 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
mapParseError ::
  (Ord e') =>
  (e -> e') ->
  ParseError s e ->
  ParseError s e'
mapParseError :: forall e' e s.
Ord e' =>
(e -> e') -> ParseError s e -> ParseError s e'
mapParseError e -> e'
_ (TrivialError Int
o Maybe (ErrorItem (Token s))
u Set (ErrorItem (Token s))
p) = forall s e.
Int
-> Maybe (ErrorItem (Token s))
-> Set (ErrorItem (Token s))
-> ParseError s e
TrivialError Int
o Maybe (ErrorItem (Token s))
u Set (ErrorItem (Token s))
p
mapParseError e -> e'
f (FancyError Int
o Set (ErrorFancy e)
x) = forall s e. Int -> Set (ErrorFancy e) -> ParseError s e
FancyError Int
o (forall b a. Ord b => (a -> b) -> Set a -> Set b
E.map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> e'
f) Set (ErrorFancy e)
x)

-- | Get the offset of a 'ParseError'.
--
-- @since 7.0.0
errorOffset :: ParseError s e -> Int
errorOffset :: forall s e. ParseError s e -> Int
errorOffset (TrivialError Int
o Maybe (ErrorItem (Token s))
_ Set (ErrorItem (Token s))
_) = Int
o
errorOffset (FancyError Int
o Set (ErrorFancy e)
_) = Int
o

-- | Set the offset of a 'ParseError'.
--
-- @since 8.0.0
setErrorOffset :: Int -> ParseError s e -> ParseError s e
setErrorOffset :: forall s e. Int -> ParseError s e -> ParseError s e
setErrorOffset Int
o (TrivialError Int
_ Maybe (ErrorItem (Token s))
u Set (ErrorItem (Token s))
p) = forall s e.
Int
-> Maybe (ErrorItem (Token s))
-> Set (ErrorItem (Token s))
-> ParseError s e
TrivialError Int
o Maybe (ErrorItem (Token s))
u Set (ErrorItem (Token s))
p
setErrorOffset Int
o (FancyError Int
_ Set (ErrorFancy e)
x) = forall s e. Int -> Set (ErrorFancy e) -> ParseError s e
FancyError Int
o Set (ErrorFancy e)
x

-- | Merge two error data structures into one joining their collections of
-- message items and preferring the longest match. In other words, earlier
-- error message is discarded. This may seem counter-intuitive, but
-- 'mergeError' is only used to merge error messages of alternative branches
-- of parsing and in this case longest match should be preferred.
mergeError ::
  (Stream s, Ord e) =>
  ParseError s e ->
  ParseError s e ->
  ParseError s e
mergeError :: forall s e.
(Stream s, Ord e) =>
ParseError s e -> ParseError s e -> ParseError s e
mergeError ParseError s e
e1 ParseError s e
e2 =
  case forall s e. ParseError s e -> Int
errorOffset ParseError s e
e1 forall a. Ord a => a -> a -> Ordering
`compare` forall s e. ParseError s e -> Int
errorOffset ParseError s e
e2 of
    Ordering
LT -> ParseError s e
e2
    Ordering
EQ ->
      case (ParseError s e
e1, ParseError s e
e2) of
        (TrivialError Int
s1 Maybe (ErrorItem (Token s))
u1 Set (ErrorItem (Token s))
p1, TrivialError Int
_ Maybe (ErrorItem (Token s))
u2 Set (ErrorItem (Token s))
p2) ->
          forall s e.
Int
-> Maybe (ErrorItem (Token s))
-> Set (ErrorItem (Token s))
-> ParseError s e
TrivialError Int
s1 (forall {a}. Ord a => Maybe a -> Maybe a -> Maybe a
n Maybe (ErrorItem (Token s))
u1 Maybe (ErrorItem (Token s))
u2) (forall a. Ord a => Set a -> Set a -> Set a
E.union Set (ErrorItem (Token s))
p1 Set (ErrorItem (Token s))
p2)
        (FancyError {}, TrivialError {}) -> ParseError s e
e1
        (TrivialError {}, FancyError {}) -> ParseError s e
e2
        (FancyError Int
s1 Set (ErrorFancy e)
x1, FancyError Int
_ Set (ErrorFancy e)
x2) ->
          forall s e. Int -> Set (ErrorFancy e) -> ParseError s e
FancyError Int
s1 (forall a. Ord a => Set a -> Set a -> Set a
E.union Set (ErrorFancy e)
x1 Set (ErrorFancy e)
x2)
    Ordering
GT -> ParseError s e
e1
  where
    -- NOTE The logic behind this merging is that since we only combine
    -- parse errors that happen at exactly the same position, all the
    -- unexpected items will be prefixes of input stream at that position or
    -- labels referring to the same thing. Our aim here is to choose the
    -- longest prefix (merging with labels and end of input is somewhat
    -- arbitrary, but is necessary because otherwise we can't make
    -- ParseError lawful Monoid and have nice parse errors at the same
    -- time).
    n :: Maybe a -> Maybe a -> Maybe a
n Maybe a
Nothing Maybe a
Nothing = forall a. Maybe a
Nothing
    n (Just a
x) Maybe a
Nothing = forall a. a -> Maybe a
Just a
x
    n Maybe a
Nothing (Just a
y) = forall a. a -> Maybe a
Just a
y
    n (Just a
x) (Just a
y) = forall a. a -> Maybe a
Just (forall a. Ord a => a -> a -> a
max a
x a
y)
{-# INLINE mergeError #-}

-- | 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
data ParseErrorBundle s e = ParseErrorBundle
  { -- | A collection of 'ParseError's that is sorted by parse error offsets
    forall s e. ParseErrorBundle s e -> NonEmpty (ParseError s e)
bundleErrors :: NonEmpty (ParseError s e),
    -- | The state that is used for line\/column calculation
    forall s e. ParseErrorBundle s e -> PosState s
bundlePosState :: PosState s
  }
  deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall s e x. Rep (ParseErrorBundle s e) x -> ParseErrorBundle s e
forall s e x. ParseErrorBundle s e -> Rep (ParseErrorBundle s e) x
$cto :: forall s e x. Rep (ParseErrorBundle s e) x -> ParseErrorBundle s e
$cfrom :: forall s e x. ParseErrorBundle s e -> Rep (ParseErrorBundle s e) x
Generic)

deriving instance
  ( Show s,
    Show (Token s),
    Show e
  ) =>
  Show (ParseErrorBundle s e)

deriving instance
  ( Eq s,
    Eq (Token s),
    Eq e
  ) =>
  Eq (ParseErrorBundle s e)

deriving instance
  ( Typeable s,
    Typeable (Token s),
    Typeable e
  ) =>
  Typeable (ParseErrorBundle s e)

deriving instance
  ( Data s,
    Data (Token s),
    Ord (Token s),
    Data e,
    Ord e
  ) =>
  Data (ParseErrorBundle s e)

instance
  ( NFData s,
    NFData (Token s),
    NFData e
  ) =>
  NFData (ParseErrorBundle s e)

instance
  ( Show s,
    Show (Token s),
    Show e,
    ShowErrorComponent e,
    VisualStream s,
    TraversableStream s,
    Typeable s,
    Typeable e
  ) =>
  Exception (ParseErrorBundle s e)
  where
  displayException :: ParseErrorBundle s e -> String
displayException = forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty

-- | 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
attachSourcePos ::
  (Traversable t, TraversableStream s) =>
  -- | How to project offset from an item (e.g. 'errorOffset')
  (a -> Int) ->
  -- | The collection of items
  t a ->
  -- | Initial 'PosState'
  PosState s ->
  -- | The collection with 'SourcePos'es added and the final 'PosState'
  (t (a, SourcePos), PosState s)
attachSourcePos :: forall (t :: * -> *) s a.
(Traversable t, TraversableStream s) =>
(a -> Int) -> t a -> PosState s -> (t (a, SourcePos), PosState s)
attachSourcePos a -> Int
projectOffset t a
xs = forall s a. State s a -> s -> (a, s)
runState (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall {m :: * -> *} {s}.
(MonadState (PosState s) m, TraversableStream s) =>
a -> m (a, SourcePos)
f t a
xs)
  where
    f :: a -> m (a, SourcePos)
f a
a = do
      PosState s
pst <- forall s (m :: * -> *). MonadState s m => m s
get
      let pst' :: PosState s
pst' = forall s. TraversableStream s => Int -> PosState s -> PosState s
reachOffsetNoLine (a -> Int
projectOffset a
a) PosState s
pst
      forall s (m :: * -> *). MonadState s m => s -> m ()
put PosState s
pst'
      forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, forall s. PosState s -> SourcePos
pstateSourcePos PosState s
pst')
{-# INLINEABLE attachSourcePos #-}

----------------------------------------------------------------------------
-- Pretty-printing

-- | The type class defines how to print a custom component of 'ParseError'.
--
-- @since 5.0.0
class (Ord a) => ShowErrorComponent a where
  -- | Pretty-print a component of 'ParseError'.
  showErrorComponent :: a -> String

  -- | Length of the error component in characters, used for highlighting of
  -- parse errors in input string.
  --
  -- @since 7.0.0
  errorComponentLen :: a -> Int
  errorComponentLen a
_ = Int
1

instance ShowErrorComponent Void where
  showErrorComponent :: Void -> String
showErrorComponent = forall a. Void -> a
absurd

-- | 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
errorBundlePretty ::
  forall s e.
  ( VisualStream s,
    TraversableStream s,
    ShowErrorComponent e
  ) =>
  -- | Parse error bundle to display
  ParseErrorBundle s e ->
  -- | Textual rendition of the bundle
  String
errorBundlePretty :: forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty ParseErrorBundle {NonEmpty (ParseError s e)
PosState s
bundlePosState :: PosState s
bundleErrors :: NonEmpty (ParseError s e)
bundlePosState :: forall s e. ParseErrorBundle s e -> PosState s
bundleErrors :: forall s e. ParseErrorBundle s e -> NonEmpty (ParseError s e)
..} =
  let (ShowS
r, PosState s
_) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (ShowS, PosState s) -> ParseError s e -> (ShowS, PosState s)
f (forall a. a -> a
id, PosState s
bundlePosState) NonEmpty (ParseError s e)
bundleErrors
   in forall a. Int -> [a] -> [a]
drop Int
1 (ShowS
r String
"")
  where
    f ::
      (ShowS, PosState s) ->
      ParseError s e ->
      (ShowS, PosState s)
    f :: (ShowS, PosState s) -> ParseError s e -> (ShowS, PosState s)
f (ShowS
o, !PosState s
pst) ParseError s e
e = (ShowS
o forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
outChunk forall a. [a] -> [a] -> [a]
++), PosState s
pst')
      where
        (Maybe String
msline, PosState s
pst') = forall s.
TraversableStream s =>
Int -> PosState s -> (Maybe String, PosState s)
reachOffset (forall s e. ParseError s e -> Int
errorOffset ParseError s e
e) PosState s
pst
        epos :: SourcePos
epos = forall s. PosState s -> SourcePos
pstateSourcePos PosState s
pst'
        outChunk :: String
outChunk =
          String
"\n"
            forall a. Semigroup a => a -> a -> a
<> SourcePos -> String
sourcePosPretty SourcePos
epos
            forall a. Semigroup a => a -> a -> a
<> String
":\n"
            forall a. Semigroup a => a -> a -> a
<> String
offendingLine
            forall a. Semigroup a => a -> a -> a
<> forall s e.
(VisualStream s, ShowErrorComponent e) =>
ParseError s e -> String
parseErrorTextPretty ParseError s e
e
        offendingLine :: String
offendingLine =
          case Maybe String
msline of
            Maybe String
Nothing -> String
""
            Just String
sline ->
              let rpadding :: String
rpadding =
                    if Int
pointerLen forall a. Ord a => a -> a -> Bool
> Int
0
                      then forall a. Int -> a -> [a]
replicate Int
rpshift Char
' '
                      else String
""
                  pointerLen :: Int
pointerLen =
                    if Int
rpshift forall a. Num a => a -> a -> a
+ Int
elen forall a. Ord a => a -> a -> Bool
> Int
slineLen
                      then Int
slineLen forall a. Num a => a -> a -> a
- Int
rpshift forall a. Num a => a -> a -> a
+ Int
1
                      else Int
elen
                  pointer :: String
pointer = forall a. Int -> a -> [a]
replicate Int
pointerLen Char
'^'
                  lineNumber :: String
lineNumber = (forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pos -> Int
unPos forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcePos -> Pos
sourceLine) SourcePos
epos
                  padding :: String
padding = forall a. Int -> a -> [a]
replicate (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
lineNumber forall a. Num a => a -> a -> a
+ Int
1) Char
' '
                  rpshift :: Int
rpshift = Pos -> Int
unPos (SourcePos -> Pos
sourceColumn SourcePos
epos) forall a. Num a => a -> a -> a
- Int
1
                  slineLen :: Int
slineLen = forall (t :: * -> *) a. Foldable t => t a -> Int
length String
sline
               in String
padding
                    forall a. Semigroup a => a -> a -> a
<> String
"|\n"
                    forall a. Semigroup a => a -> a -> a
<> String
lineNumber
                    forall a. Semigroup a => a -> a -> a
<> String
" | "
                    forall a. Semigroup a => a -> a -> a
<> String
sline
                    forall a. Semigroup a => a -> a -> a
<> String
"\n"
                    forall a. Semigroup a => a -> a -> a
<> String
padding
                    forall a. Semigroup a => a -> a -> a
<> String
"| "
                    forall a. Semigroup a => a -> a -> a
<> String
rpadding
                    forall a. Semigroup a => a -> a -> a
<> String
pointer
                    forall a. Semigroup a => a -> a -> a
<> String
"\n"
        pxy :: Proxy s
pxy = forall {k} (t :: k). Proxy t
Proxy :: Proxy s
        elen :: Int
elen =
          case ParseError s e
e of
            TrivialError Int
_ Maybe (ErrorItem (Token s))
Nothing Set (ErrorItem (Token s))
_ -> Int
1
            TrivialError Int
_ (Just ErrorItem (Token s)
x) Set (ErrorItem (Token s))
_ -> forall s. VisualStream s => Proxy s -> ErrorItem (Token s) -> Int
errorItemLength Proxy s
pxy ErrorItem (Token s)
x
            FancyError Int
_ Set (ErrorFancy e)
xs ->
              forall a b. (a -> b -> a) -> a -> Set b -> a
E.foldl' (\Int
a ErrorFancy e
b -> forall a. Ord a => a -> a -> a
max Int
a (forall e. ShowErrorComponent e => ErrorFancy e -> Int
errorFancyLength ErrorFancy e
b)) Int
1 Set (ErrorFancy e)
xs

-- | Pretty-print a 'ParseError'. The rendered 'String' always ends with a
-- newline.
--
-- @since 5.0.0
parseErrorPretty ::
  (VisualStream s, ShowErrorComponent e) =>
  -- | Parse error to render
  ParseError s e ->
  -- | Result of rendering
  String
parseErrorPretty :: forall s e.
(VisualStream s, ShowErrorComponent e) =>
ParseError s e -> String
parseErrorPretty ParseError s e
e =
  String
"offset=" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (forall s e. ParseError s e -> Int
errorOffset ParseError s e
e) forall a. Semigroup a => a -> a -> a
<> String
":\n" forall a. Semigroup a => a -> a -> a
<> forall s e.
(VisualStream s, ShowErrorComponent e) =>
ParseError s e -> String
parseErrorTextPretty ParseError s e
e

-- | 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
parseErrorTextPretty ::
  forall s e.
  (VisualStream s, ShowErrorComponent e) =>
  -- | Parse error to render
  ParseError s e ->
  -- | Result of rendering
  String
parseErrorTextPretty :: forall s e.
(VisualStream s, ShowErrorComponent e) =>
ParseError s e -> String
parseErrorTextPretty (TrivialError Int
_ Maybe (ErrorItem (Token s))
us Set (ErrorItem (Token s))
ps) =
  if forall a. Maybe a -> Bool
isNothing Maybe (ErrorItem (Token s))
us Bool -> Bool -> Bool
&& forall a. Set a -> Bool
E.null Set (ErrorItem (Token s))
ps
    then String
"unknown parse error\n"
    else
      String -> Set String -> String
messageItemsPretty String
"unexpected " (forall s.
VisualStream s =>
Proxy s -> ErrorItem (Token s) -> String
showErrorItem Proxy s
pxy forall b a. Ord b => (a -> b) -> Set a -> Set b
`E.map` forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Set a
E.empty forall a. a -> Set a
E.singleton Maybe (ErrorItem (Token s))
us)
        forall a. Semigroup a => a -> a -> a
<> String -> Set String -> String
messageItemsPretty String
"expecting " (forall s.
VisualStream s =>
Proxy s -> ErrorItem (Token s) -> String
showErrorItem Proxy s
pxy forall b a. Ord b => (a -> b) -> Set a -> Set b
`E.map` Set (ErrorItem (Token s))
ps)
  where
    pxy :: Proxy s
pxy = forall {k} (t :: k). Proxy t
Proxy :: Proxy s
parseErrorTextPretty (FancyError Int
_ Set (ErrorFancy e)
xs) =
  if forall a. Set a -> Bool
E.null Set (ErrorFancy e)
xs
    then String
"unknown fancy parse error\n"
    else [String] -> String
unlines (forall e. ShowErrorComponent e => ErrorFancy e -> String
showErrorFancy forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Set a -> [a]
E.toAscList Set (ErrorFancy e)
xs)

----------------------------------------------------------------------------
-- Helpers

-- | Pretty-print an 'ErrorItem'.
--
-- @since 9.4.0
showErrorItem :: (VisualStream s) => Proxy s -> ErrorItem (Token s) -> String
showErrorItem :: forall s.
VisualStream s =>
Proxy s -> ErrorItem (Token s) -> String
showErrorItem Proxy s
pxy = \case
  Tokens NonEmpty (Token s)
ts -> forall s. VisualStream s => Proxy s -> NonEmpty (Token s) -> String
showTokens Proxy s
pxy NonEmpty (Token s)
ts
  Label NonEmpty Char
label -> forall a. NonEmpty a -> [a]
NE.toList NonEmpty Char
label
  ErrorItem (Token s)
EndOfInput -> String
"end of input"

-- | Get length of the “pointer” to display under a given 'ErrorItem'.
errorItemLength :: (VisualStream s) => Proxy s -> ErrorItem (Token s) -> Int
errorItemLength :: forall s. VisualStream s => Proxy s -> ErrorItem (Token s) -> Int
errorItemLength Proxy s
pxy = \case
  Tokens NonEmpty (Token s)
ts -> forall s. VisualStream s => Proxy s -> NonEmpty (Token s) -> Int
tokensLength Proxy s
pxy NonEmpty (Token s)
ts
  ErrorItem (Token s)
_ -> Int
1

-- | Pretty-print an 'ErrorFancy'.
showErrorFancy :: (ShowErrorComponent e) => ErrorFancy e -> String
showErrorFancy :: forall e. ShowErrorComponent e => ErrorFancy e -> String
showErrorFancy = \case
  ErrorFail String
msg -> String
msg
  ErrorIndentation Ordering
ord Pos
ref Pos
actual ->
    String
"incorrect indentation (got "
      forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Pos -> Int
unPos Pos
actual)
      forall a. Semigroup a => a -> a -> a
<> String
", should be "
      forall a. Semigroup a => a -> a -> a
<> String
p
      forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Pos -> Int
unPos Pos
ref)
      forall a. Semigroup a => a -> a -> a
<> String
")"
    where
      p :: String
p = case Ordering
ord of
        Ordering
LT -> String
"less than "
        Ordering
EQ -> String
"equal to "
        Ordering
GT -> String
"greater than "
  ErrorCustom e
a -> forall a. ShowErrorComponent a => a -> String
showErrorComponent e
a

-- | Get length of the “pointer” to display under a given 'ErrorFancy'.
errorFancyLength :: (ShowErrorComponent e) => ErrorFancy e -> Int
errorFancyLength :: forall e. ShowErrorComponent e => ErrorFancy e -> Int
errorFancyLength = \case
  ErrorCustom e
a -> forall a. ShowErrorComponent a => a -> Int
errorComponentLen e
a
  ErrorFancy e
_ -> Int
1

-- | Transform a list of error messages into their textual representation.
messageItemsPretty ::
  -- | Prefix to prepend
  String ->
  -- | Collection of messages
  Set String ->
  -- | Result of rendering
  String
messageItemsPretty :: String -> Set String -> String
messageItemsPretty String
prefix Set String
ts
  | forall a. Set a -> Bool
E.null Set String
ts = String
""
  | Bool
otherwise =
      String
prefix forall a. Semigroup a => a -> a -> a
<> (NonEmpty String -> String
orList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> NonEmpty a
NE.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
E.toAscList) Set String
ts forall a. Semigroup a => a -> a -> a
<> String
"\n"

-- | Print a pretty list where items are separated with commas and the word
-- “or” according to the rules of English punctuation.
orList :: NonEmpty String -> String
orList :: NonEmpty String -> String
orList (String
x :| []) = String
x
orList (String
x :| [String
y]) = String
x forall a. Semigroup a => a -> a -> a
<> String
" or " forall a. Semigroup a => a -> a -> a
<> String
y
orList NonEmpty String
xs = forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a. NonEmpty a -> [a]
NE.init NonEmpty String
xs) forall a. Semigroup a => a -> a -> a
<> String
", or " forall a. Semigroup a => a -> a -> a
<> forall a. NonEmpty a -> a
NE.last NonEmpty String
xs