-- | 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 {forall s r.
Parser s r -> [s] -> ([(r, [s])], DifferenceList (ParseError [s]))
runParser :: [s] -> ([(r, [s])], DifferenceList (ParseError [s]))}

instance Functor (Parser s) where
  fmap :: forall a b. (a -> b) -> Parser s a -> Parser s b
fmap a -> b
f Parser s a
p  =  ([s] -> ([(b, [s])], DifferenceList (ParseError [s])))
-> Parser s b
forall s r.
([s] -> ([(r, [s])], DifferenceList (ParseError [s])))
-> Parser s r
Parser (a -> b
f (a -> b)
-> Parser s a
-> [s]
-> ([(b, [s])], DifferenceList (ParseError [s]))
forall a b s. (a -> b) -> Parser s a -> Parser s b
SP.<$> Parser s a -> Parser s a
forall s r.
Parser s r -> [s] -> ([(r, [s])], DifferenceList (ParseError [s]))
runParser Parser s a
p)

instance Applicative (Parser s) where
  pure :: forall a. a -> Parser s a
pure a
x    =  ([s] -> ([(a, [s])], DifferenceList (ParseError [s])))
-> Parser s a
forall s r.
([s] -> ([(r, [s])], DifferenceList (ParseError [s])))
-> Parser s r
Parser (a -> [s] -> ([(a, [s])], DifferenceList (ParseError [s]))
forall a s. a -> Parser s a
SP.succeed a
x)
  Parser s (a -> b)
p <*> :: forall a b. Parser s (a -> b) -> Parser s a -> Parser s b
<*> Parser s a
q   =  ([s] -> ([(b, [s])], DifferenceList (ParseError [s])))
-> Parser s b
forall s r.
([s] -> ([(r, [s])], DifferenceList (ParseError [s])))
-> Parser s r
Parser (Parser s (a -> b)
-> [s] -> ([(a -> b, [s])], DifferenceList (ParseError [s]))
forall s r.
Parser s r -> [s] -> ([(r, [s])], DifferenceList (ParseError [s]))
runParser Parser s (a -> b)
p ([s] -> ([(a -> b, [s])], DifferenceList (ParseError [s])))
-> Parser s a
-> [s]
-> ([(b, [s])], DifferenceList (ParseError [s]))
forall s b a. Parser s (b -> a) -> Parser s b -> Parser s a
SP.<*> Parser s a -> Parser s a
forall s r.
Parser s r -> [s] -> ([(r, [s])], DifferenceList (ParseError [s]))
runParser Parser s a
q)

instance Alternative (Parser s) where
  empty :: forall a. Parser s a
empty     =  ([s] -> ([(a, [s])], DifferenceList (ParseError [s])))
-> Parser s a
forall s r.
([s] -> ([(r, [s])], DifferenceList (ParseError [s])))
-> Parser s r
Parser [s] -> ([(a, [s])], DifferenceList (ParseError [s]))
forall s a. Parser s a
SP.empty
  Parser s a
