{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
module Text.Megaparsec.Error.Builder
(
err,
errFancy,
utok,
utoks,
ulabel,
ueof,
etok,
etoks,
elabel,
eeof,
fancy,
ET,
EF,
)
where
import Data.Data (Data)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import Data.Proxy
import Data.Set (Set)
import qualified Data.Set as E
import Data.Typeable (Typeable)
import GHC.Generics
import Text.Megaparsec.Error
import Text.Megaparsec.Stream
data ET s = ET (Maybe (ErrorItem (Token s))) (Set (ErrorItem (Token s)))
deriving (Typeable, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall s x. Rep (ET s) x -> ET s
forall s x. ET s -> Rep (ET s) x
$cto :: forall s x. Rep (ET s) x -> ET s
$cfrom :: forall s x. ET s -> Rep (ET s) x
Generic)
deriving instance (Eq (Token s)) => Eq (ET s)
deriving instance (Ord (Token s)) => Ord (ET s)
deriving instance
( Data s,
Data (Token s),
Ord (Token s)
) =>
Data (ET s)
instance (Stream s) => Semigroup (ET s) where
ET Maybe (ErrorItem (Token s))
us0 Set (ErrorItem (Token s))
ps0 <> :: ET s -> ET s -> ET s
<> ET Maybe (ErrorItem (Token s))
us1 Set (ErrorItem (Token s))
ps1 = forall s.
Maybe (ErrorItem (Token s)) -> Set (ErrorItem (Token s)) -> ET s
ET (forall {a}. Ord a => Maybe a -> Maybe a -> Maybe a
n Maybe (ErrorItem (Token s))
us0 Maybe (ErrorItem (Token s))
us1) (forall a. Ord a => Set a -> Set a -> Set a
E.union Set (ErrorItem (Token s))
ps0 Set (ErrorItem (Token s))
ps1)
where
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)
instance (Stream s) => Monoid (ET s) where
mempty :: ET s
mempty = forall s.
Maybe (ErrorItem (Token s)) -> Set (ErrorItem (Token s)) -> ET s
ET forall a. Maybe a
Nothing forall a. Set a
E.empty
mappend :: ET s -> ET s -> ET s
mappend = forall a. Semigroup a => a -> a -> a
(<>)
newtype EF e = EF (Set (ErrorFancy e))
deriving (EF e -> EF e -> Bool
forall e. Eq e => EF e -> EF e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EF e -> EF e -> Bool
$c/= :: forall e. Eq e => EF e -> EF e -> Bool
== :: EF e -> EF e -> Bool
$c== :: forall e. Eq e => EF e -> EF e -> Bool
Eq, EF e -> EF e -> Bool
EF e -> EF e -> Ordering
EF e -> EF e -> EF e
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 (EF e)
forall e. Ord e => EF e -> EF e -> Bool
forall e. Ord e => EF e -> EF e -> Ordering
forall e. Ord e => EF e -> EF e -> EF e
min :: EF e -> EF e -> EF e
$cmin :: forall e. Ord e => EF e -> EF e -> EF e
max :: EF e -> EF e -> EF e
$cmax :: forall e. Ord e => EF e -> EF e -> EF e
>= :: EF e -> EF e -> Bool
$c>= :: forall e. Ord e => EF e -> EF e -> Bool
> :: EF e -> EF e -> Bool
$c> :: forall e. Ord e => EF e -> EF e -> Bool
<= :: EF e -> EF e -> Bool
$c<= :: forall e. Ord e => EF e -> EF e -> Bool
< :: EF e -> EF e -> Bool
$c< :: forall e. Ord e => EF e -> EF e -> Bool
compare :: EF e -> EF e -> Ordering
$ccompare :: forall e. Ord e => EF e -> EF e -> Ordering
Ord, EF e -> DataType
EF e -> Constr
forall {e}. (Data e, Ord e) => Typeable (EF e)
forall e. (Data e, Ord e) => EF e -> DataType
forall e. (Data e, Ord e) => EF e -> Constr
forall e.
(Data e, Ord e) =>
(forall b. Data b => b -> b) -> EF e -> EF e
forall e u.
(Data e, Ord e) =>
Int -> (forall d. Data d => d -> u) -> EF e -> u
forall e u.
(Data e, Ord e) =>
(forall d. Data d => d -> u) -> EF e -> [u]
forall e r r'.
(Data e, Ord e) =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> EF e -> r
forall e r r'.
(Data e, Ord e) =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> EF e -> r
forall e (m :: * -> *).
(Data e, Ord e, Monad m) =>
(forall d. Data d => d -> m d) -> EF e -> m (EF e)
forall e (m :: * -> *).
(Data e, Ord e, MonadPlus m) =>
(forall d. Data d => d -> m d) -> EF e -> m (EF e)
forall e (c :: * -> *).
(Data e, Ord e) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (EF e)
forall e (c :: * -> *).
(Data e, Ord e) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EF e -> c (EF e)
forall e (t :: * -> *) (c :: * -> *).
(Data e, Ord e, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (EF e))
forall e (t :: * -> * -> *) (c :: * -> *).
(Data e, Ord e, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (EF 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 (EF e)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EF e -> c (EF e)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (EF e))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EF e -> m (EF e)
$cgmapMo :: forall e (m :: * -> *).
(Data e, Ord e, MonadPlus m) =>
(forall d. Data d => d -> m d) -> EF e -> m (EF e)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EF e -> m (EF e)
$cgmapMp :: forall e (m :: * -> *).
(Data e, Ord e, MonadPlus m) =>
(forall d. Data d => d -> m d) -> EF e -> m (EF e)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> EF e -> m (EF e)
$cgmapM :: forall e (m :: * -> *).
(Data e, Ord e, Monad m) =>
(forall d. Data d => d -> m d) -> EF e -> m (EF e)
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> EF e -> u
$cgmapQi :: forall e u.
(Data e, Ord e) =>
Int -> (forall d. Data d => d -> u) -> EF e -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> EF e -> [u]
$cgmapQ :: forall e u.
(Data e, Ord e) =>
(forall d. Data d => d -> u) -> EF e -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> EF e -> r
$cgmapQr :: forall e r r'.
(Data e, Ord e) =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> EF e -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> EF e -> r
$cgmapQl :: forall e r r'.
(Data e, Ord e) =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> EF e -> r
gmapT :: (forall b. Data b => b -> b) -> EF e -> EF e
$cgmapT :: forall e.
(Data e, Ord e) =>
(forall b. Data b => b -> b) -> EF e -> EF e
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (EF e))
$cdataCast2 :: forall e (t :: * -> * -> *) (c :: * -> *).
(Data e, Ord e, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (EF e))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (EF e))
$cdataCast1 :: forall e (t :: * -> *) (c :: * -> *).
(Data e, Ord e, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (EF e))
dataTypeOf :: EF e -> DataType
$cdataTypeOf :: forall e. (Data e, Ord e) => EF e -> DataType
toConstr :: EF e -> Constr
$ctoConstr :: forall e. (Data e, Ord e) => EF e -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (EF e)
$cgunfold :: forall e (c :: * -> *).
(Data e, Ord e) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (EF e)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EF e -> c (EF e)
$cgfoldl :: forall e (c :: * -> *).
(Data e, Ord e) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EF e -> c (EF e)
Data, Typeable, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall e x. Rep (EF e) x -> EF e
forall e x. EF e -> Rep (EF e) x
$cto :: forall e x. Rep (EF e) x -> EF e
$cfrom :: forall e x. EF e -> Rep (EF e) x
Generic)
instance (Ord e) => Semigroup (EF e) where
EF Set (ErrorFancy e)
xs0 <> :: EF e -> EF e -> EF e
<> EF Set (ErrorFancy e)
xs1 = forall e. Set (ErrorFancy e) -> EF e
EF (forall a. Ord a => Set a -> Set a -> Set a
E.union Set (ErrorFancy e)
xs0 Set (ErrorFancy e)
xs1)
instance (Ord e) => Monoid (EF e) where
mempty :: EF e
mempty = forall e. Set (ErrorFancy e) -> EF e
EF forall a. Set a
E.empty
mappend :: EF e -> EF e -> EF e
mappend = forall a. Semigroup a => a -> a -> a
(<>)
err ::
Int ->
ET s ->
ParseError s e
err :: forall s e. Int -> ET s -> ParseError s e
err Int
p (ET Maybe (ErrorItem (Token s))
us Set (ErrorItem (Token s))
ps) = forall s e.
Int
-> Maybe (ErrorItem (Token s))
-> Set (ErrorItem (Token s))
-> ParseError s e
TrivialError Int
p Maybe (ErrorItem (Token s))
us Set (ErrorItem (Token s))
ps
errFancy ::
Int ->
EF e ->
ParseError s e
errFancy :: forall e s. Int -> EF e -> ParseError s e
errFancy Int
p (EF Set (ErrorFancy e)
xs) = forall s e. Int -> Set (ErrorFancy e) -> ParseError s e
FancyError Int
p Set (ErrorFancy e)
xs
utok :: (Stream s) => Token s -> ET s
utok :: forall s. Stream s => Token s -> ET s
utok = forall s. Stream s => ErrorItem (Token s) -> ET s
unexp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. NonEmpty t -> ErrorItem t
Tokens forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> NonEmpty a
nes
utoks :: forall s. (Stream s) => Tokens s -> ET s
utoks :: forall s. Stream s => Tokens s -> ET s
utoks = forall s. Stream s => ErrorItem (Token s) -> ET s
unexp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. Stream s => Proxy s -> Tokens s -> ErrorItem (Token s)
canonicalizeTokens (forall {k} (t :: k). Proxy t
Proxy :: Proxy s)
ulabel :: (Stream s) => String -> ET s
ulabel :: forall s. Stream s => String -> ET s
ulabel String
label
| String
label forall a. Eq a => a -> a -> Bool
== String
"" = forall a. HasCallStack => String -> a
error String
"Text.Megaparsec.Error.Builder.ulabel: empty label"
| Bool
otherwise = forall s. Stream s => ErrorItem (Token s) -> ET s
unexp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. NonEmpty Char -> ErrorItem t
Label forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> NonEmpty a
NE.fromList forall a b. (a -> b) -> a -> b
$ String
label
ueof :: (Stream s) => ET s
ueof :: forall s. Stream s => ET s
ueof = forall s. Stream s => ErrorItem (Token s) -> ET s
unexp forall t. ErrorItem t
EndOfInput
etok :: (Stream s) => Token s -> ET s
etok :: forall s. Stream s => Token s -> ET s
etok = forall s. Stream s => ErrorItem (Token s) -> ET s
expe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. NonEmpty t -> ErrorItem t
Tokens forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> NonEmpty a
nes
etoks :: forall s. (Stream s) => Tokens s -> ET s
etoks :: forall s. Stream s => Tokens s -> ET s
etoks = forall s. Stream s => ErrorItem (Token s) -> ET s
expe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. Stream s => Proxy s -> Tokens s -> ErrorItem (Token s)
canonicalizeTokens (forall {k} (t :: k). Proxy t
Proxy :: Proxy s)
elabel :: (Stream s) => String -> ET s
elabel :: forall s. Stream s => String -> ET s
elabel String
label
| String
label forall a. Eq a => a -> a -> Bool
== String
"" = forall a. HasCallStack => String -> a
error String
"Text.Megaparsec.Error.Builder.elabel: empty label"
| Bool
otherwise = forall s. Stream s => ErrorItem (Token s) -> ET s
expe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. NonEmpty Char -> ErrorItem t
Label forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> NonEmpty a
NE.fromList forall a b. (a -> b) -> a -> b
$ String
label
eeof :: (Stream s) => ET s
eeof :: forall s. Stream s => ET s
eeof = forall s. Stream s => ErrorItem (Token s) -> ET s
expe forall t. ErrorItem t
EndOfInput
fancy :: ErrorFancy e -> EF e
fancy :: forall e. ErrorFancy e -> EF e
fancy = forall e. Set (ErrorFancy e) -> EF e
EF forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Set a
E.singleton
canonicalizeTokens ::
(Stream s) =>
Proxy s ->
Tokens s ->
ErrorItem (Token s)
canonicalizeTokens :: forall s. Stream s => Proxy s -> Tokens s -> ErrorItem (Token s)
canonicalizeTokens Proxy s
pxy Tokens s
ts =
case forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty (forall s. Stream s => Proxy s -> Tokens s -> [Token s]
chunkToTokens Proxy s
pxy Tokens s
ts) of
Maybe (NonEmpty (Token s))
Nothing -> forall t. ErrorItem t
EndOfInput
Just NonEmpty (Token s)
xs -> forall t. NonEmpty t -> ErrorItem t
Tokens NonEmpty (Token s)
xs
unexp :: (Stream s) => ErrorItem (Token s) -> ET s
unexp :: forall s. Stream s => ErrorItem (Token s) -> ET s
unexp ErrorItem (Token s)
u = forall s.
Maybe (ErrorItem (Token s)) -> Set (ErrorItem (Token s)) -> ET s
ET (forall (f :: * -> *) a. Applicative f => a -> f a
pure ErrorItem (Token s)
u) forall a. Set a
E.empty
expe :: (Stream s) => ErrorItem (Token s) -> ET s
expe :: forall s. Stream s => ErrorItem (Token s) -> ET s
expe ErrorItem (Token s)
p = forall s.
Maybe (ErrorItem (Token s)) -> Set (ErrorItem (Token s)) -> ET s
ET forall a. Maybe a
Nothing (forall a. a -> Set a
E.singleton ErrorItem (Token s)
p)
nes :: a -> NonEmpty a
nes :: forall a. a -> NonEmpty a
nes a
x = a
x forall a. a -> [a] -> NonEmpty a
:| []