{-# LANGUAGE CPP #-}
-- | Packrat parsing: Simple, Powerful, Lazy, Linear time by Bryan
-- Ford.  This module achieves monadic parsing library similar to
-- Parsec.
module Text.Packrat.Parse where

import Prelude hiding (exp, rem)

import Data.Char
import Data.List

import Text.Packrat.Pos

import Control.Monad
import           Control.Applicative (Applicative(..))
import qualified Control.Applicative as A

import qualified Control.Monad.Fail as Fail

-- Data types

data Message = Expected String
             | Message String

data ParseError = ParseError { ParseError -> Pos
errorPos      :: Pos
                             , ParseError -> [Message]
errorMessages :: [Message] }

data Result d v = Parsed v d ParseError
                | NoParse ParseError

newtype Parser d v = Parser (d -> Result d v)


class Derivs d where
    dvPos   :: d -> Pos
    dvChar  :: d -> Result d Char


-- Basic Combinators

infixl 2 <|>
infixl 1 <?>
infixl 1 <?!>

instance Derivs d => Functor (Parser d) where
    a -> b
f fmap :: forall a b. (a -> b) -> Parser d a -> Parser d b
`fmap` (Parser d -> Result d a
p1) = forall d v. (d -> Result d v) -> Parser d v
Parser forall a b. (a -> b) -> a -> b
$ forall {d}. Result d a -> Result d b
parse forall b c a. (b -> c) -> (a -> b) -> a -> c
. d -> Result d a
p1
        where parse :: Result d a -> Result d b
parse (Parsed a
val d
rem ParseError
err) =
                  let val2 :: b
val2 = a -> b
f a
val
                  in  forall d v. v -> d -> ParseError -> Result d v
Parsed b
val2 d
rem ParseError
err
              parse (NoParse ParseError
err) = forall d v. ParseError -> Result d v
NoParse ParseError
err

instance Derivs d => Applicative (Parser d) where
    pure :: forall a. a -> Parser d a
pure a
x = forall d v. (d -> Result d v) -> Parser d v
Parser (\d
dvs -> forall d v. v -> d -> ParseError -> Result d v
Parsed a
x d
dvs (forall d. Derivs d => d -> ParseError
nullError d
dvs))
    <*> :: forall a b. Parser d (a -> b) -> Parser d a -> Parser d b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Derivs d => Monad (Parser d) where
    (Parser d -> Result d a
p1) >>= :: forall a b. Parser d a -> (a -> Parser d b) -> Parser d b
>>= a -> Parser d b
f = forall d v. (d -> Result d v) -> Parser d v
Parser d -> Result d b
parse
        where parse :: d -> Result d b
parse d
dvs = Result d a -> Result d b
first (d -> Result d a
p1 d
dvs)
              first :: Result d a -> Result d b
first (Parsed a
val d
rem ParseError
err) =
                  let Parser d -> Result d b
p2 = a -> Parser d b
f a
val
                  in forall {d} {v}. ParseError -> Result d v -> Result d v
second ParseError
err (d -> Result d b
p2 d
rem)
              first (NoParse ParseError
err) = forall d v. ParseError -> Result d v
NoParse ParseError
err
              second :: ParseError -> Result d v -> Result d v
second ParseError
err1 (Parsed v
val d
rem ParseError
err) =
                  forall d v. v -> d -> ParseError -> Result d v
Parsed v
val d
rem (ParseError -> ParseError -> ParseError
joinErrors ParseError
err1 ParseError
err)
              second ParseError
err1 (NoParse ParseError
err) =
                  forall d v. ParseError -> Result d v
NoParse (ParseError -> ParseError -> ParseError
joinErrors ParseError
err1 ParseError
err)
    return :: forall a. a -> Parser d a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure

#if !(MIN_VERSION_base(4,13,0))
    fail = Fail.fail
#endif

instance Derivs d => Fail.MonadFail (Parser d) where
    fail :: forall a. String -> Parser d a
fail String
msg = forall d v. (d -> Result d v) -> Parser d v
Parser (\d
dvs -> forall d v. ParseError -> Result d v
NoParse (Pos -> String -> ParseError
msgError (forall d. Derivs d => d -> Pos
dvPos d
dvs) String
msg))

instance Derivs d => A.Alternative (Parser d) where
    empty :: forall a. Parser d a
empty = forall d v. (d -> Result d v) -> Parser d v
Parser forall a b. (a -> b) -> a -> b
$ forall d v. ParseError -> Result d v
NoParse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall d. Derivs d => d -> ParseError
nullError
    <|> :: forall a. Parser d a -> Parser d a -> Parser d a
(<|>) = forall d v. Derivs d => Parser d v -> Parser d v -> Parser d v
(<|>)

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

(<|>) :: Derivs d => Parser d v -> Parser d v -> Parser d v
(Parser d -> Result d v
p1) <|> :: forall d v. Derivs d => Parser d v -> Parser d v -> Parser d v
<|> (Parser d -> Result d v
p2) = forall d v. (d -> Result d v) -> Parser d v
Parser d -> Result d v
parse
    where parse :: d -> Result d v
parse d
dvs = d -> Result d v -> Result d v
first d
dvs (d -> Result d v
p1 d
dvs)
          first :: d -> Result d v -> Result d v
first d
_ (result :: Result d v
result@(Parsed {})) = Result d v
result
          first d
dvs (NoParse ParseError
err) = forall {d} {v}. ParseError -> Result d v -> Result d v
second ParseError
err (d -> Result d v
p2 d
dvs)
          second :: ParseError -> Result d v -> Result d v
second ParseError
err1 (Parsed v
val d
rem ParseError
err) =
              forall d v. v -> d -> ParseError -> Result d v
Parsed v
val d
rem (ParseError -> ParseError -> ParseError
joinErrors ParseError
err1 ParseError
err)
          second ParseError
err1 (NoParse ParseError
err) =
              forall d v. ParseError -> Result d v
NoParse (ParseError -> ParseError -> ParseError
joinErrors ParseError
err1 ParseError
err)

satisfy :: Derivs d => Parser d v -> (v -> Bool) -> Parser d v
satisfy :: forall d v. Derivs d => Parser d v -> (v -> Bool) -> Parser d v
satisfy (Parser d -> Result d v
p) v -> Bool
test = forall d v. (d -> Result d v) -> Parser d v
Parser d -> Result d v
parse
    where parse :: d -> Result d v
parse d
dvs = forall {d} {d}. Derivs d => d -> Result d v -> Result d v
check d
dvs (d -> Result d v
p d
dvs)
          check :: d -> Result d v -> Result d v
check d
dvs (result :: Result d v
result@(Parsed v
val d
_ ParseError
_)) =
              if v -> Bool
test v
val
              then Result d v
result
              else forall d v. ParseError -> Result d v
NoParse (forall d. Derivs d => d -> ParseError
nullError d
dvs)
          check d
_ Result d v
none = Result d v
none

notFollowedBy :: (Derivs d, Show v) => Parser d v -> Parser d ()
notFollowedBy :: forall d v. (Derivs d, Show v) => Parser d v -> Parser d ()
notFollowedBy (Parser d -> Result d v
p) = forall d v. (d -> Result d v) -> Parser d v
Parser d -> Result d ()
parse
    where parse :: d -> Result d ()
parse d
dvs = case d -> Result d v
p d
dvs of
                        Parsed v
val d
_ ParseError
_ ->
                            forall d v. ParseError -> Result d v
NoParse (Pos -> String -> ParseError
msgError (forall d. Derivs d => d -> Pos
dvPos d
dvs)
                                     (String
"unexpected " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show v
val))
                        NoParse ParseError
_ -> forall d v. v -> d -> ParseError -> Result d v
Parsed () d
dvs (forall d. Derivs d => d -> ParseError
nullError d
dvs)

optional :: Derivs d => Parser d v -> Parser d (Maybe v)
optional :: forall d v. Derivs d => Parser d v -> Parser d (Maybe v)
optional Parser d v
p = (do v
v <- Parser d v
p; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just v
v)) forall d v. Derivs d => Parser d v -> Parser d v -> Parser d v
<|> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

