module Bookhound.Parser (Parser, ParseError(..), runParser, errorParser,
               andThen, exactly, isMatch, check, anyOf, allOf, char,
               withTransform, withError, withErrorN, withErrorFrom, mapError, except, nonConsumingParser) where

import           Bookhound.Utils.Foldable (findJust)
import           Control.Applicative      (liftA2)
import           Data.Either              (fromRight)
import           Data.Maybe               (fromMaybe)
import           Data.Set                 (Set)
import qualified Data.Set                 as Set
import           Data.Text                (Text, pack, uncons, unpack)

type Input = Text

data Parser a
  = P
      { forall a. Parser a -> Input -> ParseResult a
parse     :: Input -> ParseResult a
      , forall a. Parser a -> forall b. Maybe (Parser b -> Parser b)
transform :: forall b. Maybe (Parser b -> Parser b)
      , forall a. Parser a -> Set (Int, ParseError)
errors    :: Set (Int, ParseError)
      }

data ParseResult a
  = Result Input (Maybe ParseError) a
  | Error ParseError
  deriving (ParseResult a -> ParseResult a -> Bool
forall a. Eq a => ParseResult a -> ParseResult a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParseResult a -> ParseResult a -> Bool
$c/= :: forall a. Eq a => ParseResult a -> ParseResult a -> Bool
== :: ParseResult a -> ParseResult a -> Bool
$c== :: forall a. Eq a => ParseResult a -> ParseResult a -> Bool
Eq)

data ParseError
  = UnexpectedEof
  | ExpectedEof Input
  | UnexpectedChar Char
  | UnexpectedString String
  | NoMatch String
  | ErrorAt String
  deriving (ParseError -> ParseError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParseError -> ParseError -> Bool
$c/= :: ParseError -> ParseError -> Bool
== :: ParseError -> ParseError -> Bool
$c== :: ParseError -> ParseError -> Bool
Eq, Eq ParseError
ParseError -> ParseError -> Bool
ParseError -> ParseError -> Ordering
ParseError -> ParseError -> ParseError
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ParseError -> ParseError -> ParseError
$cmin :: ParseError -> ParseError -> ParseError
max :: ParseError -> ParseError -> ParseError
$cmax :: ParseError -> ParseError -> ParseError
>= :: ParseError -> ParseError -> Bool
$c>= :: ParseError -> ParseError -> Bool
> :: ParseError -> ParseError -> Bool
$c> :: ParseError -> ParseError -> Bool
<= :: ParseError -> ParseError -> Bool
$c<= :: ParseError -> ParseError -> Bool
< :: ParseError -> ParseError -> Bool
$c< :: ParseError -> ParseError -> Bool
compare :: ParseError -> ParseError -> Ordering
$ccompare :: ParseError -> ParseError -> Ordering
Ord)


instance Show a => Show (ParseResult a) where
  show :: ParseResult a -> String
show (Result Input
i Maybe ParseError
_ a
a) = String
"Pending: " forall a. Semigroup a => a -> a -> a
<> String
" >" forall a. Semigroup a => a -> a -> a
<> Input -> String
unpack Input
i forall a. Semigroup a => a -> a -> a
<> String
"< "
                                    forall a. Semigroup a => a -> a -> a
<> String
"\n\nResult: \n" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show a
a
  show (Error ParseError
err)  = forall a. Show a => a -> String
show ParseError
err

instance Show ParseError where
  show :: ParseError -> String
show ParseError
UnexpectedEof        = String
"Unexpected end of stream"
  show (ExpectedEof Input
i)      = String
"Expected end of stream, but got "
                               forall a. Semigroup a => a -> a -> a
<> String
">" forall a. Semigroup a => a -> a -> a
<> Input -> String
unpack Input
i forall a. Semigroup a => a -> a -> a
<> String
"<"
  show (UnexpectedChar Char
c)   = String
"Unexpected char: "
                               forall a. Semigroup a => a -> a -> a
<> String
"[" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Char
c forall a. Semigroup a => a -> a -> a
<> String
"]"
  show (UnexpectedString String
s) = String
"Unexpected string: "
                               forall a. Semigroup a => a -> a -> a
