{-# 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 :: (a -> b) -> Parser d a -> Parser d b
`fmap` (Parser d -> Result d a
p1) = (d -> Result d b) -> Parser d b
forall d v. (d -> Result d v) -> Parser d v
Parser ((d -> Result d b) -> Parser d b)
-> (d -> Result d b) -> Parser d b
forall a b. (a -> b) -> a -> b
$ Result d a -> Result d b
forall d. Result d a -> Result d b
parse (Result d a -> Result d b) -> (d -> Result d a) -> d -> Result d b
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  b -> d -> ParseError -> Result d b
forall d v. v -> d -> ParseError -> Result d v
Parsed b
val2 d
rem ParseError
err
              parse (NoParse ParseError
err) = ParseError -> Result d b
forall d v. ParseError -> Result d v
NoParse ParseError
err

instance Derivs d => Applicative (Parser d) where
    pure :: a -> Parser d a
pure a
x = (d -> Result d a) -> Parser d a
forall d v. (d -> Result d v) -> Parser d v
Parser (\d
dvs -> a -> d -> ParseError -> Result d a
forall d v. v -> d -> ParseError -> Result d v
Parsed a
x d
dvs (d -> ParseError
forall d. Derivs d => d -> ParseError
nullError d
dvs))
    <*> :: Parser d (a -> b) -> Parser d a -> Parser d 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) >>= :: Parser d a -> (a -> Parser d b) -> Parser d b
>>= a -> Parser d b
f = (d -> Result d b) -> Parser d b
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 ParseError -> Result d b -> Result d b
forall d v. ParseError -> Result d v -> Result d v
second ParseError
err (d -> Result d b
p2 d
rem)
              first (NoParse ParseError
err) = ParseError -> Result d b
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) =
                  v -> d -> ParseError -> Result d v
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) =
                  ParseError -> Result d v
forall d v. ParseError -> Result d v
NoParse (ParseError -> ParseError -> ParseError
joinErrors ParseError
err1 ParseError
err)
    return :: a -> Parser d a
return = a -> Parser d a
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 :: String -> Parser d a
fail String
msg = (d -> Result d a) -> Parser d a
forall d v. (d -> Result d v) -> Parser d v
Parser (\d
dvs -> ParseError -> Result d a
forall d v. ParseError -> Result d v
NoParse (Pos -> String -> ParseError
msgError (d -> Pos
forall d. Derivs d => d -> Pos
dvPos d
dvs) String
msg))

instance Derivs d => A.Alternative (Parser d) where
    empty :: Parser d a
empty = (d -> Result d a) -> Parser d a
forall d v. (d -> Result d v) -> Parser d v
Parser ((d -> Result d a) -> Parser d a)
-> (d -> Result d a) -> Parser d a
forall a b. (a -> b) -> a -> b
$ ParseError -> Result d a
forall d v. ParseError -> Result d v
NoParse (ParseError -> Result d a) -> (d -> ParseError) -> d -> Result d a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. d -> ParseError
forall d. Derivs d => d -> ParseError
nullError
    <|> :: Parser d a -> Parser d a -> Parser d 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 :: Parser d a
mzero = Parser d a
forall (f :: * -> *) a. Alternative f => f a
A.empty
    mplus :: Parser d a -> Parser d a -> Parser d a
mplus = Parser d a -> Parser d a -> Parser d a
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) <|> :: Parser d v -> Parser d v -> Parser d v
<|> (Parser d -> Result d v
p2) = (d -> Result d v) -> Parser d v
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) = ParseError -> Result d v -> Result d v
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) =
              v -> d -> ParseError -> Result d v
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) =
              ParseError -> Result d v
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 :: Parser d v -> (v -> Bool) -> Parser d v
satisfy (Parser d -> Result d v
p) v -> Bool
test = (d -> Result d v) -> Parser d v
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
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 ParseError -> Result d v
forall d v. ParseError -> Result d v
NoParse (d -> ParseError
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 :: Parser d v -> Parser d ()
notFollowedBy (Parser d -> Result d v
p) = (d -> Result d ()) -> Parser d ()
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
_ ->
                            ParseError -> Result d ()
forall d v. ParseError -> Result d v
NoParse (Pos -> String -> ParseError
msgError (d -> Pos
forall d. Derivs d => d -> Pos
dvPos d
dvs)
                                     (String
"unexpected " String -> String -> String
forall a. [a] -> [a] -> [a]
++ v -> String
forall a. Show a => a -> String
show v
val))
                        NoParse ParseError
_ -> () -> d -> ParseError -> Result d ()
forall d v. v -> d -> ParseError -> Result d v
Parsed () d
dvs (d -> ParseError
forall d. Derivs d => d -> ParseError
nullError d
dvs)

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

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

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

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

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

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

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

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

sepEndBy :: Derivs d => Parser d v -> Parser d vsep -> Parser d [v]
sepEndBy :: Parser d v -> Parser d vsep -> Parser d [v]
sepEndBy Parser d v
p Parser d vsep
psep = do [v]
v <- Parser d v -> Parser d vsep -> Parser d [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; Parser d vsep -> Parser d (Maybe vsep)
forall d v. Derivs d => Parser d v -> Parser d (Maybe v)
optional Parser d vsep
psep; [v] -> Parser d [v]
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 :: 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))
                             Parser d v -> Parser d v -> Parser d v
