-- | If you are only interested in full parses of some parser @p@, enforce
-- full parses on the `Parser` level using the
-- `ParseLib.Abstract.Derived.eof` combinator as in @`parse` (p <*
-- `ParseLib.Abstract.Derived.eof`) input@. This ensures error reporting.
--
-- Report bugs to [gitlab](https://gitlab.com/rdnz/uu-tc-error/-/issues)
-- or @p.rednaz\@googlemail.com@, please.

module ParseLib.Abstract.Core
  (
    -- * The type of parsers
    Parser (Parser),
    -- * Elementary parsers
    anySymbol,
    satisfy,
    empty,
    failp,
    succeed,
    pure,
    -- * Parser combinators
    (<|>),
    (<<|>),
    (<*>),
    (<$>),
    (>>=),
    -- * Lookahead
    look,
    -- * Running parsers
    parseAndTrace,
    parseWithConfig,
    parse,
  )
  where

import Control.Applicative
import Control.Monad
import Data.Bifunctor (first)
import Data.DifferenceList (DifferenceList)
import Data.List.NonEmpty (NonEmpty)
import ParseLib.Error
  ( Config,
    ErrorsPretty (errorBundlePrettyImproved),
    ParseError,
    ParseErrorBundle,
    defaultConfig,
    traceErrorMessage,
  )
import qualified ParseLib.Simple.Core as SP

-- | An input string is mapped to a list of successful parses.
-- For each succesful parse, we return the result of type 'r',
-- and the remaining input string. The input must be a list of
-- symbols.
newtype Parser s r =
  Parser {runParser :: [s] -> ([(r, [s])], DifferenceList (ParseError [s]))}

instance Functor (Parser s) where
  fmap f p  =  Parser (f SP.<$> runParser p)

instance Applicative (Parser s) where
  pure x    =  Parser (SP.succeed x)
  p <*> q   =  Parser (runParser p SP.<*> runParser q)

instance Alternative (Parser s) where
  empty     =  Parser SP.empty
  p <|> q   =  Parser (runParser p SP.<|> runParser q)

infixr 3 <<|>

-- | Biased choice. If the left hand side parser succeeds,
-- the right hand side is not considered. Use with care!
(<<|>) :: Parser s a -> Parser s a -> Parser s a
p <<|> q  =  Parser (runParser p SP.<<|> runParser q)

instance Monad (Parser s) where
  return    =  pure
  p >>= f   =  Parser (runParser p SP.>>= (runParser . f))

instance MonadPlus (Parser s) where
  mzero     =  empty
  mplus     =  (<|>)

-- | Parses any single symbol.
anySymbol :: Parser s s
anySymbol = Parser (SP.anySymbol)

-- | Takes a predicate and returns a parser that parses a
-- single symbol satisfying that predicate.
satisfy :: (s -> Bool) -> Parser s s
satisfy p = Parser (SP.satisfy p)

-- | Parser that always succeeds, i.e., for epsilon.
succeed :: a -> Parser s a
succeed = pure

-- | Same as 'empty'; provided for compatibility with the lecture notes.
failp :: Parser s a
failp = Parser SP.failp

-- | Returns the rest of the input without consuming anything.
look :: Parser s [s]
look = Parser SP.look

-- | Runs a parser on a given string printing error messages to standard
-- error (stderr).
--
-- The `ErrorsPretty` constraint is automatically fulfilled by `Show`
-- instances. But if you see the following GHC error, you usually need to
-- add an @(`ErrorsPretty` s)@ constraint to your function and @import
-- ParseLib.Error (`ErrorsPretty`)@.
--
-- @
-- Overlapping instances for ErrorsPretty s
-- arising from a use of ‘parseAndTrace’
-- @
--
-- `ErrorsPretty` is not defined in this package but in
-- @[uu-tc-error-error](https://hackage.haskell.org/package/uu-tc-error-error)@. We
-- did this so you can switch back and forth between this library and
-- @[uu-tc](https://hackage.haskell.org/package/uu-tc)@ without the need to
-- remove `ErrorsPretty` constraints from your code. Just permanently keep
-- @[uu-tc-error-error](https://hackage.haskell.org/package/uu-tc-error-error)@
-- in your @.cabal@ file. It does not conflict with
-- @[uu-tc](https://hackage.haskell.org/package/uu-tc)@ because there are
-- no module name collisions.
parseAndTrace ::
  (ErrorsPretty s, Ord s) => Config -> Parser s a -> [s] -> [(a, [s])]
parseAndTrace config p input =
  traceErrorMessage $
  first (errorBundlePrettyImproved config input) $
  parseWithConfig config p input

-- | Runs a parser on a given string. Pretty print the error information
-- with `errorBundlePrettyImproved`.
parseWithConfig ::
  (Ord s) =>
  Config ->
  Parser s a ->
  [s] ->
  Either (ParseErrorBundle [s]) (NonEmpty (a, [s]))
parseWithConfig config (Parser p) = SP.parseWithConfig config p

-- | Runs a parser on a given string printing error messages to standard
-- error (stderr).
--
-- Notice that, when using `parse`, you might need to add `Ord` and
-- `ErrorsPretty` constraints to your own functions and ensure your own
-- data types are @deriving (`Ord`, `Show`)@.
--
-- The `ErrorsPretty` constraint is automatically fulfilled by `Show`
-- instances. But if you see the following GHC error, you usually need to
-- add an @(`ErrorsPretty` s)@ constraint to your function and @import
-- ParseLib.Error (`ErrorsPretty`)@.
--
-- @
-- Overlapping instances for ErrorsPretty s
-- arising from a use of ‘parse’
-- @
--
-- `ErrorsPretty` is not defined in this package but in
-- @[uu-tc-error-error](https://hackage.haskell.org/package/uu-tc-error-error)@. We
-- did this so you can switch back and forth between this library and
-- @[uu-tc](https://hackage.haskell.org/package/uu-tc)@ without the need to
-- remove `ErrorsPretty` constraints from your code. Just permanently keep
-- @[uu-tc-error-error](https://hackage.haskell.org/package/uu-tc-error-error)@
-- in your @.cabal@ file. It does not conflict with
-- @[uu-tc](https://hackage.haskell.org/package/uu-tc)@ because there are
-- no module name collisions.
parse :: (ErrorsPretty s, Ord s) => Parser s a -> [s] -> [(a, [s])]
parse = parseAndTrace defaultConfig