-- |
-- 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 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 = 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 Maybe a
Nothing  Maybe a
Nothing = Maybe a
forall a. Maybe a
Nothing
      n (Just a
x) Maybe a
Nothing = a -> Maybe a
forall a. a -> Maybe a
Just a
x
      n Maybe a
Nothing (Just a
y) = a -> Maybe a
forall a. a -> Maybe a
Just a
y
      n (Just a
x) (Just 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)
DataType
Constr
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 -> DataType
EF e -> Constr
(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 -> 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 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 Set (ErrorFancy e)
xs0 <> :: EF e -> EF e -> EF e
<> EF 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 Int
p (ET Maybe (ErrorItem (Token s))
us 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 Int
p (EF 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 String
label
  | String
label String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"" = String -> ET s
forall a. HasCallStack => String -> a
error String
"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 String
label
  | String
label String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"" = String -> ET s
forall a. HasCallStack => String -> a
error String
"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 Proxy s
pxy 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
    Maybe (NonEmpty (Token s))
Nothing -> ErrorItem (Token s)
forall t. ErrorItem t
EndOfInput
    Just 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 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 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 a
x = a
x a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| []