forall d v. Derivs d => Parser d v -> Parser d v -> Parser d v
<|> 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 :: 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 = Parser d v -> Parser d (v -> v -> v) -> Parser d v
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 Parser d v -> Parser d v -> Parser d v
forall d v. Derivs d => Parser d v -> Parser d v -> Parser d v
<|> 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 :: 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 <- Parser d v -> Parser d (v -> v -> v) -> Parser d v
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
                     v -> Parser d v
forall (m :: * -> *) a. Monad m => a -> m a
return (v -> v -> v
f v
v v
w))
                 Parser d v -> Parser d v -> Parser d v
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 :: 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 = Parser d v -> Parser d (v -> v -> v) -> Parser d v
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 Parser d v -> Parser d v -> Parser d v
forall d v. Derivs d => Parser d v -> Parser d v -> Parser d v
<|> 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 :: [Parser d v] -> Parser d v
choice [] = String -> Parser d v
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 Parser d v -> Parser d v -> Parser d v
forall d v. Derivs d => Parser d v -> Parser d v -> 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 :: Parser d v -> Parser d vend -> Parser d [v]
manyTill Parser d v
p Parser d vend
pend = (Parser d vend
pend Parser d vend -> Parser d [v] -> Parser d [v]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [v] -> Parser d [v]
forall (m :: * -> *) a. Monad m => a -> m a
return [])
              Parser d [v] -> Parser d [v] -> Parser d [v]
forall d v. Derivs d => Parser d v -> Parser d v -> Parser d v
<|> do v
tok <- Parser d v
p
                     [v]
rest <- Parser d v -> Parser d vend -> Parser d [v]
forall d v vsep.
Derivs d =>
Parser d v -> Parser d vsep -> Parser d [v]
manyTill Parser d v
p Parser d vend
pend
                     [v] -> Parser d [v]
forall (m :: * -> *) a. Monad m => a -> m a
return (v
tokv -> [v] -> [v]
forall a. a -> [a] -> [a]
:[v]
rest)

between :: Derivs d => Parser d vs -> Parser d ve -> Parser d v -> Parser d v
between :: 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
                      v -> Parser d v
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 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
e2
    Message String
m1 == Message String
m2    = String
m1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
m2
    Message
_ == Message
_                      = Bool
False

failAt :: Derivs d => Pos -> String -> Parser d v
failAt :: Pos -> String -> Parser d v
failAt Pos
pos String
msg = (d -> Result d v) -> Parser d v
forall d v. (d -> Result d v) -> Parser d v
Parser (Result d v -> d -> Result d v
forall a b. a -> b -> a
const (Result d v -> d -> Result d v) -> Result d v -> d -> Result d v
forall a b. (a -> b) -> a -> b
$ ParseError -> Result d v
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) <?> :: Parser d v -> String -> Parser d v
<?> String
desc = (d -> Result d v) -> Parser d v
forall d v. (d -> Result d v) -> Parser d v
Parser (\d
dvs -> d -> Result d v -> Result d v
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) =
              v -> d -> ParseError -> Result d v
forall d v. v -> d -> ParseError -> Result d v
Parsed v
v d
rem (d -> ParseError -> ParseError
forall d. Derivs d => d -> ParseError -> ParseError
fix d
dvs ParseError
err)
          munge d
dvs (NoParse ParseError
err) =
              ParseError -> Result d v