<> String
"[" forall a. Semigroup a => a -> a -> a
<> String
s forall a. Semigroup a => a -> a -> a
<> String
"]"
  show (NoMatch String
s)          = String
"Did not match condition: " forall a. Semigroup a => a -> a -> a
<> String
s
  show (ErrorAt String
s)          = String
"Error at " forall a. Semigroup a => a -> a -> a
<> String
s


instance Functor ParseResult where
  fmap :: forall a b. (a -> b) -> ParseResult a -> ParseResult b
fmap a -> b
f (Result Input
i Maybe ParseError
pe a
a) = forall a. Input -> Maybe ParseError -> a -> ParseResult a
Result Input
i Maybe ParseError
pe (a -> b
f a
a)
  fmap a -> b
_ (Error ParseError
pe)      = forall a. ParseError -> ParseResult a
Error ParseError
pe


instance Functor Parser where
  fmap :: forall a b. (a -> b) -> Parser a -> Parser b
fmap a -> b
f (P Input -> ParseResult a
p forall b. Maybe (Parser b -> Parser b)
t Set (Int, ParseError)
e) = forall a.
(forall b. Maybe (Parser b -> Parser b))
-> Set (Int, ParseError) -> Parser a -> Parser a
applyTransformError forall b. Maybe (Parser b -> Parser b)
t Set (Int, ParseError)
e forall a b. (a -> b) -> a -> b
$
    forall a. (Input -> ParseResult a) -> Parser a
mkParser (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Input -> ParseResult a
p)

instance Applicative Parser where
  pure :: forall a. a -> Parser a
pure a
a      = forall a. (Input -> ParseResult a) -> Parser a
mkParser (\Input
x -> forall a. Input -> Maybe ParseError -> a -> ParseResult a
Result Input
x forall a. Maybe a
Nothing a
a)
  liftA2 :: forall a b c. (a -> b -> c) -> Parser a -> Parser b -> Parser c
