-- |
-- Module      :  Text.Megaparsec.Error.Builder
-- Copyright   :  © 2015–present Megaparsec contributors
-- License     :  FreeBSD
--
-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- A set of helpers that should make construction of 'ParseError's more
-- concise. This is primarily useful in test suites and for debugging.
--
-- @since 6.0.0

{-# LANGUAGE DeriveDataTypeable   #-}
{-# LANGUAGE DeriveGeneric        #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE StandaloneDeriving   #-}
{-# LANGUAGE UndecidableInstances #-}

module Text.Megaparsec.Error.Builder
  ( -- * Top-level helpers
    err
  , errFancy
    -- * Error components
  , utok
  , utoks
  , ulabel
  , ueof
  , etok
  , etoks
  , elabel
  , eeof
  , fancy
    -- * Data types
  , ET
  , EF )
where

import Data.Data (Data)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Proxy
import Data.Set (Set)
import Data.Typeable (Typeable)
import GHC.Generics
import Text.Megaparsec.Error
import Text.Megaparsec.Stream
import qualified Data.List.NonEmpty as NE
import qualified Data.Set           as E

----------------------------------------------------------------------------
-- Data types

-- | Auxiliary type for construction of trivial parse errors.

data ET s = ET (Maybe (ErrorItem (Token s))) (Set (ErrorItem (Token s)))
  deriving (Typeable, (forall x. ET s -> Rep (ET s) x)
-> (forall x. Rep (ET s) x -> ET s) -> Generic (ET s)
forall x. Rep (ET s) x -> ET s
forall x. ET s -> Rep (ET s) x
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 us0 :: Maybe (ErrorItem (Token s))
us0 ps0 :: Set (ErrorItem (Token s))
ps0 <> :: ET s -> ET s -> ET s
<> ET us1 :: Maybe (ErrorItem (Token s))
us1 ps1 :: Set (ErrorItem (Token s))
ps1 = Maybe (ErrorItem (Token s)) -> Set (ErrorItem (Token s)) -> ET s
forall s.
Maybe (ErrorItem (Token s)) -> Set (ErrorItem (Token s)) -> ET s
ET (Maybe (ErrorItem (Token s))
-> Maybe (ErrorItem (Token s)) -> Maybe (ErrorItem (Token s))
forall a. Ord a => Maybe a -> Maybe a -> Maybe a
n Maybe (ErrorItem (Token s))
us0 Maybe (ErrorItem (Token s))
us1) (Set (ErrorItem (Token s))
-> Set (ErrorItem (Token s)) -> Set (ErrorItem (Token s))
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 Nothing  Nothing = Maybe a
forall a. Maybe a
Nothing
      n (Just x :: a
x) Nothing = a -> Maybe a
forall a. a -> Maybe a
Just a
x
      n Nothing (Just y :: a
y) = a -> Maybe a
forall a. a -> Maybe a
Just a
y
      n (Just x :: a
x) (Just y :: a
y) = a -> Maybe a
forall a. a -> Maybe a
Just (a -> a -> a
forall a. Ord a => a -> a -> a
max a
x a
y)

instance Stream s => Monoid (ET s) where
  mempty :: ET s
mempty  = Maybe (ErrorItem (Token s)) -> Set (ErrorItem (Token s)) -> ET s
forall s.
Maybe (ErrorItem (Token s)) -> Set (ErrorItem (Token s)) -> ET s
ET Maybe (ErrorItem (Token s))
forall a. Maybe a
Nothing Set (ErrorItem (Token s))
forall a. Set a
E.empty
  mappend :: ET s -> ET s -> ET s
mappend = ET s -> ET s -> ET s
forall a. Semigroup a => a -> a -> a
(<>)

-- | Auxiliary type for construction of fancy parse errors.

newtype EF e = EF (Set (ErrorFancy e))
  deriving (EF e -> EF e -> Bool
(EF e -> EF e -> Bool) -> (EF e -> EF e -> Bool) -> Eq (EF e)
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, Eq (EF e)
Eq (EF e) =>
(EF e -> EF e -> Ordering)
-> (EF e -> EF e -> Bool)
-> (EF e -> EF e -> Bool)
-> (EF e -> EF e -> Bool)
-> (EF e -> EF e -> Bool)
-> (EF e -> EF e -> EF e)
-> (EF e -> EF e -> EF e)
-> Ord (EF e)
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
$cp1Ord :: forall e. Ord e => Eq (EF e)
Ord, Typeable (EF e)
Constr
DataType
Typeable (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 (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (EF e))
-> (EF e -> Constr)
-> (EF e -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (EF e)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (EF e)))
-> ((forall b. Data b => b -> b) -> EF e -> EF e)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> EF e -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> EF e -> r)
-> (forall u. (forall d. Data d => d -> u) -> EF e -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> EF e -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> EF e -> m (EF e))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> EF e -> m (EF e))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> EF e -> m (EF e))
-> Data (EF e)
EF e -> Constr
EF e -> DataType
(forall d. Data d => c (t d)) -> Maybe (c (EF e))
(forall b. Data b => b -> b) -> EF e -> EF e
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EF e -> c (EF e)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (EF e)
forall e. (Data e, Ord e) => Typeable (EF e)
forall e. (Data e, Ord e) => EF e -> Constr
forall e. (Data e, Ord e) => EF e -> DataType
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 u. Int -> (forall d. Data d => d -> u) -> EF e -> u
forall u. (forall d. Data d => d -> u) -> EF e -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> EF e -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> EF e -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> EF e -> m (EF e)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EF e -> m (EF e)
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))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (EF e))
$cEF :: Constr
$tEF :: DataType
gmapMo :: (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 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 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 :: 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 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 :: (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 :: (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 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 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 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 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)
$cp1Data :: forall e. (Data e, Ord e) => Typeable (EF e)
Data, Typeable, (forall x. EF e -> Rep (EF e) x)
-> (forall x. Rep (EF e) x -> EF e) -> Generic (EF e)
forall x. Rep (EF e) x -> EF e
forall x. EF e -> Rep (EF e) x
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 xs0 :: Set (ErrorFancy e)
xs0 <> :: EF e -> EF e -> EF e
<> EF xs1 :: Set (ErrorFancy e)
xs1 = Set (ErrorFancy e) -> EF e
forall e. Set (ErrorFancy e) -> EF e
EF (Set (ErrorFancy e) -> Set (ErrorFancy e) -> Set (ErrorFancy e)
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  = Set (ErrorFancy e) -> EF e
forall e. Set (ErrorFancy e) -> EF e
EF Set (ErrorFancy e)
forall a. Set a
E.empty
  mappend :: EF e -> EF e -> EF e
mappend = EF e -> EF e -> EF e
forall a. Semigroup a => a -> a -> a
(<>)

----------------------------------------------------------------------------
-- Top-level helpers

-- | Assemble a 'ParseError' from offset and @'ET' t@ value. @'ET' t@ is a
-- monoid and can be assembled by combining primitives provided by this
-- module, see below.

err
  :: Int               -- ^ 'ParseError' offset
  -> ET s              -- ^ Error components
  -> ParseError s e    -- ^ Resulting 'ParseError'
err :: Int -> ET s -> ParseError s e
err p :: Int
p (ET us :: Maybe (ErrorItem (Token s))
us ps :: Set (ErrorItem (Token s))
ps) = Int
-> Maybe (ErrorItem (Token s))
-> Set (ErrorItem (Token s))
-> ParseError s e
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

-- | Like 'err', but constructs a “fancy” 'ParseError'.

errFancy
  :: Int               -- ^ 'ParseError' offset
  -> EF e              -- ^ Error components
  -> ParseError s e    -- ^ Resulting 'ParseError'
errFancy :: Int -> EF e -> ParseError s e
errFancy p :: Int
p (EF xs :: Set (ErrorFancy e)
xs) = Int -> Set (ErrorFancy e) -> ParseError s e
forall s e. Int -> Set (ErrorFancy e) -> ParseError s e
FancyError Int
p Set (ErrorFancy e)
xs

----------------------------------------------------------------------------
-- Error components

-- | Construct an “unexpected token” error component.

utok :: Stream s => Token s -> ET s
utok :: Token s -> ET s
utok = ErrorItem (Token s) -> ET s
forall s. Stream s => ErrorItem (Token s) -> ET s
unexp (ErrorItem (Token s) -> ET s)
-> (Token s -> ErrorItem (Token s)) -> Token s -> ET s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Token s) -> ErrorItem (Token s)
forall t. NonEmpty t -> ErrorItem t
Tokens (NonEmpty (Token s) -> ErrorItem (Token s))
-> (Token s -> NonEmpty (Token s))
-> Token s
-> ErrorItem (Token s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token s -> NonEmpty (Token s)
forall a. a -> NonEmpty a
nes

-- | Construct an “unexpected tokens” error component. Empty chunk produces
-- 'EndOfInput'.

utoks :: forall s. Stream s => Tokens s -> ET s
utoks :: Tokens s -> ET s
utoks = ErrorItem (Token s) -> ET s
forall s. Stream s => ErrorItem (Token s) -> ET s
unexp (ErrorItem (Token s) -> ET s)
-> (Tokens s -> ErrorItem (Token s)) -> Tokens s -> ET s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy s -> Tokens s -> ErrorItem (Token s)
forall s. Stream s => Proxy s -> Tokens s -> ErrorItem (Token s)
canonicalizeTokens (Proxy s
forall k (t :: k). Proxy t
Proxy :: Proxy s)

-- | Construct an “unexpected label” error component. Do not use with empty
-- strings (for empty strings it's bottom).

ulabel :: Stream s => String -> ET s
ulabel :: String -> ET s
ulabel label :: String
label
  | String
label String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "" = String -> ET s
forall a. HasCallStack => String -> a
error "Text.Megaparsec.Error.Builder.ulabel: empty label"
  | Bool
otherwise = ErrorItem (Token s) -> ET s
forall s. Stream s => ErrorItem (Token s) -> ET s
unexp (ErrorItem (Token s) -> ET s)
-> (String -> ErrorItem (Token s)) -> String -> ET s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Char -> ErrorItem (Token s)
forall t. NonEmpty Char -> ErrorItem t
Label (NonEmpty Char -> ErrorItem (Token s))
-> (String -> NonEmpty Char) -> String -> ErrorItem (Token s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> NonEmpty Char
forall a. [a] -> NonEmpty a
NE.fromList (String -> ET s) -> String -> ET s
forall a b. (a -> b) -> a -> b
$ String
label

-- | Construct an “unexpected end of input” error component.

ueof :: Stream s => ET s
ueof :: ET s
ueof = ErrorItem (Token s) -> ET s
forall s. Stream s => ErrorItem (Token s) -> ET s
unexp ErrorItem (Token s)
forall t. ErrorItem t
EndOfInput

-- | Construct an “expected token” error component.

etok :: Stream s => Token s -> ET s
etok :: Token s -> ET s
etok = ErrorItem (Token s) -> ET s
forall s. Stream s => ErrorItem (Token s) -> ET s
expe (ErrorItem (Token s) -> ET s)
-> (Token s -> ErrorItem (Token s)) -> Token s -> ET s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Token s) -> ErrorItem (Token s)
forall t. NonEmpty t -> ErrorItem t
Tokens (NonEmpty (Token s) -> ErrorItem (Token s))
-> (Token s -> NonEmpty (Token s))
-> Token s
-> ErrorItem (Token s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token s -> NonEmpty (Token s)
forall a. a -> NonEmpty a
nes

-- | Construct an “expected tokens” error component. Empty chunk produces
-- 'EndOfInput'.

etoks :: forall s. Stream s => Tokens s -> ET s
etoks :: Tokens s -> ET s
etoks = ErrorItem (Token s) -> ET s
forall s. Stream s => ErrorItem (Token s) -> ET s
expe (ErrorItem (Token s) -> ET s)
-> (Tokens s -> ErrorItem (Token s)) -> Tokens s -> ET s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy s -> Tokens s -> ErrorItem (Token s)
forall s. Stream s => Proxy s -> Tokens s -> ErrorItem (Token s)
canonicalizeTokens (Proxy s
forall k (t :: k). Proxy t
Proxy :: Proxy s)

-- | Construct an “expected label” error component. Do not use with empty
-- strings.

elabel :: Stream s => String -> ET s
elabel :: String -> ET s
elabel label :: String
label
  | String
label String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "" = String -> ET s
forall a. HasCallStack => String -> a
error "Text.Megaparsec.Error.Builder.elabel: empty label"
  | Bool
otherwise = ErrorItem (Token s) -> ET s
forall s. Stream s => ErrorItem (Token s) -> ET s
expe (ErrorItem (Token s) -> ET s)
-> (String -> ErrorItem (Token s)) -> String -> ET s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Char -> ErrorItem (Token s)
forall t. NonEmpty Char -> ErrorItem t
Label (NonEmpty Char -> ErrorItem (Token s))
-> (String -> NonEmpty Char) -> String -> ErrorItem (Token s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> NonEmpty Char
forall a. [a] -> NonEmpty a
NE.fromList (String -> ET s) -> String -> ET s
forall a b. (a -> b) -> a -> b
$ String
label

-- | Construct an “expected end of input” error component.

eeof :: Stream s => ET s
eeof :: ET s
eeof = ErrorItem (Token s) -> ET s
forall s. Stream s => ErrorItem (Token s) -> ET s
expe ErrorItem (Token s)
forall t. ErrorItem t
EndOfInput

-- | Construct a custom error component.

fancy :: ErrorFancy e -> EF e
fancy :: ErrorFancy e -> EF e
fancy = Set (ErrorFancy e) -> EF e
forall e. Set (ErrorFancy e) -> EF e
EF (Set (ErrorFancy e) -> EF e)
-> (ErrorFancy e -> Set (ErrorFancy e)) -> ErrorFancy e -> EF e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorFancy e -> Set (ErrorFancy e)
forall a. a -> Set a
E.singleton

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

-- | Construct appropriate 'ErrorItem' representation for given token
-- stream. Empty string produces 'EndOfInput'.

canonicalizeTokens
  :: Stream s
  => Proxy s
  -> Tokens s
  -> ErrorItem (Token s)
canonicalizeTokens :: Proxy s -> Tokens s -> ErrorItem (Token s)
canonicalizeTokens pxy :: Proxy s
pxy ts :: Tokens s
ts =
  case [Token s] -> Maybe (NonEmpty (Token s))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty (Proxy s -> Tokens s -> [Token s]
forall s. Stream s => Proxy s -> Tokens s -> [Token s]
chunkToTokens Proxy s
pxy Tokens s
ts) of
    Nothing -> ErrorItem (Token s)
forall t. ErrorItem t
EndOfInput
    Just xs :: NonEmpty (Token s)
xs -> NonEmpty (Token s) -> ErrorItem (Token s)
forall t. NonEmpty t -> ErrorItem t
Tokens NonEmpty (Token s)
xs

-- | Lift an unexpected item into 'ET'.

unexp :: Stream s => ErrorItem (Token s) -> ET s
unexp :: ErrorItem (Token s) -> ET s
unexp u :: ErrorItem (Token s)
u = Maybe (ErrorItem (Token s)) -> Set (ErrorItem (Token s)) -> ET s
forall s.
Maybe (ErrorItem (Token s)) -> Set (ErrorItem (Token s)) -> ET s
ET (ErrorItem (Token s) -> Maybe (ErrorItem (Token s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ErrorItem (Token s)
u) Set (ErrorItem (Token s))
forall a. Set a
E.empty

-- | Lift an expected item into 'ET'.

expe :: Stream s => ErrorItem (Token s) -> ET s
expe :: ErrorItem (Token s) -> ET s
expe p :: ErrorItem (Token s)
p = Maybe (ErrorItem (Token s)) -> Set (ErrorItem (Token s)) -> ET s
forall s.
Maybe (ErrorItem (Token s)) -> Set (ErrorItem (Token s)) -> ET s
ET Maybe (ErrorItem (Token s))
forall a. Maybe a
Nothing (ErrorItem (Token s) -> Set (ErrorItem (Token s))
forall a. a -> Set a
E.singleton ErrorItem (Token s)
p)

-- | Make a singleton non-empty list from a value.

nes :: a -> NonEmpty a
nes :: a -> NonEmpty a
nes x :: a
x = a
x a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| []