option :: Derivs d => v -> Parser d v -> Parser d v
option :: forall d v. Derivs d => v -> Parser d v -> Parser d v
option v
v Parser d v
p = Parser d v
p forall d v. Derivs d => Parser d v -> Parser d v -> Parser d v
<|> forall (m :: * -> *) a. Monad m => a -> m a
return v
v

many :: Derivs d => Parser d v -> Parser d [v]
many :: forall d v. Derivs d => Parser d v -> Parser d [v]
many Parser d v
p = (do { v
v <- Parser d v
p; [v]
vs <- forall d v. Derivs d => Parser d v -> Parser d [v]
many Parser d v
p; forall (m :: * -> *) a. Monad m => a -> m a
return (v
v forall a. a -> [a] -> [a]
: [v]
vs) } )
     forall d v. Derivs d => Parser d v -> Parser d v -> Parser d v
<|> forall (m :: * -> *) a. Monad m => a -> m a
return []

many1 :: Derivs d => Parser d v -> Parser d [v]
many1 :: forall d v. Derivs d => Parser d v -> Parser d [v]
many1 Parser d v
p = do { v
v <- Parser d v
p; [v]
vs <- forall d v. Derivs d => Parser d v -> Parser d [v]
many Parser d v
p; forall (m :: * -> *) a. Monad m => a -> m a
return (v
v forall a. a -> [a] -> [a]
: [v]
vs) }

