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

-- |
-- 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
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 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 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 the offset and the @'ET' t@ value. @'ET'
-- t@ is a monoid and can be assembled by combining primitives provided by
-- this module, see below.
err ::
  -- | 'ParseError' offset
  Int ->
  -- | Error components
  ET s ->
  -- | Resulting 'ParseError'
  ParseError s e
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 ::
  -- | 'ParseError' offset
  Int ->
  -- | Error components
  EF e ->
  -- | Resulting 'ParseError'
  ParseError s e
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 the appropriate 'ErrorItem' representation for the given
-- token stream. The 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
:| []