liftA2 a -> b -> c
f (P Input -> ParseResult a
p forall b. Maybe (Parser b -> Parser b)
t Set (Int, ParseError)
e) mb :: Parser b
mb@(P Input -> ParseResult b
_ forall b. Maybe (Parser b -> Parser b)
t' Set (Int, ParseError)
e') =
    forall a.
(forall b. [Maybe (Parser b -> Parser b)])
-> [Set (Int, ParseError)] -> Parser a -> Parser a
applyTransformsErrors [forall b. Maybe (Parser b -> Parser b)
t, forall b. Maybe (Parser b -> Parser b)
t'] [Set (Int, ParseError)
e, Set (Int, ParseError)
e'] forall a b. (a -> b) -> a -> b
$ forall a. (Input -> ParseResult a) -> Parser a
mkParser (\Input
x ->
      case Input -> ParseResult a
p Input
x of
        Result Input
i Maybe ParseError
pe a
a -> forall a.
(ParseError -> Maybe ParseError) -> ParseResult a -> ParseResult a
mapErrorResult (forall a b. a -> b -> a
const Maybe ParseError
pe) forall a b. (a -> b) -> a -> b
$
                          forall a. Parser a -> Input -> ParseResult a
parse ((a -> b -> c
f a
a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser b
mb) Input
i
        Error ParseError
pe      -> forall a. ParseError -> ParseResult a
Error ParseError
pe
    )

instance Monad Parser where
  >>= :: forall a b. Parser a -> (a -> Parser b) -> Parser b
(>>=) (P Input -> ParseResult a
p forall b. Maybe (Parser b -> Parser b)
t Set (Int, ParseError)
e) a -> Parser b
f =
    forall a.
(forall b. Maybe (Parser b -> Parser b))
-> Set (Int, ParseError) -> Parser a -> Parser a
applyTransformError forall b. Maybe (Parser b -> Parser b)
t Set (Int, ParseError)
e forall a b. (a -> b) -> a -> b
$ forall a. (Input -> ParseResult a) -> Parser a
mkParser (\Input
x ->
      case Input -> ParseResult a
p Input
x of
        Result Input
i Maybe ParseError
pe a
a -> forall a.
(ParseError -> Maybe ParseError) -> ParseResult a -> ParseResult a
mapErrorResult (forall a b. a -> b -> a
const Maybe ParseError
pe) forall a b. (a -> b) -> a -> b
$
                         forall a. Parser a -> Input -> ParseResult a
parse (a -> Parser b
f a
a) Input
i
        Error ParseError
pe      -> forall a. ParseError -> ParseResult a
Error ParseError
pe
    )

runParser :: Parser a -> Input -> Either [ParseError] a
runParser :: forall a. Parser a -> Input -> Either [ParseError] a
runParser p :: Parser a
p@(P Input -> ParseResult a
_ forall b. Maybe (Parser b -> Parser b)
_ Set (Int, ParseError)
e) Input
i = ParseResult a -> Either [ParseError] a
toEither forall a b. (a -> b) -> a -> b
$ forall a. Parser a -> Input -> ParseResult a
parse (forall a. Parser a -> Parser a
exactly Parser a
p) Input
i
  where
    toEither :: ParseResult a -> Either [ParseError] a
toEither = \case
      Result Input
_ Maybe ParseError
_ a
a -> forall a b. b -> Either a b
Right a
a
      Error ParseError
pe   -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (ParseError -> Bool
hasPriorityError)   [ParseError
pe]   forall a. Semigroup a => a -> a -> a
<>
                          (forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> [a]
reverse (forall a. Set a -> [a]
Set.toList Set (Int, ParseError)
e))   forall a. Semigroup a => a -> a -> a
<>
                          forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> Bool
hasPriorityError) [ParseError
pe]

errorParser :: ParseError -> Parser a
errorParser :: forall a. ParseError -> Parser a
errorParser = forall a. (Input -> ParseResult a) -> Parser a
mkParser forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ParseError -> ParseResult a
Error

andThen :: Parser String -> Parser a -> Parser a
andThen :: forall a. Parser String -> Parser a -> Parser a
andThen Parser String
p1 p2 :: Parser a
p2@(P Input -> ParseResult a
_ forall b. Maybe (Parser b -> Parser b)
t Set (Int, ParseError)
e) = forall a.
(forall b. Maybe (Parser b -> Parser b))
-> Set (Int, ParseError) -> Parser a -> Parser a
applyTransformError forall b. Maybe (Parser b -> Parser b)
t Set (Int, ParseError)
e forall a b. (a -> b) -> a -> b
$
  forall a.
(Input -> ParseResult a)
-> (forall b. Maybe (Parser b -> Parser b))
-> Set (Int, ParseError)
-> Parser a
P (\Input
i -> forall a. Parser a -> Input -> ParseResult a
parse Parser a
p2 forall a b. (a -> b) -> a -> b
$ forall b a. b -> Either a b -> b
fromRight Input
i forall a b. (a -> b) -> a -> b
$ String -> Input
pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parser a -> Input -> Either [ParseError] a
runParser Parser String
p1 Input
i) forall b. Maybe (Parser b -> Parser b)
t Set (Int, ParseError)
e

char :: Parser Char
char :: Parser Char
char = forall a. (Input -> ParseResult a) -> Parser a
mkParser forall a b. (a -> b) -> a -> b
$
   forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. ParseError -> ParseResult a
Error ParseError
UnexpectedEof) (\(Char
ch, Input
rest) -> forall a. Input -> Maybe ParseError -> a -> ParseResult a
Result Input
rest forall a. Maybe a
Nothing Char
ch)
   forall b c a. (b -> c) -> (a -> b) -> a -> c
. Input -> Maybe (Char, Input)
uncons


exactly :: Parser a -> Parser a
exactly :: forall a. Parser a -> Parser a
exactly (P Input -> ParseResult a
p forall b. Maybe (Parser b -> Parser b)
t Set (Int, ParseError)
e) = forall a.
(forall b. Maybe (Parser b -> Parser b))
-> Set (Int, ParseError) -> Parser a -> Parser a
applyTransformError forall b. Maybe (Parser b -> Parser b)
t Set (Int, ParseError)
e forall a b. (a -> b) -> a -> b
$
  forall a. (Input -> ParseResult a) -> Parser a
mkParser (\Input
x ->
    case Input -> ParseResult a
p Input
x of
      result :: ParseResult a
result@(Result Input
i Maybe ParseError
_ a
_) | Input
i forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty -> ParseResult a
result
      Result Input
i Maybe ParseError
_ a
_                        -> forall a. ParseError -> ParseResult a
Error forall a b. (a -> b) -> a -> b
$ Input -> ParseError
ExpectedEof Input
i
      ParseResult a
err                                 -> ParseResult a
err
    )

anyOf :: [Parser a] -> Parser a
anyOf :: forall a. [Parser a] -> Parser a
anyOf [Parser a]
ps = forall a.
[Parser a]
-> (forall b. Maybe (Parser b -> Parser b))
-> Set (Int, ParseError)
-> Parser a
anyOfHelper [Parser a]
ps forall a. Maybe a
Nothing forall a. Monoid a => a
mempty

allOf :: [Parser a] -> Parser a
allOf :: forall a. [Parser a] -> Parser a
allOf [Parser a]
ps = forall a.
[Parser a]
-> (forall b. Maybe (Parser b -> Parser b))
-> Set (Int, ParseError)
-> Parser a
allOfHelper [Parser a]
ps forall a. Maybe a
Nothing forall a. Monoid a => a
mempty


anyOfHelper :: [Parser a]
            -> (forall b. Maybe (Parser b -> Parser b))
            -> Set (Int, ParseError)
            -> Parser a
anyOfHelper :: forall a.
[Parser a]
-> (forall b. Maybe (Parser b -> Parser b))
-> Set (Int, ParseError)
-> Parser a
anyOfHelper [] forall b. Maybe (Parser b -> Parser b)
_ Set (Int, ParseError)
_  = forall a. ParseError -> Parser a
errorParser forall a b. (a -> b) -> a -> b
$ String -> ParseError
NoMatch String
"anyOf"
anyOfHelper [Parser a
p] forall b. Maybe (Parser b -> Parser b)
_ Set (Int, ParseError)
_ = Parser a
p
anyOfHelper ((P Input -> ParseResult a
p forall b. Maybe (Parser b -> Parser b)
t Set (Int, ParseError)
e) : [Parser a]
rest) forall b. Maybe (Parser b -> Parser b)
t' Set (Int, ParseError)
e' =
  forall a.
(forall b. [Maybe (Parser b -> Parser b)])
-> [Set (Int, ParseError)] -> Parser a -> Parser a
applyTransformsErrors [forall b. Maybe (Parser b -> Parser b)
t, forall b. Maybe (Parser b -> Parser b)
t'] [Set (Int, ParseError)
e, Set (Int, ParseError)
e'] forall a b. (a -> b) -> a -> b
$
    forall a. (Input -> ParseResult a) -> Parser a
mkParser (\Input
x ->
      case Input -> ParseResult a
p Input
x of
        Error ParseError
pe -> forall a.
(ParseError -> Maybe ParseError) -> ParseResult a -> ParseResult a
mapErrorResult (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ ParseError -> Maybe ParseError
wrapMaybeError ParseError
pe) forall a b. (a -> b) -> a -> b
$
                     forall a. Parser a -> Input -> ParseResult a
parse (forall a.
[Parser a]
-> (forall b. Maybe (Parser b -> Parser b))
-> Set (Int, ParseError)
-> Parser a
anyOfHelper [Parser a]
rest forall b. Maybe (Parser b -> Parser b)
t Set (Int, ParseError)
e) Input
x
        ParseResult a
result   -> ParseResult a
result
      )


allOfHelper :: [Parser a]
            -> (forall b. Maybe (Parser b -> Parser b))
            -> Set (Int, ParseError)
            -> Parser a
allOfHelper :: forall a.
[Parser a]
-> (forall b. Maybe (Parser b -> Parser b))
-> Set (Int, ParseError)
-> Parser a
allOfHelper [] forall b. Maybe (Parser b -> Parser b)
_ Set (Int, ParseError)
_ = forall a. ParseError -> Parser a
errorParser forall a b. (a -> b) -> a -> b
$ String -> ParseError
NoMatch String
"allOf"
allOfHelper [Parser a
p] forall b. Maybe (Parser b -> Parser b)
_ Set (Int, ParseError)
_ = Parser a
p
allOfHelper ((P Input -> ParseResult a
p forall b. Maybe (Parser b -> Parser b)
t Set (Int, ParseError)
e) : [Parser a]
rest) forall b. Maybe (Parser b -> Parser b)
t' Set (Int, ParseError)
e' =
  forall a.
(forall b. [Maybe (Parser b -> Parser b)])
-> [Set (Int, ParseError)] -> Parser a -> Parser a
applyTransformsErrors [forall b. Maybe (Parser b -> Parser b)
t, forall b. Maybe (Parser b -> Parser b)
t'] [Set (Int, ParseError)
e, Set (Int, ParseError)
e'] forall a b. (a -> b) -> a -> b
$
    forall a. (Input -> ParseResult a) -> Parser a
mkParser (\Input
x ->
      case Input -> ParseResult a
p Input
x of
        Result Input
_ Maybe ParseError
pe a
_ -> forall a.
(ParseError -> Maybe ParseError) -> ParseResult a -> ParseResult a
mapErrorResult (forall a b. a -> b -> a
const Maybe ParseError
pe) forall a b. (a -> b) -> a -> b
$
                          forall a. Parser a -> Input -> ParseResult a
parse (forall a.
[Parser a]
-> (forall b. Maybe (Parser b -> Parser b))
-> Set (Int, ParseError)
-> Parser a
allOfHelper [Parser a]
rest forall b. Maybe (Parser b -> Parser b)
t Set (Int, ParseError)
e) Input
x
        ParseResult a
err          -> ParseResult a
err
      )


isMatch :: (Char -> Char -> Bool) -> Parser Char -> Char -> Parser Char
isMatch :: (Char -> Char -> Bool) -> Parser Char -> Char -> Parser Char
isMatch Char -> Char -> Bool
cond Parser Char
parser Char
c1 =
  do Char
c2 <- Parser Char
parser
     if Char -> Char -> Bool
cond Char
c1 Char
c2
       then forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
c2
       else forall a. ParseError -> Parser a
errorParser forall a b. (a -> b) -> a -> b
$ Char -> ParseError
UnexpectedChar Char
c2

check :: String -> (a -> Bool) -> Parser a -> Parser a
check :: forall a. String -> (a -> Bool) -> Parser a -> Parser a
check String
condName a -> Bool
cond Parser a
parser =
  do a
c2 <- Parser a
parser
     if a -> Bool
cond a
c2
       then forall (f :: * -> *) a. Applicative f => a -> f a
pure a
c2
       else forall a. ParseError -> Parser a
errorParser forall a b. (a -> b) -> a -> b
$ String -> ParseError
NoMatch String
condName


except :: Parser a -> Parser a -> Parser a
except :: forall a. Parser a -> Parser a -> Parser a
except (P Input -> ParseResult a
p forall b. Maybe (Parser b -> Parser b)
t Set (Int, ParseError)
e) (P Input -> ParseResult a
p' forall b. Maybe (Parser b -> Parser b)
_ Set (Int, ParseError)
_) = forall a.
(forall b. Maybe (Parser b -> Parser b))
-> Set (Int, ParseError) -> Parser a -> Parser a
applyTransformError forall b. Maybe (Parser b -> Parser b)
t Set (Int, ParseError)
e forall a b. (a -> b) -> a -> b
$ forall a. (Input -> ParseResult a) -> Parser a
mkParser (
  \Input
x -> case Input -> ParseResult a
p' Input
x of
    Result Input
_ Maybe ParseError
_ a
_ -> forall a. ParseError -> ParseResult a
Error forall a b. (a -> b) -> a -> b
$ String -> ParseError
NoMatch String
"except"
    Error ParseError
_      -> Input -> ParseResult a
p Input
x
  )

withError :: String -> Parser a -> Parser a
withError :: forall a. String -> Parser a -> Parser a
withError = forall a. Int -> String -> Parser a -> Parser a
withErrorN Int
0

withErrorN :: Int -> String -> Parser a -> Parser a
withErrorN :: forall a. Int -> String -> Parser a -> Parser a
withErrorN Int
n String
str = forall a. Set (Int, ParseError) -> Parser a -> Parser a
applyError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Set a
Set.singleton forall a b. (a -> b) -> a -> b
$ (Int
n, String -> ParseError
ErrorAt String
str)

withErrorFrom :: (a -> String) -> Parser a -> Parser b -> Parser b
withErrorFrom :: forall a b. (a -> String) -> Parser a -> Parser b -> Parser b
withErrorFrom a -> String
errFn Parser a
pDoc Parser b
p =
  do a
value <- forall a. Parser a -> Parser a
nonConsumingParser Parser a
pDoc
     forall a. (ParseError -> Maybe ParseError) -> Parser a -> Parser a
mapError (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ String -> ParseError
ErrorAt forall a b. (a -> b) -> a -> b
$ a -> String
errFn a
value) Parser b
p

mapError :: (ParseError -> Maybe ParseError) -> Parser a -> Parser a
mapError :: forall a. (ParseError -> Maybe ParseError) -> Parser a -> Parser a
mapError ParseError -> Maybe ParseError
f (P Input -> ParseResult a
p forall b. Maybe (Parser b -> Parser b)
t Set (Int, ParseError)
e) = forall a.
(forall b. Maybe (Parser b -> Parser b))
-> Set (Int, ParseError) -> Parser a -> Parser a
applyTransformError forall b. Maybe (Parser b -> Parser b)
t Set (Int, ParseError)
e forall a b. (a -> b) -> a -> b
$
  forall a. (Input -> ParseResult a) -> Parser a
mkParser forall a b. (a -> b) -> a -> b
$ forall a.
(ParseError -> Maybe ParseError) -> ParseResult a -> ParseResult a
mapErrorResult ParseError -> Maybe ParseError
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Input -> ParseResult a
p



withTransform :: (forall b. Parser b -> Parser b) -> Parser a -> Parser a
withTransform :: forall a. (forall a. Parser a -> Parser a) -> Parser a -> Parser a
withTransform forall a. Parser a -> Parser a
t = forall a.
(forall b. Maybe (Parser b -> Parser b)) -> Parser a -> Parser a
applyTransform forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a. Parser a -> Parser a
t



applyTransformsErrors :: (forall b. [Maybe (Parser b -> Parser b)])
                      -> [Set (Int, ParseError)]
                      -> Parser a
                      -> Parser a
applyTransformsErrors :: forall a.
(forall b. [Maybe (Parser b -> Parser b)])
-> [Set (Int, ParseError)] -> Parser a -> Parser a
applyTransformsErrors forall b. [Maybe (Parser b -> Parser b)]
ts [Set (Int, ParseError)]
es =
  forall a.
(forall b. Maybe (Parser b -> Parser b))
-> Set (Int, ParseError) -> Parser a -> Parser a
applyTransformError (forall (t :: * -> *) a. Foldable t => t (Maybe a) -> Maybe a
findJust forall b. [Maybe (Parser b -> Parser b)]
ts) (forall a. Monoid a => [a] -> a
mconcat [Set (Int, ParseError)]
es)


applyTransformError :: (forall b. Maybe (Parser b -> Parser b))
                    -> Set (Int, ParseError)
                    -> Parser a
                    -> Parser a
applyTransformError :: forall a.
(forall b. Maybe (Parser b -> Parser b))
-> Set (Int, ParseError) -> Parser a -> Parser a
applyTransformError forall b. Maybe (Parser b -> Parser b)
t Set (Int, ParseError)
e = forall a.
(forall b. Maybe (Parser b -> Parser b)) -> Parser a -> Parser a
applyTransform forall b. Maybe (Parser b -> Parser b)
t forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set (Int, ParseError) -> Parser a -> Parser a
applyError Set (Int, ParseError)
e



nonConsumingParser :: Parser a -> Parser a
nonConsumingParser :: forall a. Parser a -> Parser a
nonConsumingParser (P Input -> ParseResult a
p forall b. Maybe (Parser b -> Parser b)
t Set (Int, ParseError)
e) = forall a.
(forall b. Maybe (Parser b -> Parser b))
-> Set (Int, ParseError) -> Parser a -> Parser a
applyTransformError forall b. Maybe (Parser b -> Parser b)
t Set (Int, ParseError)
e forall a b. (a -> b) -> a -> b
$ forall a. (Input -> ParseResult a) -> Parser a
mkParser (
  \Input
x -> case Input -> ParseResult a
p Input
x of
    Result Input
_ Maybe ParseError
pe a
a -> forall a. Input -> Maybe ParseError -> a -> ParseResult a
Result Input
x Maybe ParseError
pe a
a
    ParseResult a
err           -> ParseResult a
err
  )

mapErrorResult :: (ParseError -> Maybe ParseError) -> ParseResult a -> ParseResult a
mapErrorResult :: forall a.
(ParseError -> Maybe ParseError) -> ParseResult a -> ParseResult a
mapErrorResult ParseError -> Maybe ParseError
f (Error ParseError
pe) = forall a. ParseError -> ParseResult a
Error forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe ParseError
pe forall a b. (a -> b) -> a -> b
$ ParseError -> Maybe ParseError
f ParseError
pe
mapErrorResult ParseError -> Maybe ParseError
_  ParseResult a
result    = ParseResult a
result


wrapMaybeError :: ParseError -> Maybe ParseError
wrapMaybeError :: ParseError -> Maybe ParseError
wrapMaybeError ParseError
pe | ParseError -> Bool
hasPriorityError ParseError
pe = forall (f :: * -> *) a. Applicative f => a -> f a
pure ParseError
pe
                  | Bool
otherwise = forall a. Maybe a
Nothing

hasPriorityError :: ParseError -> Bool
hasPriorityError :: ParseError -> Bool
hasPriorityError (ErrorAt String
_) = Bool
True
hasPriorityError ParseError
_           = Bool
False

applyTransform :: (forall b. Maybe (Parser b -> Parser b)) -> Parser a -> Parser a
applyTransform :: forall a.
(forall b. Maybe (Parser b -> Parser b)) -> Parser a -> Parser a
applyTransform forall b. Maybe (Parser b -> Parser b)
f Parser a
p =  forall b a. b -> (a -> b) -> Maybe a -> b
maybe Parser a
p (\Parser a -> Parser a
f' -> (Parser a -> Parser a
f' Parser a
p) {$sel:transform:P :: forall b. Maybe (Parser b -> Parser b)
transform = forall b. Maybe (Parser b -> Parser b)
f}) forall b. Maybe (Parser b -> Parser b)
f

applyError :: Set (Int, ParseError) -> Parser a -> Parser a
applyError :: forall a. Set (Int, ParseError) -> Parser a -> Parser a
applyError Set (Int, ParseError)
e p :: Parser a
p@(P Input -> ParseResult a
_ forall b. Maybe (Parser b -> Parser b)
_ Set (Int, ParseError)
e') = Parser a
p {$sel:errors:P :: Set (Int, ParseError)
errors = Set (Int, ParseError)
e forall a. Semigroup a => a -> a -> a
<> Set (Int, ParseError)
e'}

mkParser :: (Input -> ParseResult a) -> Parser a
mkParser :: forall a. (Input -> ParseResult a) -> Parser a
mkParser Input -> ParseResult a
p = P {$sel:parse:P :: Input -> ParseResult a
parse = Input -> ParseResult a
p, $sel:transform:P :: forall b. Maybe (Parser b -> Parser b)
transform = forall a. Maybe a
Nothing, $sel:errors:P :: Set (Int, ParseError)
errors = forall a. Set a
Set.empty}