count :: Derivs d => Int -> Parser d v -> Parser d [v]
count :: forall d v. Derivs d => Int -> Parser d v -> Parser d [v]
count = forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM

sepBy1 :: Derivs d => Parser d v -> Parser d vsep -> Parser d [v]
sepBy1 :: forall d v vsep.
Derivs d =>
Parser d v -> Parser d vsep -> Parser d [v]
sepBy1 Parser d v
p Parser d vsep
psep = do v
v <- Parser d v
p
                   [v]
vs <- forall d v. Derivs d => Parser d v -> Parser d [v]
many (do { Parser d vsep
psep; Parser d v
p })
                   forall (m :: * -> *) a. Monad m => a -> m a
return (v
v forall a. a -> [a] -> [a]
: [v]
vs)

sepBy :: Derivs d => Parser d v -> Parser d vsep -> Parser d [v]
sepBy :: forall d v vsep.
Derivs d =>
Parser d v -> Parser d vsep -> Parser d [v]
sepBy Parser d v
p Parser d vsep
psep = forall d v vsep.
Derivs d =>
Parser d v -> Parser d vsep -> Parser d [v]
sepBy1 Parser d v
p Parser d vsep
psep forall d v. Derivs d => Parser d v -> Parser d v -> Parser d v
<|> forall (m :: * -> *) a. Monad m => a -> m a
return []

endBy :: Derivs d => Parser d v -> Parser d vend -> Parser d [v]
endBy :: forall d v vsep.
Derivs d =>
Parser d v -> Parser d vsep -> Parser d [v]
endBy Parser d v
p Parser d vend
pend = forall d v. Derivs d => Parser d v -> Parser d [v]
many (do { v
v <- Parser d v
p; Parser d vend
pend; forall (m :: * -> *) a. Monad m => a -> m a
return v
v })

endBy1 :: Derivs d => Parser d v -> Parser d vend -> Parser d [v]
endBy1 :: forall d v vsep.
Derivs d =>
Parser d v -> Parser d vsep -> Parser d [v]
endBy1 Parser d v
p Parser d vend
pend = forall d v. Derivs d => Parser d v -> Parser d [v]
many1 (do { v
v <- Parser d v
p; Parser d vend
pend; forall (m :: * -> *) a. Monad m => a -> m a
return v
v })

sepEndBy1 :: Derivs d => Parser d v -> Parser d vsep -> Parser d [v]
sepEndBy1 :: forall d v vsep.
Derivs d =>
Parser d v -> Parser d vsep -> Parser d [v]
sepEndBy1 Parser d v
p Parser d vsep
psep = do [v]
v <- forall d v vsep.
Derivs d =>
Parser d v -> Parser d vsep -> Parser d [v]
sepBy1 Parser d v
p Parser d vsep
psep; forall d v. Derivs d => Parser d v -> Parser d (Maybe v)
optional Parser d vsep
psep; forall (m :: * -> *) a. Monad m => a -> m a
return [v]
v

sepEndBy :: Derivs d => Parser d v -> Parser d vsep -> Parser d [v]
sepEndBy :: forall d v vsep.
Derivs d =>
Parser d v -> Parser d vsep -> Parser d [v]
sepEndBy Parser d v
p Parser d vsep
psep = do [v]
v <- forall d v vsep.
Derivs d =>
Parser d v -> Parser d vsep -> Parser d [v]
sepBy Parser d v
p Parser d vsep
psep; forall d v. Derivs d => Parser d v -> Parser d (Maybe v)
optional Parser d vsep
psep; forall (m :: * -> *) a. Monad m => a -> m a
return [v]
v

chainl1 :: Derivs d => Parser d v -> Parser d (v->v->v) -> Parser d v
chainl1 :: forall d v.
Derivs d =>
Parser d v -> Parser d (v -> v -> v) -> Parser d v
chainl1 Parser d v
p Parser d (v -> v -> v)
psep = let psuffix :: v -> Parser d v
psuffix v
z = (do v -> v -> v
f <- Parser d (v -> v -> v)
psep
                                     v
v <- Parser d v
p
                                     v -> Parser d v
psuffix (v -> v -> v
f v
z v
v))
                             forall d v. Derivs d => Parser d v -> Parser d v -> Parser d v
<|> forall (m :: * -> *) a. Monad m => a -> m a
return v
z
                 in do v
v <- Parser d v
p
                       v -> Parser d v
psuffix v
v

