-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

-- |  Custom exceptions that can happen during parsing.

module Morley.Michelson.Parser.Error
  ( CustomParserException (..)
  , StringLiteralParserException (..)
  , ParseErrorBundle
  , ParserException (..)
  ) where

import Data.Data (Data(..))
import Fmt (Buildable(build), pretty)
import Text.Megaparsec (ParseErrorBundle, ShowErrorComponent(..), errorBundlePretty)

import Morley.Michelson.Untyped.View
import Morley.Util.Instances ()

data CustomParserException
  = StringLiteralException StringLiteralParserException
  | ViewNameException BadViewNameError
  | OddNumberBytesException
  | ExcessFieldAnnotation
  deriving stock (CustomParserException -> CustomParserException -> Bool
(CustomParserException -> CustomParserException -> Bool)
-> (CustomParserException -> CustomParserException -> Bool)
-> Eq CustomParserException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CustomParserException -> CustomParserException -> Bool
$c/= :: CustomParserException -> CustomParserException -> Bool
== :: CustomParserException -> CustomParserException -> Bool
$c== :: CustomParserException -> CustomParserException -> Bool
Eq, Typeable CustomParserException
Typeable CustomParserException
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> CustomParserException
    -> c CustomParserException)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CustomParserException)
-> (CustomParserException -> Constr)
-> (CustomParserException -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CustomParserException))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CustomParserException))
-> ((forall b. Data b => b -> b)
    -> CustomParserException -> CustomParserException)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CustomParserException
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CustomParserException
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> CustomParserException -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> CustomParserException -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CustomParserException -> m CustomParserException)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CustomParserException -> m CustomParserException)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CustomParserException -> m CustomParserException)
-> Data CustomParserException
CustomParserException -> DataType
CustomParserException -> Constr
(forall b. Data b => b -> b)
-> CustomParserException -> CustomParserException
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 u.
Int -> (forall d. Data d => d -> u) -> CustomParserException -> u
forall u.
(forall d. Data d => d -> u) -> CustomParserException -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CustomParserException -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CustomParserException -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CustomParserException -> m CustomParserException
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CustomParserException -> m CustomParserException
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CustomParserException
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CustomParserException
-> c CustomParserException
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CustomParserException)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CustomParserException)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CustomParserException -> m CustomParserException
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CustomParserException -> m CustomParserException
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CustomParserException -> m CustomParserException
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CustomParserException -> m CustomParserException
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CustomParserException -> m CustomParserException
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CustomParserException -> m CustomParserException
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CustomParserException -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CustomParserException -> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> CustomParserException -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> CustomParserException -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CustomParserException -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CustomParserException -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CustomParserException -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CustomParserException -> r
gmapT :: (forall b. Data b => b -> b)
-> CustomParserException -> CustomParserException
$cgmapT :: (forall b. Data b => b -> b)
-> CustomParserException -> CustomParserException
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CustomParserException)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CustomParserException)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CustomParserException)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CustomParserException)
dataTypeOf :: CustomParserException -> DataType
$cdataTypeOf :: CustomParserException -> DataType
toConstr :: CustomParserException -> Constr
$ctoConstr :: CustomParserException -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CustomParserException
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CustomParserException
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CustomParserException
-> c CustomParserException
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CustomParserException
-> c CustomParserException
Data, Eq CustomParserException
Eq CustomParserException
-> (CustomParserException -> CustomParserException -> Ordering)
-> (CustomParserException -> CustomParserException -> Bool)
-> (CustomParserException -> CustomParserException -> Bool)
-> (CustomParserException -> CustomParserException -> Bool)
-> (CustomParserException -> CustomParserException -> Bool)
-> (CustomParserException
    -> CustomParserException -> CustomParserException)
-> (CustomParserException
    -> CustomParserException -> CustomParserException)
-> Ord CustomParserException
CustomParserException -> CustomParserException -> Bool
CustomParserException -> CustomParserException -> Ordering
CustomParserException
-> CustomParserException -> CustomParserException
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
min :: CustomParserException
-> CustomParserException -> CustomParserException
$cmin :: CustomParserException
-> CustomParserException -> CustomParserException
max :: CustomParserException
-> CustomParserException -> CustomParserException
$cmax :: CustomParserException
-> CustomParserException -> CustomParserException
>= :: CustomParserException -> CustomParserException -> Bool
$c>= :: CustomParserException -> CustomParserException -> Bool
> :: CustomParserException -> CustomParserException -> Bool
$c> :: CustomParserException -> CustomParserException -> Bool
<= :: CustomParserException -> CustomParserException -> Bool
$c<= :: CustomParserException -> CustomParserException -> Bool
< :: CustomParserException -> CustomParserException -> Bool
$c< :: CustomParserException -> CustomParserException -> Bool
compare :: CustomParserException -> CustomParserException -> Ordering
$ccompare :: CustomParserException -> CustomParserException -> Ordering
Ord, Int -> CustomParserException -> ShowS
[CustomParserException] -> ShowS
CustomParserException -> String
(Int -> CustomParserException -> ShowS)
-> (CustomParserException -> String)
-> ([CustomParserException] -> ShowS)
-> Show CustomParserException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CustomParserException] -> ShowS
$cshowList :: [CustomParserException] -> ShowS
show :: CustomParserException -> String
$cshow :: CustomParserException -> String
showsPrec :: Int -> CustomParserException -> ShowS
$cshowsPrec :: Int -> CustomParserException -> ShowS
Show, (forall x. CustomParserException -> Rep CustomParserException x)
-> (forall x. Rep CustomParserException x -> CustomParserException)
-> Generic CustomParserException
forall x. Rep CustomParserException x -> CustomParserException
forall x. CustomParserException -> Rep CustomParserException x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CustomParserException x -> CustomParserException
$cfrom :: forall x. CustomParserException -> Rep CustomParserException x
Generic)

