    -- |
    -- Module      :  Text.Megaparsec.Error.Builder
    -- Copyright   :  © 2015–2019 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 CPP                  #-}
    {-# 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

    #if !MIN_VERSION_base(4,11,0)
    import Data.Semigroup
    #endif

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

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

    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 = (<>)

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

    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 = (<>)

    ----------------------------------------------------------------------------
    -- 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 p (ET us ps) = TrivialError p us ps

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

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

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

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

    utok :: Stream s => Token s -> ET s
    utok = unexp . Tokens . nes

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

    utoks :: forall s. Stream s => Tokens s -> ET s
    utoks = unexp . canonicalizeTokens (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 label
      | label == "" = error "Text.Megaparsec.Error.Builder.ulabel: empty label"
      | otherwise = unexp . Label . NE.fromList $ label

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

    ueof :: Stream s => ET s
    ueof = unexp EndOfInput

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

    etok :: Stream s => Token s -> ET s
    etok = expe . Tokens . nes

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

    etoks :: forall s. Stream s => Tokens s -> ET s
    etoks = expe . canonicalizeTokens (Proxy :: Proxy s)

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

    elabel :: Stream s => String -> ET s
    elabel label
      | label == "" = error "Text.Megaparsec.Error.Builder.elabel: empty label"
      | otherwise = expe . Label . NE.fromList $ label

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

    eeof :: Stream s => ET s
    eeof = expe EndOfInput

    -- | Construct a custom error component.

    fancy :: ErrorFancy e -> EF e
    fancy = EF . 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 pxy ts =
      case NE.nonEmpty (chunkToTokens pxy ts) of
        Nothing -> EndOfInput
        Just xs -> Tokens xs

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

    unexp :: Stream s => ErrorItem (Token s) -> ET s
    unexp u = ET (pure u) E.empty

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

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

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

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