chainl :: Derivs d => Parser d v -> Parser d (v->v->v) -> v -> Parser d v
chainl :: forall d v.
Derivs d =>
Parser d v -> Parser d (v -> v -> v) -> v -> Parser d v
chainl Parser d v
p Parser d (v -> v -> v)
psep v
z = forall d v.
Derivs d =>
Parser d v -> Parser d (v -> v -> v) -> Parser d v
chainl1 Parser d v
p Parser d (v -> v -> v)
psep forall d v. Derivs d => Parser d v -> Parser d v -> Parser d v
<|> forall (m :: * -> *) a. Monad m => a -> m a
return v
z

chainr1 :: Derivs d => Parser d v -> Parser d (v->v->v) -> Parser d v
chainr1 :: forall d v.
Derivs d =>
Parser d v -> Parser d (v -> v -> v) -> Parser d v
chainr1 Parser d v
p Parser d (v -> v -> v)
psep = (do v
v <- Parser d v
p
                     v -> v -> v
f <- Parser d (v -> v -> v)
psep
                     v
w <- forall d v.
Derivs d =>
Parser d v -> Parser d (v -> v -> v) -> Parser d v
chainr1 Parser d v
p Parser d (v -> v -> v)
psep
                     forall (m :: * -> *) a. Monad m => a -> m a
return (v -> v -> v
f v
v v
w))
                 forall d v. Derivs d => Parser d v -> Parser d v -> Parser d v
<|> Parser d v
p

chainr :: Derivs d => Parser d v -> Parser d (v->v->v) -> v -> Parser d v
chainr :: forall d v.
Derivs d =>
Parser d v -> Parser d (v -> v -> v) -> v -> Parser d v
chainr Parser d v
p Parser d (v -> v -> v)
psep v
z = forall d v.
Derivs d =>
Parser d v -> Parser d (v -> v -> v) -> Parser d v
chainr1 Parser d v
p Parser d (v -> v -> v)
psep forall d v. Derivs d => Parser d v -> Parser d v -> Parser d v
<|> forall (m :: * -> *) a. Monad m => a -> m a
return v
z

choice :: Derivs d => [Parser d v] -> Parser d v
choice :: forall d v. Derivs d => [Parser d v] -> Parser d v
choice [] = forall a. HasCallStack => String -> a
error String
"choice requires non-empty list"
choice [Parser d v
p] = Parser d v
p
choice (Parser d v
p:[Parser d v]
ps) = Parser d v
p forall d v. Derivs d => Parser d v -> Parser d v -> Parser d v
<|> forall d v. Derivs d => [Parser d v] -> Parser d v
choice [Parser d v]
ps


manyTill :: Derivs d => Parser d v -> Parser d vend -> Parser d [v]
manyTill :: forall d v vsep.
Derivs d =>
Parser d v -> Parser d vsep -> Parser d [v]
manyTill Parser d v
p Parser d vend
pend = (Parser d vend
pend forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return [])
              forall d v. Derivs d => Parser d v -> Parser d v -> Parser d v
<|> do v
tok <- Parser d v
p
                     [v]
rest <- forall d v vsep.
Derivs d =>
Parser d v -> Parser d vsep -> Parser d [v]
manyTill Parser d v
p Parser d vend
pend
                     forall (m :: * -> *) a. Monad m => a -> m a
return (v
tokforall a. a -> [a] -> [a]
:[v]
rest)

between :: Derivs d => Parser d vs -> Parser d ve -> Parser d v -> Parser d v
between :: forall d vs ve v.
Derivs d =>
Parser d vs -> Parser d ve -> Parser d v -> Parser d v
between Parser d vs
s Parser d ve
e Parser d v
main = do Parser d vs
s
                      v
v <- Parser d v
main
                      Parser d ve
e
                      forall (m :: * -> *) a. Monad m => a -> m a
return v
v

-- Error handling
instance Eq Message where
    Expected String
e1 == :: Message -> Message -> Bool
== Expected String
e2  = String
e1 forall a. Eq a => a -> a -> Bool
== String
e2
    Message String
m1 == Message String
m2    = String
m1 forall a. Eq a => a -> a -> Bool
== String
m2
    Message
_ == Message
_                      = Bool
False

failAt :: Derivs d => Pos -> String -> Parser d v
failAt :: forall d v. Derivs d => Pos -> String -> Parser d v
failAt Pos
pos String
msg = forall d v. (d -> Result d v) -> Parser d v
Parser (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall d v. ParseError -> Result d v
NoParse (Pos -> String -> ParseError
msgError Pos
pos String
msg))

