-- | If you are only interested in full parses of some parser @p@, enforce
-- full parses on the `Parser` level using the
-- `ParseLib.Simple.Derived.eof` combinator as in @`parse` (p <*
-- `ParseLib.Simple.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.Simple.Core
  (
    -- * The type of parsers
    Parser,
    -- * Elementary parsers
    anySymbol,
    satisfy,
    empty,
    failp,
    succeed,
    pure,
    fail,
    expected,
    -- * Parser combinators
    (<|>),
    (<<|>),
    (<*>),
    (<$>),
    (>>=),
    -- * Lookahead
    look,
    -- * Running parsers
    parseAndTrace,
    parseWithConfig,
    parse,
  )
  where

import Data.Bifunctor (first, second)
import Data.DifferenceList (DifferenceList)
import qualified Data.DifferenceList as D
import Data.Foldable (toList)
import Data.List.NonEmpty (NonEmpty ((:|)))
import ParseLib.Error
  ( Config (Config, errorCount),
    ErrorsPretty (errorBundlePrettyImproved),
    ParseError (Fail, ParseError),
    ParseErrorBundle (ParseErrorBundle),
    defaultConfig,
    toBundle,
    traceErrorMessage,
  )
import Prelude hiding (MonadFail (..), pure, (<$>), (<*>), (>>=))

-- | 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.
type Parser s r = [s] -> ([(r, [s])], DifferenceList (ParseError [s]))

fail :: String -> Parser s a
fail text input = ([], D.singleton $ Fail text input)

expected :: [s] -> Parser s a
expected expect input = ([], D.singleton $ ParseError expect input)

-- | Parses any single symbol.
anySymbol :: Parser s s
anySymbol (x:xs)  =  ([(x,xs)], mempty)
anySymbol []      =  fail "Core.anySymbol expected any symbol." []

-- | Takes a predicate and returns a parser that parses a
-- single symbol satisfying that predicate.
satisfy  ::  (s -> Bool) -> Parser s s
satisfy p (x:xs) | p x  =  ([(x,xs)], mempty)
satisfy _ input         =  fail "Core.satisfy expected a symbol satisfying the predicate argument." input

-- | Parser for the empty language, i.e., parser that always fails.
empty :: Parser s a
empty = fail "Core.empty"

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

-- | Parser that always succeeds, i.e., for epsilon.
succeed :: a -> Parser s a
succeed r xs = ([(r, xs)], mempty)

-- | Same as 'succeed'; provided for compatiblity with the applicative
-- interface.
pure :: a -> Parser s a
pure = succeed

infixl 4  <$>, <*>
infixr 3  <|>, <<|>
infixl 1  >>=

-- | Choice between two parsers with the same result type.
(<|>) :: Parser s a -> Parser s a -> Parser s a
(p <|> q) xs  =  p xs <> q xs

-- | 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) xs  =  let pxs@(r, es) = p xs in if null r then second (es <>) (q xs) else pxs

-- | Sequence of two parsers.
(<*>) :: Parser s (b -> a) -> Parser s b -> Parser s a
(p <*> q) xs =
  second (es0 <>) $
  foldMap (\(f, ys) -> (first . fmap . first) f (q ys)) $
  r0
  where (r0, es0) = p xs

-- | Map a function over the results of a parser. The '<$>' combinator
-- can also be defined in terms of 'succeed' and '<*>':
--
-- > f <$> p  =  succeed f <*> p
--
(<$>) :: (a -> b) -> Parser s a -> Parser s b
(f <$> p) xs =
  (
    [(f y,ys)
    |(  y,ys) <- r
    ]
    ,
    es0
  )
  where (r, es0) = p xs

-- | Monadic bind. Do not use this combinator unless absolutely
-- required. Most sequencing can be done with '<*>'.
(>>=) :: Parser s a -> (a -> Parser s b) -> Parser s b
(p >>= f) xs  =
  second (es0 <>) $
  foldMap (\(a, ys) -> f a ys) $
  r
  where (r, es0) = p xs

-- | Returns the rest of the input without consuming anything.
look :: Parser s [s]
look xs = ([(xs, xs)], mempty)

-- | 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 {errorCount}) p =
  -- Either (ParseErrorBundle [s]) (NonEmpty (a, [s]))
  first ParseErrorBundle .
  -- Either [(WithLength [s], NonEmpty (BundledParseError [s]))] (NonEmpty (a, [s]))
  (if errorCount >= 0 then first (take errorCount) else id) .
  -- Either [(WithLength [s], NonEmpty (BundledParseError [s]))] (NonEmpty (a, [s]))
  first toBundle .
  -- Either [ParseError [s]] (NonEmpty (a, [s]))
  first toList .
  -- Either (DifferenceList (ParseError [s])) (NonEmpty (a, [s]))
  (\case
    ([], errors) -> Left errors
    (a : b, _) -> Right (a :| b)
  ) .
  -- ([(a, [s])], DifferenceList (ParseError [s]))
  p
  -- [s]

-- | 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