instance NFData CustomParserException

instance ShowErrorComponent CustomParserException where
  showErrorComponent :: CustomParserException -> String
showErrorComponent (StringLiteralException StringLiteralParserException
e) = StringLiteralParserException -> String
forall a. ShowErrorComponent a => a -> String
showErrorComponent StringLiteralParserException
e
  showErrorComponent (ViewNameException BadViewNameError
e) = BadViewNameError -> String
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty BadViewNameError
e
  showErrorComponent CustomParserException
OddNumberBytesException = String
"odd number bytes"
  showErrorComponent CustomParserException
ExcessFieldAnnotation = String
"excess field annotation"

data StringLiteralParserException
  = InvalidEscapeSequence Char
  | InvalidChar Char
  deriving stock (StringLiteralParserException
-> StringLiteralParserException -> Bool
(StringLiteralParserException
 -> StringLiteralParserException -> Bool)
-> (StringLiteralParserException
    -> StringLiteralParserException -> Bool)
-> Eq StringLiteralParserException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StringLiteralParserException
-> StringLiteralParserException -> Bool
$c/= :: StringLiteralParserException
-> StringLiteralParserException -> Bool
== :: StringLiteralParserException
-> StringLiteralParserException -> Bool
$c== :: StringLiteralParserException
-> StringLiteralParserException -> Bool
Eq, Typeable StringLiteralParserException
Typeable StringLiteralParserException
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> StringLiteralParserException
    -> c StringLiteralParserException)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c StringLiteralParserException)
-> (StringLiteralParserException -> Constr)
-> (StringLiteralParserException -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c StringLiteralParserException))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c StringLiteralParserException))
-> ((forall b. Data b => b -> b)
    -> StringLiteralParserException -> StringLiteralParserException)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> StringLiteralParserException
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> StringLiteralParserException
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> StringLiteralParserException -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> StringLiteralParserException
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> StringLiteralParserException -> m StringLiteralParserException)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> StringLiteralParserException -> m StringLiteralParserException)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> StringLiteralParserException -> m StringLiteralParserException)
-> Data StringLiteralParserException
StringLiteralParserException -> DataType
StringLiteralParserException -> Constr
(forall b. Data b => b -> b)
-> StringLiteralParserException -> StringLiteralParserException
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 u.
Int
-> (forall d. Data d => d -> u)
-> StringLiteralParserException
-> u
forall u.
(forall d. Data d => d -> u) -> StringLiteralParserException -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> StringLiteralParserException
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> StringLiteralParserException
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> StringLiteralParserException -> m StringLiteralParserException
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> StringLiteralParserException -> m StringLiteralParserException
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StringLiteralParserException
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> StringLiteralParserException
-> c StringLiteralParserException
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c StringLiteralParserException)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c StringLiteralParserException)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> StringLiteralParserException -> m StringLiteralParserException
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> StringLiteralParserException -> m StringLiteralParserException
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> StringLiteralParserException -> m StringLiteralParserException
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> StringLiteralParserException -> m StringLiteralParserException
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> StringLiteralParserException -> m StringLiteralParserException
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> StringLiteralParserException -> m StringLiteralParserException
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> StringLiteralParserException
-> u
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> StringLiteralParserException
-> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> StringLiteralParserException -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> StringLiteralParserException -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> StringLiteralParserException
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> StringLiteralParserException
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> StringLiteralParserException
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> StringLiteralParserException
-> r
gmapT :: (forall b. Data b => b -> b)
-> StringLiteralParserException -> StringLiteralParserException
$cgmapT :: (forall b. Data b => b -> b)
-> StringLiteralParserException -> StringLiteralParserException
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c StringLiteralParserException)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c StringLiteralParserException)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c StringLiteralParserException)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c StringLiteralParserException)
dataTypeOf :: StringLiteralParserException -> DataType
$cdataTypeOf :: StringLiteralParserException -> DataType
toConstr :: StringLiteralParserException -> Constr
$ctoConstr :: StringLiteralParserException -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StringLiteralParserException
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StringLiteralParserException
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> StringLiteralParserException
-> c StringLiteralParserException
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> StringLiteralParserException
-> c StringLiteralParserException
Data, Eq StringLiteralParserException
Eq StringLiteralParserException
-> (StringLiteralParserException
    -> StringLiteralParserException -> Ordering)