forall d v. ParseError -> Result d v
NoParse (d -> ParseError -> ParseError
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 Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
> d -> Pos
forall d. Derivs d => d -> Pos
dvPos d
dvs
              then ParseError
err
              else Pos -> String -> ParseError
expError (d -> Pos
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) <?!> :: Parser d v -> String -> Parser d v
<?!> String
desc = (d -> Result d v) -> Parser d v
forall d v. (d -> Result d v) -> Parser d v
Parser (\d
dvs -> d -> Result d v -> Result d v
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) =
              v -> d -> ParseError -> Result d v
forall d v. v -> d -> ParseError -> Result d v
Parsed v
v d
rem (d -> ParseError -> ParseError
forall d. Derivs d => d -> ParseError -> ParseError
fix d
dvs ParseError
err)
          munge d
dvs (NoParse ParseError
err) =
              ParseError -> Result d v
forall d v. ParseError -> Result d v
NoParse (d -> ParseError -> ParseError
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 (d -> Pos
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' Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
> Pos
p Bool -> Bool -> Bool
|| [Message] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Message]
m  = ParseError
e'
    | Pos
p Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
> Pos
p' Bool -> Bool -> Bool
|| [Message] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Message]
m' = ParseError
e
    | Bool
otherwise         = Pos -> [Message] -> ParseError
ParseError Pos
p ([Message]
m [Message] -> [Message] -> [Message]
forall a. Eq a => [a] -> [a] -> [a]
`union` [Message]
m')

nullError :: Derivs d => d -> ParseError
nullError :: d -> ParseError
nullError d
dvs = Pos -> [Message] -> ParseError
ParseError (d -> Pos
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 :: d -> ParseError
eofError d
dvs = Pos -> String -> ParseError
msgError (d -> Pos
forall d. Derivs d => d -> Pos
dvPos d
dvs) String
"end of input"

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

unexpected :: Derivs d => String -> Parser d v
unexpected :: String -> Parser d v
unexpected String
str = String -> Parser d v
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"unexpected " String -> String -> String
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 Pos -> Pos -> Bool
forall a. Eq a => a -> a -> Bool
== Pos
p2
    ParseError Pos
p1 [Message]
_ /= :: ParseError -> ParseError -> Bool
/= ParseError Pos
p2 [Message]
_  = Pos
p1 Pos -> Pos -> Bool
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 Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
< Pos
p2
    ParseError Pos
p1 [Message]
_ > :: ParseError -> ParseError -> Bool
> ParseError Pos
p2 [Message]
_   = Pos
p1 Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
> Pos
p2
    ParseError Pos
p1 [Message]
_ <= :: ParseError -> ParseError -> Bool
<= ParseError Pos
p2 [Message]
_  = Pos
p1 Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
<= Pos
p2
    ParseError Pos
p1 [Message]
_ >= :: ParseError -> ParseError -> Bool
>= ParseError Pos
p2 [Message]
_  = Pos
p1 Pos -> Pos -> Bool
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
_ = ParseError
forall a. HasCallStack => a
undefined

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


-- Character-oriented parsers

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

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

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

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


charIf :: Derivs d => (Char -> Bool) -> Parser d Char
charIf :: (Char -> Bool) -> Parser d Char
charIf Char -> Bool
p = Parser d Char -> (Char -> Bool) -> Parser d Char
forall d v. Derivs d => Parser d v -> (v -> Bool) -> Parser d v
satisfy Parser d Char
forall d. Derivs d => Parser d Char
anyChar Char -> Bool
p Parser d Char -> String -> Parser d Char
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 :: String -> Parser d String
string String
str = String -> Parser d String
forall d. Derivs d => String -> Parser d String
p String
str Parser d String -> String -> Parser d String
forall d v. Derivs d => Parser d v -> String -> Parser d v
<?> String -> String
forall a. Show a => a -> String
show String
str
    where p :: String -> Parser d String
p [] = String -> Parser d String
forall (m :: * -> *) a. Monad m => a -> m a
return String
str
          p (Char
ch:String
chs) = do { Char -> Parser d Char
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 :: [String] -> Parser d String
stringFrom [] = String -> Parser d String
forall a. HasCallStack => String -> a
error String
"stringFrom requires non-empty list"
stringFrom [String
str] = String -> Parser d String
forall d. Derivs d => String -> Parser d String
string String
str
stringFrom (String
str : [String]
strs) = String -> Parser d String
forall d. Derivs d => String -> Parser d String
string String
str Parser d String -> Parser d String -> Parser d String
forall d v. Derivs d => Parser d v -> Parser d v -> Parser d v
<|> [String] -> Parser d String
forall d. Derivs d => [String] -> Parser d String
stringFrom [String]
strs

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

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

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

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

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

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

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

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

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

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

eof :: Derivs d => Parser d ()
eof :: Parser d ()
eof = Parser d Char -> Parser d ()
forall d v. (Derivs d, Show v) => Parser d v -> Parser d ()
notFollowedBy Parser d Char
forall d. Derivs d => Parser d Char
anyChar Parser d () -> String -> Parser d ()
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 :: Parser d d
getDerivs = (d -> Result d d) -> Parser d d
forall d v. (d -> Result d v) -> Parser d v
Parser (\d
dvs -> d -> d -> ParseError -> Result d d
forall d v. v -> d -> ParseError -> Result d v
Parsed d
dvs d
dvs (d -> ParseError
forall d. Derivs d => d -> ParseError
nullError d
dvs))

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

getPos :: Derivs d => Parser d Pos
getPos :: Parser d Pos
getPos = (d -> Result d Pos) -> Parser d Pos
forall d v. (d -> Result d v) -> Parser d v
Parser (\d
dvs -> Pos -> d -> ParseError -> Result d Pos
forall d v. v -> d -> ParseError -> Result d v
Parsed (d -> Pos
forall d. Derivs d => d -> Pos
dvPos d
dvs) d
dvs (d -> ParseError
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 :: d -> String
dvString d
d =
    case d -> Result d Char
forall d. Derivs d => d -> Result d Char
dvChar d
d of
      NoParse ParseError
_ -> []
      Parsed Char
c d
rem ParseError
_ -> Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: d -> String
forall d. Derivs d => d -> String
dvString d
rem