-- Annotate a parser with a description of the construct to be parsed.
-- The resulting parser yields an "expected" error message
-- if the construct cannot be parsed
-- and if no error information is already available
-- indicating a position farther right in the source code
-- (which would normally be more localized/detailed information).
(<?>) :: Derivs d => Parser d v -> String -> Parser d v
(Parser d -> Result d v
p) <?> :: forall d v. Derivs d => Parser d v -> String -> Parser d v
<?> String
desc = forall d v. (d -> Result d v) -> Parser d v
Parser (\d
dvs -> forall {d} {d} {v}. Derivs d => d -> Result d v -> Result d v
munge d
dvs (d -> Result d v
p d
dvs))
    where munge :: d -> Result d v -> Result d v
munge d
dvs (Parsed v
v d
rem ParseError
err) =
              forall d v. v -> d -> ParseError -> Result d v
Parsed v
v d
rem (forall {d}. Derivs d => d -> ParseError -> ParseError
fix d
dvs ParseError
err)
          munge d
dvs (NoParse ParseError
err) =
              forall d v. ParseError -> Result d v
NoParse (forall {d}. Derivs d => d -> ParseError -> ParseError
fix d
dvs ParseError
err)
          fix :: d -> ParseError -> ParseError
fix d
dvs (err :: ParseError
err@(ParseError Pos
ep [Message]
_)) =
              if Pos
ep forall a. Ord a => a -> a -> Bool
> forall d. Derivs d => d -> Pos
dvPos d
dvs
              then ParseError
err
              else Pos -> String -> ParseError
expError (forall d. Derivs d => d -> Pos
dvPos d
dvs) String
desc

-- Stronger version of the <?> error annotation operator above,
-- which unconditionally overrides any existing error information.
(<?!>) :: Derivs d => Parser d v -> String -> Parser d v
(Parser d -> Result d v
p) <?!> :: forall d v. Derivs d => Parser d v -> String -> Parser d v
<?!> String
desc = forall d v. (d -> Result d v) -> Parser d v
Parser (\d
dvs -> forall {d} {d} {v}. Derivs d => d -> Result d v -> Result d v
munge d
dvs (d -> Result d v
p d
dvs))
    where munge :: d -> Result d v -> Result d v
munge d
dvs (Parsed v
v d
rem ParseError
err) =
              forall d v. v -> d -> ParseError -> Result d v
Parsed v
v d
rem (forall {d}. Derivs d => d -> ParseError -> ParseError
fix d
dvs ParseError
err)
          munge d
dvs (NoParse ParseError
err) =
              forall d v. ParseError -> Result d v
NoParse (forall {d}. Derivs d => d -> ParseError -> ParseError
fix d
dvs ParseError
err)
          fix :: d -> ParseError -> ParseError
fix d
dvs (ParseError Pos
_ [Message]
_) =
              Pos -> String -> ParseError
expError (forall d. Derivs d => d -> Pos
dvPos d
dvs) String
desc

-- Potentially join two sets of ParseErrors,
-- but only if the position didn't change from the first to the second.
-- If it did, just return the "new" (second) set of errors.
joinErrors :: ParseError -> ParseError -> ParseError
joinErrors :: ParseError -> ParseError -> ParseError
joinErrors (e :: ParseError
e@(ParseError Pos
p [Message]
m)) (e' :: ParseError
e'@(ParseError Pos
p' [Message]
m'))
    | Pos
p' forall a. Ord a => a -> a -> Bool
> Pos
p Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Message]
m  = ParseError
e'
    | Pos
p forall a. Ord a => a -> a -> Bool
> Pos
p' Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Message]
m' = ParseError
e
    | Bool
otherwise         = Pos -> [Message] -> ParseError
ParseError Pos
p ([Message]
m forall a. Eq a => [a] -> [a] -> [a]
`union` [Message]
m')

nullError :: Derivs d => d -> ParseError
nullError :: forall d. Derivs d => d -> ParseError
nullError d
dvs = Pos -> [Message] -> ParseError
ParseError (forall d. Derivs d => d -> Pos
dvPos d
dvs) []

expError :: Pos -> String -> ParseError
expError :: Pos -> String -> ParseError
expError Pos
pos String
desc = Pos -> [Message] -> ParseError
ParseError Pos
pos [String -> Message
Expected String
desc]

msgError :: Pos -> String -> ParseError
msgError :: Pos -> String -> ParseError
msgError Pos
pos String
msg = Pos -> [Message] -> ParseError
ParseError Pos
pos [String -> Message
Message String
msg]

eofError :: Derivs d => d -> ParseError
eofError :: forall d. Derivs d => d -> ParseError
eofError d
dvs = Pos -> String -> ParseError
msgError (forall d. Derivs d => d -> Pos
dvPos d
dvs) String
"end of input"

expected :: Derivs d => String -> Parser d v
expected :: forall d v. Derivs d => String -> Parser d v
expected String
desc = forall d v. (d -> Result d v) -> Parser d v
Parser (\d
dvs -> forall d v. ParseError -> Result d v
NoParse (Pos -> String -> ParseError
expError (forall d. Derivs d => d -> Pos
dvPos d
dvs) String
desc))

unexpected :: Derivs d => String -> Parser d v
unexpected :: forall d v. Derivs d => String -> Parser d v
unexpected String
str = forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"unexpected " forall a. [a] -> [a] -> [a]
++ String
str)