p <|> :: forall a. Parser s a -> Parser s a -> Parser s a
<|> Parser s a
q   =  ([s] -> ([(a, [s])], DifferenceList (ParseError [s])))
-> Parser s a
forall s r.
([s] -> ([(r, [s])], DifferenceList (ParseError [s])))
-> Parser s r
Parser (Parser s a -> [s] -> ([(a, [s])], DifferenceList (ParseError [s]))
forall s r.
Parser s r -> [s] -> ([(r, [s])], DifferenceList (ParseError [s]))
runParser Parser s a
p ([s] -> ([(a, [s])], DifferenceList (ParseError [s])))
-> ([s] -> ([(a, [s])], DifferenceList (ParseError [s])))
-> [s]
-> ([(a, [s])], DifferenceList (ParseError [s]))
forall s a. Parser s a -> Parser s a -> Parser s a
SP.<|> Parser s a -> [s] -> ([(a, [s])], DifferenceList (ParseError [s]))
forall s r.
Parser s r -> [s] -> ([(r, [s])], DifferenceList (ParseError [s]))
runParser Parser s a
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
Parser s a
p <<|> :: forall s a. Parser s a -> Parser s a -> Parser s a
<<|> Parser s a
q  =  ([s] -> ([(a, [s])], DifferenceList (ParseError [s])))
-> Parser s a
forall s r.
([s] -> ([(r, [s])], DifferenceList (ParseError [s])))
-> Parser s r
Parser (Parser s a -> [s] -> ([(a, [s])], DifferenceList (ParseError [s]))
forall s r.
Parser s r -> [s] -> ([(r, [s])], DifferenceList (ParseError [s]))
runParser Parser s a
p ([s] -> ([(a, [s])], DifferenceList (ParseError [s])))
-> ([s] -> ([(a, [s])], DifferenceList (ParseError [s])))
-> [s]
-> ([(a, [s])], DifferenceList (ParseError [s]))
forall s a. Parser s a -> Parser s a -> Parser s a
SP.<<|> Parser s a -> [s] -> ([(a, [s])], DifferenceList (ParseError [s]))
forall s r.
Parser s r -> [s] -> ([(r, [s])], DifferenceList (ParseError [s]))
runParser Parser s a
q)

instance Monad (Parser s) where
  return :: forall a. a -> Parser s a
return    =  a -> Parser s a
forall a. a -> Parser s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  Parser s a
p >>= :: forall a b. Parser s a -> (a -> Parser s b) -> Parser s b
>>= a -> Parser s b
f   =  ([s] -> ([(b, [s])], DifferenceList (ParseError [s])))
-> Parser s b
forall s r.
([s] -> ([(r, [s])], DifferenceList (ParseError [s])))
-> Parser s r
Parser (Parser s a -> [s] -> ([(a, [s])], DifferenceList (ParseError [s]))
forall s r.
Parser s r -> [s] -> ([(r, [s])], DifferenceList (ParseError [s]))
runParser Parser s a
p ([s] -> ([(a, [s])], DifferenceList (ParseError [s])))
-> (a -> [s] -> ([(b, [s])], DifferenceList (ParseError [s])))
-> [s]
-> ([(b, [s])], DifferenceList (ParseError [s]))
forall s a b. Parser s a -> (a -> Parser s b) -> Parser s b
SP.>>= (Parser s b -> [s] -> ([(b, [s])], DifferenceList (ParseError [s]))
forall s r.
Parser s r -> [s] -> ([(r, [s])], DifferenceList (ParseError [s]))
runParser (Parser s b
 -> [s] -> ([(b, [s])], DifferenceList (ParseError [s])))
-> (a -> Parser s b)
-> a
-> [s]
-> ([(b, [s])], DifferenceList (ParseError [s]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Parser s b
f))

instance MonadPlus (Parser s) where
  mzero :: forall a. Parser s a
mzero     =  Parser s a
forall a. Parser s a
forall (f :: * -> *) a. Alternative f => f a
empty
  mplus :: forall a. Parser s a -> Parser s a -> Parser s a
mplus     =  Parser s a -> Parser s a -> Parser s a
forall a. Parser s a -> Parser s a -> Parser s a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)

-- | Parses any single symbol.
anySymbol :: Parser s s
anySymbol :: forall s. Parser s s
anySymbol = ([s] -> ([(s, [s])], DifferenceList (ParseError [s])))
-> Parser s s
forall s r.
([s] -> ([(r, [s])], DifferenceList (ParseError [s])))
-> Parser s r
Parser ([s] -> ([(s, [s])], DifferenceList (ParseError [s]))
forall s. Parser s s
SP.anySymbol)

-- | Takes a predicate and returns a parser that parses a
-- single symbol satisfying that predicate.
satisfy :: (s -> Bool) -> Parser s s
satisfy :: forall s. (s -> Bool) -> Parser s s
satisfy s -> Bool
p = ([s] -> ([(s, [s])], DifferenceList (ParseError [s])))
-> Parser s s
forall s r.
([s] -> ([(r, [s])], DifferenceList (ParseError [s])))
-> Parser s r
Parser ((s -> Bool) -> [s] -> ([(s, [s])], DifferenceList (ParseError [s]))
forall s. (s -> Bool) -> Parser s s
SP.satisfy s -> Bool
p)

-- | Parser that always succeeds, i.e., for epsilon.
succeed :: a -> Parser s a
succeed :: forall a s. a -> Parser s a
succeed = a -> Parser s a
forall a. a -> Parser s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Same as 'empty'; provided for compatibility with the lecture notes.
failp :: Parser s a
failp :: forall s a. Parser s a
failp = ([s] -> ([(a, [s])], DifferenceList (ParseError [s])))
-> Parser s a
forall s r.
([s] -> ([(r, [s])], DifferenceList (ParseError [s])))
-> Parser s r
Parser [s] -> ([(a, [s])], DifferenceList (ParseError [s]))
forall s a. Parser s a
SP.failp

-- | Returns the rest of the input without consuming anything.
look :: Parser s [s]
look :: forall s. Parser s [s]
look = ([s] -> ([([s], [s])], DifferenceList (ParseError [s])))
-> Parser s [s]
forall s r.
([s] -> ([(r, [s])], DifferenceList (ParseError [s])))
-> Parser s r
Parser [s] -> ([([s], [s])], DifferenceList (ParseError [s]))
forall s. Parser s [s]
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 :: forall s a.
(ErrorsPretty s, Ord s) =>
Config -> Parser s a -> [s] -> [(a, [s])]
parseAndTrace Config
config Parser s a
p [s]
input =
  Either String (NonEmpty (a, [s])) -> [(a, [s])]
forall a s. Either String (NonEmpty (a, [s])) -> [(a, [s])]
traceErrorMessage (Either String (NonEmpty (a, [s])) -> [(a, [s])])
-> Either String (NonEmpty (a, [s])) -> [(a, [s])]
forall a b. (a -> b) -> a -> b
$
  (ParseErrorBundle [s] -> String)
-> Either (ParseErrorBundle [s]) (NonEmpty (a, [s]))
-> Either String (NonEmpty (a, [s]))
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Config -> [s] -> ParseErrorBundle [s] -> String
forall symbol.
ErrorsPretty symbol =>
Config -> [symbol] -> ParseErrorBundle [symbol] -> String
errorBundlePrettyImproved Config
config [s]
input) (Either (ParseErrorBundle [s]) (NonEmpty (a, [s]))
 -> Either String (NonEmpty (a, [s])))
-> Either (ParseErrorBundle [s]) (NonEmpty (a, [s]))
-> Either String (NonEmpty (a, [s]))
forall a b. (a -> b) -> a -> b
$
  Config
-> Parser s a
-> [s]
-> Either (ParseErrorBundle [s]) (NonEmpty (a, [s]))
forall s a.
Ord s =>
Config
-> Parser s a
-> [s]
-> Either (ParseErrorBundle [s]) (NonEmpty (a, [s]))
parseWithConfig Config
config Parser s a
p [s]
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 :: forall s a.
Ord s =>
Config
-> Parser s a
-> [s]
-> Either (ParseErrorBundle [s]) (NonEmpty (a, [s]))
parseWithConfig Config
config (Parser [s] -> ([(a, [s])], DifferenceList (ParseError [s]))
p) = Config
-> ([s] -> ([(a, [s])], DifferenceList (ParseError [s])))
-> [s]
-> Either (ParseErrorBundle [s]) (NonEmpty (a, [s]))
forall s a.
Ord s =>
Config
-> Parser s a
-> [s]
-> Either (ParseErrorBundle [s]) (NonEmpty (a, [s]))
SP.parseWithConfig Config
config [s] -> ([(a, [s])], DifferenceList (ParseError [s]))
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 :: forall s a.
(ErrorsPretty s, Ord s) =>
Parser s a -> [s] -> [(a, [s])]
parse = Config -> Parser s a -> [s] -> [(a, [s])]
forall s a.
(ErrorsPretty s, Ord s) =>
Config -> Parser s a -> [s] -> [(a, [s])]
parseAndTrace Config
defaultConfig