-> (StringLiteralParserException
    -> StringLiteralParserException -> Bool)
-> (StringLiteralParserException
    -> StringLiteralParserException -> Bool)
-> (StringLiteralParserException
    -> StringLiteralParserException -> Bool)
-> (StringLiteralParserException
    -> StringLiteralParserException -> Bool)
-> (StringLiteralParserException
    -> StringLiteralParserException -> StringLiteralParserException)
-> (StringLiteralParserException
    -> StringLiteralParserException -> StringLiteralParserException)
-> Ord StringLiteralParserException
StringLiteralParserException
-> StringLiteralParserException -> Bool
StringLiteralParserException
-> StringLiteralParserException -> Ordering
StringLiteralParserException
-> StringLiteralParserException -> StringLiteralParserException
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
min :: StringLiteralParserException
-> StringLiteralParserException -> StringLiteralParserException
$cmin :: StringLiteralParserException
-> StringLiteralParserException -> StringLiteralParserException
max :: StringLiteralParserException
-> StringLiteralParserException -> StringLiteralParserException
$cmax :: StringLiteralParserException
-> StringLiteralParserException -> StringLiteralParserException
>= :: StringLiteralParserException
-> StringLiteralParserException -> Bool
$c>= :: StringLiteralParserException
-> StringLiteralParserException -> Bool
> :: StringLiteralParserException
-> StringLiteralParserException -> Bool
$c> :: StringLiteralParserException
-> StringLiteralParserException -> Bool
<= :: StringLiteralParserException
-> StringLiteralParserException -> Bool
$c<= :: StringLiteralParserException
-> StringLiteralParserException -> Bool
< :: StringLiteralParserException
-> StringLiteralParserException -> Bool
$c< :: StringLiteralParserException
-> StringLiteralParserException -> Bool
compare :: StringLiteralParserException
-> StringLiteralParserException -> Ordering
$ccompare :: StringLiteralParserException
-> StringLiteralParserException -> Ordering
Ord, Int -> StringLiteralParserException -> ShowS
[StringLiteralParserException] -> ShowS
StringLiteralParserException -> String
(Int -> StringLiteralParserException -> ShowS)
-> (StringLiteralParserException -> String)
-> ([StringLiteralParserException] -> ShowS)
-> Show StringLiteralParserException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StringLiteralParserException] -> ShowS
$cshowList :: [StringLiteralParserException] -> ShowS
show :: StringLiteralParserException -> String
$cshow :: StringLiteralParserException -> String
showsPrec :: Int -> StringLiteralParserException -> ShowS
$cshowsPrec :: Int -> StringLiteralParserException -> ShowS
Show, (forall x.
 StringLiteralParserException -> Rep StringLiteralParserException x)
-> (forall x.
    Rep StringLiteralParserException x -> StringLiteralParserException)
-> Generic StringLiteralParserException
forall x.
Rep StringLiteralParserException x -> StringLiteralParserException
forall x.
StringLiteralParserException -> Rep StringLiteralParserException x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep StringLiteralParserException x -> StringLiteralParserException
$cfrom :: forall x.
StringLiteralParserException -> Rep StringLiteralParserException x
Generic)

instance NFData StringLiteralParserException

instance ShowErrorComponent StringLiteralParserException where
  showErrorComponent :: StringLiteralParserException -> String
showErrorComponent (InvalidEscapeSequence Char
c) =
    String
"invalid escape sequence '\\" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char
c] String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"'"
  showErrorComponent (InvalidChar Char
c) =
    String
"invalid character '" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char
c] String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"'"

data ParserException =
  ParserException (ParseErrorBundle Text CustomParserException)
  deriving stock (ParserException -> ParserException -> Bool
(ParserException -> ParserException -> Bool)
-> (ParserException -> ParserException -> Bool)
-> Eq ParserException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParserException -> ParserException -> Bool
$c/= :: ParserException -> ParserException -> Bool
== :: ParserException -> ParserException -> Bool
$c== :: ParserException -> ParserException -> Bool
Eq, Int -> ParserException -> ShowS
[ParserException] -> ShowS
ParserException -> String
(Int -> ParserException -> ShowS)
-> (ParserException -> String)
-> ([ParserException] -> ShowS)
-> Show ParserException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParserException] -> ShowS
$cshowList :: [ParserException] -> ShowS
show :: ParserException -> String
$cshow :: ParserException -> String
showsPrec :: Int -> ParserException -> ShowS
$cshowsPrec :: Int -> ParserException -> ShowS
Show)

instance Exception ParserException where
  displayException :: ParserException -> String
displayException (ParserException ParseErrorBundle Text CustomParserException
bundle) = ParseErrorBundle Text CustomParserException -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty ParseErrorBundle Text CustomParserException
bundle

instance Buildable ParserException where
  build :: ParserException -> Builder
build (ParserException ParseErrorBundle Text CustomParserException
bundle) = String -> Builder
forall p. Buildable p => p -> Builder
build (String -> Builder) -> String -> Builder
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle Text CustomParserException -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty ParseErrorBundle Text CustomParserException
bundle