-- Comparison operators for ParseError just compare relative positions.
instance Eq ParseError where
    ParseError Pos
p1 [Message]
_ == :: ParseError -> ParseError -> Bool
== ParseError Pos
p2 [Message]
_  = Pos
p1 forall a. Eq a => a -> a -> Bool
== Pos
p2
    ParseError Pos
p1 [Message]
_ /= :: ParseError -> ParseError -> Bool
/= ParseError Pos
p2 [Message]
_  = Pos
p1 forall a. Eq a => a -> a -> Bool
/= Pos
p2

instance Ord ParseError where
    ParseError Pos
p1 [Message]
_ < :: ParseError -> ParseError -> Bool
< ParseError Pos
p2 [Message]
_   = Pos
p1 forall a. Ord a => a -> a -> Bool
< Pos
p2
    ParseError Pos
p1 [Message]
_ > :: ParseError -> ParseError -> Bool
> ParseError Pos
p2 [Message]
_   = Pos
p1 forall a. Ord a => a -> a -> Bool
> Pos
p2
    ParseError Pos
p1 [Message]
_ <= :: ParseError -> ParseError -> Bool
<= ParseError Pos
p2 [Message]
_  = Pos
p1 forall a. Ord a => a -> a -> Bool
<= Pos
p2
    ParseError Pos
p1 [Message]
_ >= :: ParseError -> ParseError -> Bool
>= ParseError Pos
p2 [Message]
_  = Pos
p1 forall a. Ord a => a -> a -> Bool
>= Pos
p2
    -- Special behavior: "max" joins two errors
    max :: ParseError -> ParseError -> ParseError
max = ParseError -> ParseError -> ParseError
joinErrors
    min :: ParseError -> ParseError -> ParseError
min ParseError
_ ParseError
_ = forall a. HasCallStack => a
undefined

instance Show ParseError where
    show :: ParseError -> String
show (ParseError Pos
pos []) =
        forall a. Show a => a -> String
show Pos
pos forall a. [a] -> [a] -> [a]
++ String
": unknown error"
    show (ParseError Pos
pos [Message]
msgs) = [String] -> String
expectmsg [String]
expects forall a. [a] -> [a] -> [a]
++ [Message] -> String
messages [Message]
msgs
        where expects :: [String]
expects = [Message] -> [String]
getExpects [Message]
msgs
              getExpects :: [Message] -> [String]
getExpects [] = []
              getExpects (Expected String
exp : [Message]
rest) = String
exp forall a. a -> [a] -> [a]
: [Message] -> [String]
getExpects [Message]
rest
              getExpects (Message String
_ : [Message]
rest) = [Message] -> [String]
getExpects [Message]
rest
              expectmsg :: [String] -> String
expectmsg [] = String
""
              expectmsg [String
exp] = forall a. Show a => a -> String
show Pos
pos forall a. [a] -> [a] -> [a]
++ String
": expecting " forall a. [a] -> [a] -> [a]
++ String
exp forall a. [a] -> [a] -> [a]
++ String
"\n"
              expectmsg [String
e1, String
e2] = forall a. Show a => a -> String
show Pos
pos forall a. [a] -> [a] -> [a]
++ String
": expecting either "
                                     forall a. [a] -> [a] -> [a]
++ String
e1 forall a. [a] -> [a] -> [a]
++ String
" or " forall a. [a] -> [a] -> [a]
++ String
e2 forall a. [a] -> [a] -> [a]
++ String
"\n"
              expectmsg (String
first : [String]
rest) = forall a. Show a => a -> String
show Pos
pos forall a. [a] -> [a] -> [a]
++ String
": expecting one of: "
                                           forall a. [a] -> [a] -> [a]
++ String
first forall a. [a] -> [a] -> [a]
++ [String] -> String
expectlist [String]
rest forall a. [a] -> [a] -> [a]
++ String
"\n"
              expectlist :: [String] -> String
expectlist [] = String
""
              expectlist [String
lst] = String
", or " forall a. [a] -> [a] -> [a]
++ String
lst
              expectlist (String
mid : [String]
rest) = String
", " forall a. [a] -> [a] -> [a]
++ String
mid forall a. [a] -> [a] -> [a]
++ [String] -> String
expectlist [String]
rest
              messages :: [Message] -> String
