{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# 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 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
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup
#endif
data ET s = ET (Maybe (ErrorItem (Token s))) (Set (ErrorItem (Token s)))
deriving (Typeable, 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 ps0 <> ET us1 ps1 = ET (n us0 us1) (E.union ps0 ps1)
where
n Nothing Nothing = Nothing
n (Just x) Nothing = Just x
n Nothing (Just y) = Just y
n (Just x) (Just y) = Just (max x y)
instance Stream s => Monoid (ET s) where
mempty = ET Nothing E.empty
mappend = (<>)
newtype EF e = EF (Set (ErrorFancy e))
deriving (Eq, Ord, Data, Typeable, Generic)
instance Ord e => Semigroup (EF e) where
EF xs0 <> EF xs1 = EF (E.union xs0 xs1)
instance Ord e => Monoid (EF e) where
mempty = EF E.empty
mappend = (<>)
err
:: Int
-> ET s
-> ParseError s e
err p (ET us ps) = TrivialError p us ps
errFancy
:: Int
-> EF e
-> ParseError s e
errFancy p (EF xs) = FancyError p xs
utok :: Stream s => Token s -> ET s
utok = unexp . Tokens . nes
utoks :: forall s. Stream s => Tokens s -> ET s
utoks = unexp . canonicalizeTokens (Proxy :: Proxy s)
ulabel :: Stream s => String -> ET s
ulabel = unexp . Label . NE.fromList
ueof :: Stream s => ET s
ueof = unexp EndOfInput
etok :: Stream s => Token s -> ET s
etok = expe . Tokens . nes
etoks :: forall s. Stream s => Tokens s -> ET s
etoks = expe . canonicalizeTokens (Proxy :: Proxy s)
elabel :: Stream s => String -> ET s
elabel = expe . Label . NE.fromList
eeof :: Stream s => ET s
eeof = expe EndOfInput
fancy :: ErrorFancy e -> EF e
fancy = EF . E.singleton
canonicalizeTokens
:: Stream s
=> Proxy s
-> Tokens s
-> ErrorItem (Token s)
canonicalizeTokens pxy ts =
case NE.nonEmpty (chunkToTokens pxy ts) of
Nothing -> EndOfInput
Just xs -> Tokens xs
unexp :: Stream s => ErrorItem (Token s) -> ET s
unexp u = ET (pure u) E.empty
expe :: Stream s => ErrorItem (Token s) -> ET s
expe p = ET Nothing (E.singleton p)
nes :: a -> NonEmpty a
nes x = x :| []