messages [] = []
              messages (Expected String
_ : [Message]
rest) = [Message] -> String
messages [Message]
rest
              messages (Message String
msg : [Message]
rest) =
                  forall a. Show a => a -> String
show Pos
pos forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ String
msg forall a. [a] -> [a] -> [a]
++ String
"\n" forall a. [a] -> [a] -> [a]
++ [Message] -> String
messages [Message]
rest


-- Character-oriented parsers

anyChar :: Derivs d => Parser d Char
anyChar :: forall d. Derivs d => Parser d Char
anyChar = forall d v. (d -> Result d v) -> Parser d v
Parser forall d. Derivs d => d -> Result d Char
dvChar

char :: Derivs d => Char -> Parser d Char
char :: forall d. Derivs d => Char -> Parser d Char
char Char
ch = forall d v. Derivs d => Parser d v -> (v -> Bool) -> Parser d v
satisfy forall d. Derivs d => Parser d Char
anyChar (forall a. Eq a => a -> a -> Bool
== Char
ch) forall d v. Derivs d => Parser d v -> String -> Parser d v
<?> forall a. Show a => a -> String
show Char
ch

oneOf :: Derivs d => [Char] -> Parser d Char
oneOf :: forall d. Derivs d => String -> Parser d Char
oneOf String
chs = forall d v. Derivs d => Parser d v -> (v -> Bool) -> Parser d v
satisfy forall d. Derivs d => Parser d Char
anyChar (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
chs)
            forall d v. Derivs d => Parser d v -> String -> Parser d v
<?> (String
"one of the characters " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
chs)

noneOf :: Derivs d => [Char] -> Parser d Char
noneOf :: forall d. Derivs d => String -> Parser d Char
noneOf String
chs = forall d v. Derivs d => Parser d v -> (v -> Bool) -> Parser d v
satisfy forall d. Derivs d => Parser d Char
anyChar (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
chs)
             forall d v. Derivs d => Parser d v -> String -> Parser d v
<?> (String
"any character not in " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
chs)


charIf :: Derivs d => (Char -> Bool) -> Parser d Char
charIf :: forall d. Derivs d => (Char -> Bool) -> Parser d Char
charIf Char -> Bool
p = forall d v. Derivs d => Parser d v -> (v -> Bool) -> Parser d v
satisfy forall d. Derivs d => Parser d Char
anyChar Char -> Bool
p forall d v. Derivs d => Parser d v -> String -> Parser d v
<?> String
"predicate is not satisfied"

string :: Derivs d => String -> Parser d String
string :: forall d. Derivs d => String -> Parser d String
string String
str = forall d. Derivs d => String -> Parser d String
p String
str forall d v. Derivs d => Parser d v -> String -> Parser d v
<?> forall a. Show a => a -> String
show String
str
    where p :: String -> Parser d String
p [] = forall (m :: * -> *) a. Monad m => a -> m a
return String
str
          p (Char
ch:String
chs) = do { forall d. Derivs d => Char -> Parser d Char
char Char
ch; String -> Parser d String
p String
chs }

stringFrom :: Derivs d => [String] -> Parser d String
stringFrom :: forall d. Derivs d => [String] -> Parser d String
stringFrom [] = forall a. HasCallStack => String -> a
error String
"stringFrom requires non-empty list"
stringFrom [String
str] = forall d. Derivs d => String -> Parser d String
string String
str
stringFrom (String
str : [String]
strs) = forall d. Derivs d => String -> Parser d String
string String
str forall d v. Derivs d => Parser d v -> Parser d v -> Parser d v
<|> forall d. Derivs d => [String] -> Parser d String
stringFrom [String]
strs

upper :: Derivs d => Parser d Char
upper :: forall d. Derivs d => Parser d Char
upper = forall d v. Derivs d => Parser d v -> (v -> Bool) -> Parser d v
satisfy forall d. Derivs d => Parser d Char
anyChar Char -> Bool
isUpper forall d v. Derivs d => Parser d v -> String -> Parser d v
<?> String
"uppercase letter"

lower :: Derivs d => Parser d Char
lower :: forall d. Derivs d => Parser d Char
lower = forall d v. Derivs d => Parser d v -> (v -> Bool) -> Parser d v
satisfy forall d. Derivs d => Parser d Char
anyChar Char -> Bool
isLower forall d v. Derivs d => Parser d v -> String -> Parser d v
<?> String
"lowercase letter"

letter :: Derivs d => Parser d Char
letter :: forall d. Derivs d => Parser d Char
letter = forall d v. Derivs d => Parser d v -> (v -> Bool) -> Parser d v
satisfy forall d. Derivs d => Parser d Char
anyChar Char -> Bool
isAlpha forall d v. Derivs d => Parser d v -> String -> Parser d v
<?> String
"letter"

alphaNum :: Derivs d => Parser d Char
alphaNum :: forall d. Derivs d => Parser d Char
alphaNum = forall d v. Derivs d => Parser d v -> (v -> Bool) -> Parser d v
satisfy forall d. Derivs d => Parser d Char
anyChar Char -> Bool
isAlphaNum forall d v. Derivs d => Parser d v -> String -> Parser d v
<?> String
"letter or digit"

digit :: Derivs d => Parser d Char
digit :: forall d. Derivs d => Parser d Char
digit = forall d v. Derivs d => Parser d v -> (v -> Bool) -> Parser d v
satisfy forall d. Derivs d => Parser d Char
anyChar Char -> Bool
isDigit forall d v. Derivs d => Parser d v -> String -> Parser d v
<?> String
"digit"

hexDigit :: Derivs d => Parser d Char
hexDigit :: forall d. Derivs d => Parser d Char
hexDigit = forall d v. Derivs d => Parser d v -> (v -> Bool) -> Parser d v
satisfy forall d. Derivs d => Parser d Char
anyChar Char -> Bool
isHexDigit forall d v. Derivs d => Parser d v -> String -> Parser d v
<?> String
"hexadecimal digit (0-9, a-f)"

octDigit :: Derivs d => Parser d Char
octDigit :: forall d. Derivs d => Parser d Char
octDigit = forall d v. Derivs d => Parser d v -> (v -> Bool) -> Parser d v
satisfy forall d. Derivs d => Parser d Char
anyChar Char -> Bool
isOctDigit forall d v. Derivs d => Parser d v -> String -> Parser d v
<?> String
"octal digit (0-7)"

newline :: Derivs d => Parser d Char
newline :: forall d. Derivs d => Parser d Char
newline = forall d. Derivs d => Char -> Parser d Char
char Char
'\n'

tab :: Derivs d => Parser d Char
tab :: forall d. Derivs d => Parser d Char
tab = forall d. Derivs d => Char -> Parser d Char
char Char
'\t'

space :: Derivs d => Parser d Char
space :: forall d. Derivs d => Parser d Char
space = forall d v. Derivs d => Parser d v -> (v -> Bool) -> Parser d v
satisfy forall d. Derivs d => Parser d Char
anyChar Char -> Bool
isSpace forall d v. Derivs d => Parser d v -> String -> Parser d v
<?> String
"whitespace character"

spaces :: Derivs d => Parser d [Char]
spaces :: forall d. Derivs d => Parser d String
spaces = forall d v. Derivs d => Parser d v -> Parser d [v]
many forall d. Derivs d => Parser d Char
space

eof :: Derivs d => Parser d ()
eof :: forall d. Derivs d => Parser d ()
eof = forall d v. (Derivs d, Show v) => Parser d v -> Parser d ()
notFollowedBy forall d. Derivs d => Parser d Char
anyChar forall d v. Derivs d => Parser d v -> String -> Parser d v
<?> String
"end of input"


-- State manipulation

getDerivs :: Derivs d => Parser d d
getDerivs :: forall d. Derivs d => Parser d d
getDerivs = forall d v. (d -> Result d v) -> Parser d v
Parser (\d
dvs -> forall d v. v -> d -> ParseError -> Result d v
Parsed d
dvs d
dvs (forall d. Derivs d => d -> ParseError
nullError d
dvs))

setDerivs :: Derivs d => d -> Parser d ()
setDerivs :: forall d. Derivs d => d -> Parser d ()
setDerivs d
newdvs = forall d v. (d -> Result d v) -> Parser d v
Parser (forall d v. v -> d -> ParseError -> Result d v
Parsed () d
newdvs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall d. Derivs d => d -> ParseError
nullError)

getPos :: Derivs d => Parser d Pos
getPos :: forall d. Derivs d => Parser d Pos
getPos = forall d v. (d -> Result d v) -> Parser d v
Parser (\d
dvs -> forall d v. v -> d -> ParseError -> Result d v
Parsed (forall d. Derivs d => d -> Pos
dvPos d
dvs) d
dvs (forall d. Derivs d => d -> ParseError
nullError d
dvs))


-- Special function that converts a Derivs "back" into an ordinary String
-- by extracting the successive dvChar elements.
dvString :: Derivs d => d -> String
dvString :: forall d. Derivs d => d -> String
dvString d
d =
    case forall d. Derivs d => d -> Result d Char
dvChar d
d of
      NoParse ParseError
_ -> []
      Parsed Char
c d
rem ParseError
_ -> Char
c forall a. a -> [a] -> [a]
: forall d. Derivs d => d -> String
dvString d
rem