{-# LANGUAGE AllowAmbiguousTypes, ConstraintKinds, DefaultSignatures, DeriveDataTypeable, DeriveFunctor,
             FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, OverloadedStrings,
             RankNTypes, ScopedTypeVariables, TypeApplications, TypeFamilies, TypeOperators, TypeSynonymInstances,
             UndecidableInstances #-}
-- | The core classes supported by all the parsers in this library.
module Text.Grampa.Class (MultiParsing(..), GrammarParsing(..),
                          AmbiguousParsing(..), DeterministicParsing(..), InputParsing(..), InputCharParsing(..),
                          CommittedParsing(..), ConsumedInputParsing(..), LexicalParsing(..), TailsParsing(..),
                          ParseResults, ParseFailure(..), FailureDescription(..), Pos,
                          Ambiguous(..), completeParser) where

import Control.Applicative (Alternative(empty), liftA2)
import Data.Char (isAlphaNum, isLetter, isSpace)
import Data.Functor.Classes (Show1(..))
import Data.Functor.Compose (Compose(..))
import Data.Kind (Type)
import Data.List.NonEmpty (NonEmpty((:|)))
import Data.Data (Data)
import Data.Typeable (Typeable)
import Data.Monoid (Monoid(mempty, mappend))
import qualified Data.Monoid.Null as Null
import Data.Monoid.Null (MonoidNull)
import Data.Monoid.Factorial (FactorialMonoid)
import Data.Monoid.Textual (TextualMonoid)
import Data.Semigroup (Semigroup((<>)))
import Data.Ord (Down(Down))
import Text.Parser.Combinators (Parsing((<?>)))
import Text.Parser.Token (TokenParsing)
import Text.Parser.Deterministic (DeterministicParsing(..))
import Text.Parser.Input (ConsumedInputParsing(..), InputParsing(..), InputCharParsing(..))
import qualified Text.Parser.Char
import Data.Kind (Constraint)

import qualified Rank2

import Prelude hiding (takeWhile)

-- | A parse results in either a 'ParseFailure' or the result of the appropriate type.
type ParseResults s = Either (ParseFailure Pos s)

-- | A 'ParseFailure' contains the offset of the parse failure and the list of things expected at that offset.
data ParseFailure pos s =
   ParseFailure {forall pos s. ParseFailure pos s -> pos
failurePosition :: pos,
                 forall pos s. ParseFailure pos s -> FailureDescription s
expectedAlternatives :: FailureDescription s,  -- ^ expected input alternatives
                 forall pos s. ParseFailure pos s -> [String]
errorAlternatives ::    [String]               -- ^ erroneous alternatives
                }
   deriving (ParseFailure pos s -> ParseFailure pos s -> Bool
(ParseFailure pos s -> ParseFailure pos s -> Bool)
-> (ParseFailure pos s -> ParseFailure pos s -> Bool)
-> Eq (ParseFailure pos s)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall pos s.
(Eq pos, Eq s) =>
ParseFailure pos s -> ParseFailure pos s -> Bool
$c== :: forall pos s.
(Eq pos, Eq s) =>
ParseFailure pos s -> ParseFailure pos s -> Bool
== :: ParseFailure pos s -> ParseFailure pos s -> Bool
$c/= :: forall pos s.
(Eq pos, Eq s) =>
ParseFailure pos s -> ParseFailure pos s -> Bool
/= :: ParseFailure pos s -> ParseFailure pos s -> Bool
Eq, (forall a b. (a -> b) -> ParseFailure pos a -> ParseFailure pos b)
-> (forall a b. a -> ParseFailure pos b -> ParseFailure pos a)
-> Functor (ParseFailure pos)
forall a b. a -> ParseFailure pos b -> ParseFailure pos a
forall a b. (a -> b) -> ParseFailure pos a -> ParseFailure pos b
forall pos a b. a -> ParseFailure pos b -> ParseFailure pos a
forall pos a b.
(a -> b) -> ParseFailure pos a -> ParseFailure pos b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall pos a b.
(a -> b) -> ParseFailure pos a -> ParseFailure pos b
fmap :: forall a b. (a -> b) -> ParseFailure pos a -> ParseFailure pos b
$c<$ :: forall pos a b. a -> ParseFailure pos b -> ParseFailure pos a
<$ :: forall a b. a -> ParseFailure pos b -> ParseFailure pos a
Functor, Int -> ParseFailure pos s -> ShowS
[ParseFailure pos s] -> ShowS
ParseFailure pos s -> String
(Int -> ParseFailure pos s -> ShowS)
-> (ParseFailure pos s -> String)
-> ([ParseFailure pos s] -> ShowS)
-> Show (ParseFailure pos s)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall pos s.
(Show pos, Show s) =>
Int -> ParseFailure pos s -> ShowS
forall pos s. (Show pos, Show s) => [ParseFailure pos s] -> ShowS
forall pos s. (Show pos, Show s) => ParseFailure pos s -> String
$cshowsPrec :: forall pos s.
(Show pos, Show s) =>
Int -> ParseFailure pos s -> ShowS
showsPrec :: Int -> ParseFailure pos s -> ShowS
$cshow :: forall pos s. (Show pos, Show s) => ParseFailure pos s -> String
show :: ParseFailure pos s -> String
$cshowList :: forall pos s. (Show pos, Show s) => [ParseFailure pos s] -> ShowS
showList :: [ParseFailure pos s] -> ShowS
Show)

-- | A position in the input is represented as the length of its remainder.
type Pos = Down Int

-- | An expected or erroneous input can be described using 'String' or using the input type
data FailureDescription s = FailureDescription {forall s. FailureDescription s -> [String]
staticDescriptions  :: [String],
                                                forall s. FailureDescription s -> [s]
literalDescriptions :: [s]}
                            deriving ((forall a b.
 (a -> b) -> FailureDescription a -> FailureDescription b)
-> (forall a b. a -> FailureDescription b -> FailureDescription a)
-> Functor FailureDescription
forall a b. a -> FailureDescription b -> FailureDescription a
forall a b.
(a -> b) -> FailureDescription a -> FailureDescription b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b.
(a -> b) -> FailureDescription a -> FailureDescription b
fmap :: forall a b.
(a -> b) -> FailureDescription a -> FailureDescription b
$c<$ :: forall a b. a -> FailureDescription b -> FailureDescription a
<$ :: forall a b. a -> FailureDescription b -> FailureDescription a
Functor, FailureDescription s -> FailureDescription s -> Bool
(FailureDescription s -> FailureDescription s -> Bool)
-> (FailureDescription s -> FailureDescription s -> Bool)
-> Eq (FailureDescription s)
forall s.
Eq s =>
FailureDescription s -> FailureDescription s -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall s.
Eq s =>
FailureDescription s -> FailureDescription s -> Bool
== :: FailureDescription s -> FailureDescription s -> Bool
$c/= :: forall s.
Eq s =>
FailureDescription s -> FailureDescription s -> Bool
/= :: FailureDescription s -> FailureDescription s -> Bool
Eq, Eq (FailureDescription s)
Eq (FailureDescription s) =>
(FailureDescription s -> FailureDescription s -> Ordering)
-> (FailureDescription s -> FailureDescription s -> Bool)
-> (FailureDescription s -> FailureDescription s -> Bool)
-> (FailureDescription s -> FailureDescription s -> Bool)
-> (FailureDescription s -> FailureDescription s -> Bool)
-> (FailureDescription s
    -> FailureDescription s -> FailureDescription s)
-> (FailureDescription s
    -> FailureDescription s -> FailureDescription s)
-> Ord (FailureDescription s)
FailureDescription s -> FailureDescription s -> Bool
FailureDescription s -> FailureDescription s -> Ordering
FailureDescription s
-> FailureDescription s -> FailureDescription s
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
forall s. Ord s => Eq (FailureDescription s)
forall s.
Ord s =>
FailureDescription s -> FailureDescription s -> Bool
forall s.
Ord s =>
FailureDescription s -> FailureDescription s -> Ordering
forall s.
Ord s =>
FailureDescription s
-> FailureDescription s -> FailureDescription s
$ccompare :: forall s.
Ord s =>
FailureDescription s -> FailureDescription s -> Ordering
compare :: FailureDescription s -> FailureDescription s -> Ordering
$c< :: forall s.
Ord s =>
FailureDescription s -> FailureDescription s -> Bool
< :: FailureDescription s -> FailureDescription s -> Bool
$c<= :: forall s.
Ord s =>
FailureDescription s -> FailureDescription s -> Bool
<= :: FailureDescription s -> FailureDescription s -> Bool
$c> :: forall s.
Ord s =>
FailureDescription s -> FailureDescription s -> Bool
> :: FailureDescription s -> FailureDescription s -> Bool
$c>= :: forall s.
Ord s =>
FailureDescription s -> FailureDescription s -> Bool
>= :: FailureDescription s -> FailureDescription s -> Bool
$cmax :: forall s.
Ord s =>
FailureDescription s
-> FailureDescription s -> FailureDescription s
max :: FailureDescription s
-> FailureDescription s -> FailureDescription s
$cmin :: forall s.
Ord s =>
FailureDescription s
-> FailureDescription s -> FailureDescription s
min :: FailureDescription s
-> FailureDescription s -> FailureDescription s
Ord, ReadPrec [FailureDescription s]
ReadPrec (FailureDescription s)
Int -> ReadS (FailureDescription s)
ReadS [FailureDescription s]
(Int -> ReadS (FailureDescription s))
-> ReadS [FailureDescription s]
-> ReadPrec (FailureDescription s)
-> ReadPrec [FailureDescription s]
-> Read (FailureDescription s)
forall s. Read s => ReadPrec [FailureDescription s]
forall s. Read s => ReadPrec (FailureDescription s)
forall s. Read s => Int -> ReadS (FailureDescription s)
forall s. Read s => ReadS [FailureDescription s]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall s. Read s => Int -> ReadS (FailureDescription s)
readsPrec :: Int -> ReadS (FailureDescription s)
$creadList :: forall s. Read s => ReadS [FailureDescription s]
readList :: ReadS [FailureDescription s]
$creadPrec :: forall s. Read s => ReadPrec (FailureDescription s)
readPrec :: ReadPrec (FailureDescription s)
$creadListPrec :: forall s. Read s => ReadPrec [FailureDescription s]
readListPrec :: ReadPrec [FailureDescription s]
Read, Int -> FailureDescription s -> ShowS
[FailureDescription s] -> ShowS
FailureDescription s -> String
(Int -> FailureDescription s -> ShowS)
-> (FailureDescription s -> String)
-> ([FailureDescription s] -> ShowS)
-> Show (FailureDescription s)
forall s. Show s => Int -> FailureDescription s -> ShowS
forall s. Show s => [FailureDescription s] -> ShowS
forall s. Show s => FailureDescription s -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall s. Show s => Int -> FailureDescription s -> ShowS
showsPrec :: Int -> FailureDescription s -> ShowS
$cshow :: forall s. Show s => FailureDescription s -> String
show :: FailureDescription s -> String
$cshowList :: forall s. Show s => [FailureDescription s] -> ShowS
showList :: [FailureDescription s] -> ShowS
Show)

instance (Ord pos, Ord s) => Semigroup (ParseFailure pos s) where
   f1 :: ParseFailure pos s
f1@(ParseFailure pos
pos1 FailureDescription s
exp1 [String]
err1) <> :: ParseFailure pos s -> ParseFailure pos s -> ParseFailure pos s
<> f2 :: ParseFailure pos s
f2@(ParseFailure pos
pos2 FailureDescription s
exp2 [String]
err2) = pos -> FailureDescription s -> [String] -> ParseFailure pos s
forall pos s.
pos -> FailureDescription s -> [String] -> ParseFailure pos s
ParseFailure pos
pos' FailureDescription s
exp' [String]
err'
      where ParseFailure pos
pos' FailureDescription s
exp' [String]
err'
               | pos
pos1 pos -> pos -> Bool
forall a. Ord a => a -> a -> Bool
> pos
pos2 = ParseFailure pos s
f1
               | pos
pos1 pos -> pos -> Bool
forall a. Ord a => a -> a -> Bool
< pos
pos2 = ParseFailure pos s
f2
               | Bool
otherwise = pos -> FailureDescription s -> [String] -> ParseFailure pos s
forall pos s.
pos -> FailureDescription s -> [String] -> ParseFailure pos s
ParseFailure pos
pos1 (FailureDescription s
exp1 FailureDescription s
-> FailureDescription s -> FailureDescription s
forall a. Semigroup a => a -> a -> a
<> FailureDescription s
exp2) ([String] -> [String] -> [String]
forall a. Ord a => [a] -> [a] -> [a]
mergeSorted [String]
err1 [String]
err2)

instance Ord s => Semigroup (FailureDescription s) where
   FailureDescription s
exp1 <> :: FailureDescription s
-> FailureDescription s -> FailureDescription s
<> FailureDescription s
exp2 =
      [String] -> [s] -> FailureDescription s
forall s. [String] -> [s] -> FailureDescription s
FailureDescription
         ([String] -> [String] -> [String]
forall a. Ord a => [a] -> [a] -> [a]
mergeSorted (FailureDescription s -> [String]
forall s. FailureDescription s -> [String]
staticDescriptions FailureDescription s
exp1) (FailureDescription s -> [String]
forall s. FailureDescription s -> [String]
staticDescriptions FailureDescription s
exp2))
         ([s] -> [s] -> [s]
forall a. Ord a => [a] -> [a] -> [a]
mergeSorted (FailureDescription s -> [s]
forall s. FailureDescription s -> [s]
literalDescriptions FailureDescription s
exp1) (FailureDescription s -> [s]
forall s. FailureDescription s -> [s]
literalDescriptions FailureDescription s
exp2))

mergeSorted :: Ord a => [a] -> [a] -> [a]
mergeSorted :: forall a. Ord a => [a] -> [a] -> [a]
mergeSorted [] [a]
xs = [a]
xs
mergeSorted [a]
xs [] = [a]
xs
mergeSorted xs :: [a]
xs@(a
x:[a]
xs') ys :: [a]
ys@(a
y:[a]
ys')
   | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
y = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
mergeSorted [a]
xs' [a]
ys
   | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
y = a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
mergeSorted [a]
xs [a]
ys'
   | Bool
otherwise = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
mergeSorted [a]
xs' [a]
ys'

instance Ord s => Monoid (ParseFailure Pos s) where
   mempty :: ParseFailure Pos s
mempty = Pos -> FailureDescription s -> [String] -> ParseFailure Pos s
forall pos s.
pos -> FailureDescription s -> [String] -> ParseFailure pos s
ParseFailure (Int -> Pos
forall a. a -> Down a
Down Int
forall a. Bounded a => a
maxBound) FailureDescription s
forall a. Monoid a => a
mempty []
   mappend :: ParseFailure Pos s -> ParseFailure Pos s -> ParseFailure Pos s
mappend = ParseFailure Pos s -> ParseFailure Pos s -> ParseFailure Pos s
forall a. Semigroup a => a -> a -> a
(<>)

instance Ord s => Monoid (FailureDescription s) where
   mempty :: FailureDescription s
mempty = [String] -> [s] -> FailureDescription s
forall s. [String] -> [s] -> FailureDescription s
FailureDescription [String]
forall a. Monoid a => a
mempty [s]
forall a. Monoid a => a
mempty

-- | An 'Ambiguous' parse result, produced by the 'ambiguous' combinator, contains a 'NonEmpty' list of
-- alternative results.
newtype Ambiguous a = Ambiguous{forall a. Ambiguous a -> NonEmpty a
getAmbiguous :: NonEmpty a} deriving (Typeable (Ambiguous a)
Typeable (Ambiguous a) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Ambiguous a -> c (Ambiguous a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Ambiguous a))
-> (Ambiguous a -> Constr)
-> (Ambiguous a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Ambiguous a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Ambiguous a)))
-> ((forall b. Data b => b -> b) -> Ambiguous a -> Ambiguous a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Ambiguous a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Ambiguous a -> r)
-> (forall u. (forall d. Data d => d -> u) -> Ambiguous a -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Ambiguous a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Ambiguous a -> m (Ambiguous a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Ambiguous a -> m (Ambiguous a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Ambiguous a -> m (Ambiguous a))
-> Data (Ambiguous a)
Ambiguous a -> Constr
Ambiguous a -> DataType
(forall b. Data b => b -> b) -> Ambiguous a -> Ambiguous a
forall a. Data a => Typeable (Ambiguous a)
forall a. Data a => Ambiguous a -> Constr
forall a. Data a => Ambiguous a -> DataType
forall a.
Data a =>
(forall b. Data b => b -> b) -> Ambiguous a -> Ambiguous a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Ambiguous a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> Ambiguous a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Ambiguous a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Ambiguous a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Ambiguous a -> m (Ambiguous a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Ambiguous a -> m (Ambiguous a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Ambiguous a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ambiguous a -> c (Ambiguous a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Ambiguous a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Ambiguous a))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Ambiguous a -> u
forall u. (forall d. Data d => d -> u) -> Ambiguous a -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Ambiguous a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Ambiguous a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Ambiguous a -> m (Ambiguous a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Ambiguous a -> m (Ambiguous a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Ambiguous a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ambiguous a -> c (Ambiguous a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Ambiguous a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Ambiguous a))
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ambiguous a -> c (Ambiguous a)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ambiguous a -> c (Ambiguous a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Ambiguous a)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Ambiguous a)
$ctoConstr :: forall a. Data a => Ambiguous a -> Constr
toConstr :: Ambiguous a -> Constr
$cdataTypeOf :: forall a. Data a => Ambiguous a -> DataType
dataTypeOf :: Ambiguous a -> DataType
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Ambiguous a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Ambiguous a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Ambiguous a))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Ambiguous a))
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> Ambiguous a -> Ambiguous a
gmapT :: (forall b. Data b => b -> b) -> Ambiguous a -> Ambiguous a
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Ambiguous a -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Ambiguous a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Ambiguous a -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Ambiguous a -> r
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> Ambiguous a -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Ambiguous a -> [u]
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Ambiguous a -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Ambiguous a -> u
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Ambiguous a -> m (Ambiguous a)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Ambiguous a -> m (Ambiguous a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Ambiguous a -> m (Ambiguous a)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Ambiguous a -> m (Ambiguous a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Ambiguous a -> m (Ambiguous a)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Ambiguous a -> m (Ambiguous a)
Data, Ambiguous a -> Ambiguous a -> Bool
(Ambiguous a -> Ambiguous a -> Bool)
-> (Ambiguous a -> Ambiguous a -> Bool) -> Eq (Ambiguous a)
forall a. Eq a => Ambiguous a -> Ambiguous a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Ambiguous a -> Ambiguous a -> Bool
== :: Ambiguous a -> Ambiguous a -> Bool
$c/= :: forall a. Eq a => Ambiguous a -> Ambiguous a -> Bool
/= :: Ambiguous a -> Ambiguous a -> Bool
Eq, Eq (Ambiguous a)
Eq (Ambiguous a) =>
(Ambiguous a -> Ambiguous a -> Ordering)
-> (Ambiguous a -> Ambiguous a -> Bool)
-> (Ambiguous a -> Ambiguous a -> Bool)
-> (Ambiguous a -> Ambiguous a -> Bool)
-> (Ambiguous a -> Ambiguous a -> Bool)
-> (Ambiguous a -> Ambiguous a -> Ambiguous a)
-> (Ambiguous a -> Ambiguous a -> Ambiguous a)
-> Ord (Ambiguous a)
Ambiguous a -> Ambiguous a -> Bool
Ambiguous a -> Ambiguous a -> Ordering
Ambiguous a -> Ambiguous a -> Ambiguous a
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
forall a. Ord a => Eq (Ambiguous a)
forall a. Ord a => Ambiguous a -> Ambiguous a -> Bool
forall a. Ord a => Ambiguous a -> Ambiguous a -> Ordering
forall a. Ord a => Ambiguous a -> Ambiguous a -> Ambiguous a
$ccompare :: forall a. Ord a => Ambiguous a -> Ambiguous a -> Ordering
compare :: Ambiguous a -> Ambiguous a -> Ordering
$c< :: forall a. Ord a => Ambiguous a -> Ambiguous a -> Bool
< :: Ambiguous a -> Ambiguous a -> Bool
$c<= :: forall a. Ord a => Ambiguous a -> Ambiguous a -> Bool
<= :: Ambiguous a -> Ambiguous a -> Bool
$c> :: forall a. Ord a => Ambiguous a -> Ambiguous a -> Bool
> :: Ambiguous a -> Ambiguous a -> Bool
$c>= :: forall a. Ord a => Ambiguous a -> Ambiguous a -> Bool
>= :: Ambiguous a -> Ambiguous a -> Bool
$cmax :: forall a. Ord a => Ambiguous a -> Ambiguous a -> Ambiguous a
max :: Ambiguous a -> Ambiguous a -> Ambiguous a
$cmin :: forall a. Ord a => Ambiguous a -> Ambiguous a -> Ambiguous a
min :: Ambiguous a -> Ambiguous a -> Ambiguous a
Ord, Int -> Ambiguous a -> ShowS
[Ambiguous a] -> ShowS
Ambiguous a -> String
(Int -> Ambiguous a -> ShowS)
-> (Ambiguous a -> String)
-> ([Ambiguous a] -> ShowS)
-> Show (Ambiguous a)
forall a. Show a => Int -> Ambiguous a -> ShowS
forall a. Show a => [Ambiguous a] -> ShowS
forall a. Show a => Ambiguous a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Ambiguous a -> ShowS
showsPrec :: Int -> Ambiguous a -> ShowS
$cshow :: forall a. Show a => Ambiguous a -> String
show :: Ambiguous a -> String
$cshowList :: forall a. Show a => [Ambiguous a] -> ShowS
showList :: [Ambiguous a] -> ShowS
Show, Typeable)

instance Show1 Ambiguous where
   liftShowsPrec :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> Ambiguous a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d (Ambiguous (a
h :| [a]
l)) String
t
      | Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
5 = String
"(Ambiguous $ " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> a -> ShowS
sp Int
0 a
h (String
" :| " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [a] -> ShowS
sl [a]
l (Char
')' Char -> ShowS
forall a. a -> [a] -> [a]
: String
t))
      | Bool
otherwise = String
"Ambiguous (" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> a -> ShowS
sp Int
0 a
h (String
" :| " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [a] -> ShowS
sl [a]
l (Char
')' Char -> ShowS
forall a. a -> [a] -> [a]
: String
t))

instance Functor Ambiguous where
   fmap :: forall a b. (a -> b) -> Ambiguous a -> Ambiguous b
fmap a -> b
f (Ambiguous NonEmpty a
a) = NonEmpty b -> Ambiguous b
forall a. NonEmpty a -> Ambiguous a
Ambiguous ((a -> b) -> NonEmpty a -> NonEmpty b
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f NonEmpty a
a)

instance Applicative Ambiguous where
   pure :: forall a. a -> Ambiguous a
pure a
a = NonEmpty a -> Ambiguous a
forall a. NonEmpty a -> Ambiguous a
Ambiguous (a -> NonEmpty a
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a)
   Ambiguous NonEmpty (a -> b)
f <*> :: forall a b. Ambiguous (a -> b) -> Ambiguous a -> Ambiguous b
<*> Ambiguous NonEmpty a
a = NonEmpty b -> Ambiguous b
forall a. NonEmpty a -> Ambiguous a
Ambiguous (NonEmpty (a -> b)
f NonEmpty (a -> b) -> NonEmpty a -> NonEmpty b
forall a b. NonEmpty (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NonEmpty a
a)

instance Monad Ambiguous where
   return :: forall a. a -> Ambiguous a
return = a -> Ambiguous a
forall a. a -> Ambiguous a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
   Ambiguous NonEmpty a
a >>= :: forall a b. Ambiguous a -> (a -> Ambiguous b) -> Ambiguous b
>>= a -> Ambiguous b
f = NonEmpty b -> Ambiguous b
forall a. NonEmpty a -> Ambiguous a
Ambiguous (NonEmpty a
a NonEmpty a -> (a -> NonEmpty b) -> NonEmpty b
forall a b. NonEmpty a -> (a -> NonEmpty b) -> NonEmpty b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ambiguous b -> NonEmpty b
forall a. Ambiguous a -> NonEmpty a
getAmbiguous (Ambiguous b -> NonEmpty b)
-> (a -> Ambiguous b) -> a -> NonEmpty b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Ambiguous b
f)

instance Foldable Ambiguous where
   foldMap :: forall m a. Monoid m => (a -> m) -> Ambiguous a -> m
foldMap a -> m
f (Ambiguous NonEmpty a
a) = (a -> m) -> NonEmpty a -> m
forall m a. Monoid m => (a -> m) -> NonEmpty a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f NonEmpty a
a

instance Traversable Ambiguous where
   traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Ambiguous a -> f (Ambiguous b)
traverse a -> f b
f (Ambiguous NonEmpty a
a) = NonEmpty b -> Ambiguous b
forall a. NonEmpty a -> Ambiguous a
Ambiguous (NonEmpty b -> Ambiguous b) -> f (NonEmpty b) -> f (Ambiguous b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> NonEmpty a -> f (NonEmpty b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NonEmpty a -> f (NonEmpty b)
traverse a -> f b
f NonEmpty a
a

instance Semigroup a => Semigroup (Ambiguous a) where
   Ambiguous NonEmpty a
xs <> :: Ambiguous a -> Ambiguous a -> Ambiguous a
<> Ambiguous NonEmpty a
ys = NonEmpty a -> Ambiguous a
forall a. NonEmpty a -> Ambiguous a
Ambiguous ((a -> a -> a) -> NonEmpty a -> NonEmpty a -> NonEmpty a
forall a b c.
(a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>) NonEmpty a
xs NonEmpty a
ys)

instance Monoid a => Monoid (Ambiguous a) where
   mempty :: Ambiguous a
mempty = NonEmpty a -> Ambiguous a
forall a. NonEmpty a -> Ambiguous a
Ambiguous (a
forall a. Monoid a => a
mempty a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [])
   mappend :: Ambiguous a -> Ambiguous a -> Ambiguous a
mappend = Ambiguous a -> Ambiguous a -> Ambiguous a
forall a. Semigroup a => a -> a -> a
(<>)

completeParser :: MonoidNull s => Compose (ParseResults s) (Compose [] ((,) s)) r -> Compose (ParseResults s) [] r
completeParser :: forall s r.
MonoidNull s =>
Compose (ParseResults s) (Compose [] ((,) s)) r
-> Compose (ParseResults s) [] r
completeParser (Compose (Left ParseFailure Pos s
failure)) = ParseResults s [r] -> Compose (ParseResults s) [] r
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (ParseFailure Pos s -> ParseResults s [r]
forall a b. a -> Either a b
Left ParseFailure Pos s
failure)
completeParser (Compose (Right (Compose [(s, r)]
results))) =
   case ((s, r) -> Bool) -> [(s, r)] -> [(s, r)]
forall a. (a -> Bool) -> [a] -> [a]
filter (s -> Bool
forall m. MonoidNull m => m -> Bool
Null.null (s -> Bool) -> ((s, r) -> s) -> (s, r) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s, r) -> s
forall a b. (a, b) -> a
fst) [(s, r)]
results
   of [] -> ParseResults s [r] -> Compose (ParseResults s) [] r
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (ParseFailure Pos s -> ParseResults s [r]
forall a b. a -> Either a b
Left (ParseFailure Pos s -> ParseResults s [r])
-> ParseFailure Pos s -> ParseResults s [r]
forall a b. (a -> b) -> a -> b
$ Pos -> FailureDescription s -> [String] -> ParseFailure Pos s
forall pos s.
pos -> FailureDescription s -> [String] -> ParseFailure pos s
ParseFailure Pos
0 ([String] -> [s] -> FailureDescription s
forall s. [String] -> [s] -> FailureDescription s
FailureDescription [String
"a complete parse"] []) [])
      [(s, r)]
completeResults -> ParseResults s [r] -> Compose (ParseResults s) [] r
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose ([r] -> ParseResults s [r]
forall a b. b -> Either a b
Right ([r] -> ParseResults s [r]) -> [r] -> ParseResults s [r]
forall a b. (a -> b) -> a -> b
$ (s, r) -> r
forall a b. (a, b) -> b
snd ((s, r) -> r) -> [(s, r)] -> [r]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(s, r)]
completeResults)

-- | Choose one of the instances of this class to parse with.
class InputParsing m => MultiParsing m where
   -- | Some parser types produce a single result, others a list of results.
   type ResultFunctor m :: Type -> Type
   type GrammarConstraint m (g :: (Type -> Type) -> Type) :: Constraint
   type GrammarConstraint m g = Rank2.Functor g
   -- | Given a rank-2 record of parsers and input, produce a record of parses of the complete input.
   parseComplete :: (ParserInput m ~ s, GrammarConstraint m g, Eq s, FactorialMonoid s) =>
                    g m -> s -> g (ResultFunctor m)
   -- | Given a rank-2 record of parsers and input, produce a record of prefix parses paired with the remaining input
   -- suffix.
   parsePrefix :: (ParserInput m ~ s, GrammarConstraint m g, Eq s, FactorialMonoid s) =>
                  g m -> s -> g (Compose (ResultFunctor m) ((,) s))

-- | Parsers that belong to this class can memoize the parse results to avoid exponential performance complexity.
class MultiParsing m => GrammarParsing m where
   -- | The record of grammar productions associated with the parser
   type ParserGrammar m :: (Type -> Type) -> Type
   -- | For internal use by 'notTerminal'
   type GrammarFunctor m :: Type -> Type
   -- | Converts the intermediate to final parsing result.
   parsingResult :: ParserInput m -> GrammarFunctor m a -> ResultFunctor m (ParserInput m, a)
   -- | Used to reference a grammar production, only necessary from outside the grammar itself
   nonTerminal :: (g ~ ParserGrammar m, GrammarConstraint m g) => (g (GrammarFunctor m) -> GrammarFunctor m a) -> m a
   -- | Construct a grammar whose every production refers to itself.
   selfReferring :: (g ~ ParserGrammar m, GrammarConstraint m g, Rank2.Distributive g) => g m
   -- | Convert a self-referring grammar function to a grammar.
   fixGrammar :: (g ~ ParserGrammar m, GrammarConstraint m g, Rank2.Distributive g) => (g m -> g m) -> g m
   -- | Mark a parser that relies on primitive recursion to prevent an infinite loop in 'fixGrammar'.
   recursive :: m a -> m a
   -- | Convert a left-recursive parser to a non-left-recursive one. For example, you can replace the left-recursive
   -- production
   --
   -- > foo = BinOp <$> foo <*> bar <|> baz
   --
   -- in the field @foo@ of grammar @g@ with
   --
   -- > foo = chainRecursive (\x g-> g{foo = x}) baz (BinOp <$> foo <*> bar)
   --
   -- This method works on individual parsers left-recursive on themselves, not on grammars with mutually
   -- left-recursive productions. Use "Text.Grampa.ContextFree.Memoizing.LeftRecursive" for the latter.
   chainRecursive :: (g ~ ParserGrammar m, f ~ GrammarFunctor m, GrammarConstraint m g)
                  => (f a -> g f -> g f) -- ^ setter for the parsed results of each iteration
                  -> m a -- ^ the non-recursive base case
                  -> m a -- ^ the recursive case to iterate
                  -> m a
   -- | Line 'chainRecursive' but produces only the longest possible parse. The modified example
   --
   -- > foo = chainLongestRecursive (\x g-> g{foo = x}) baz (BinOp <$> foo <*> bar)
   --
   -- would be equivalent to the left-recursive production with biased choice
   --
   -- > foo = BinOp <$> foo <*> bar <<|> baz
   chainLongestRecursive :: (g ~ ParserGrammar m, f ~ GrammarFunctor m, GrammarConstraint m g)
                         => (f a -> g f -> g f) -- ^ setter for the parsed results of each iteration
                         -> m a -- ^ the non-recursive base case
                         -> m a -- ^ the recursive case to iterate
                         -> m a

   selfReferring = (forall a. (g (GrammarFunctor m) -> GrammarFunctor m a) -> m a)
-> (g (GrammarFunctor m) -> g (GrammarFunctor m)) -> g m
forall {k1} (g :: (k1 -> *) -> *) (m :: * -> *) (p :: k1 -> *)
       (q :: k1 -> *).
(Distributive g, Functor m) =>
(forall (a :: k1). m (p a) -> q a) -> m (g p) -> g q
forall (m :: * -> *) (p :: * -> *) (q :: * -> *).
Functor m =>
(forall a. m (p a) -> q a) -> m (g p) -> g q
Rank2.cotraverse (g (GrammarFunctor m) -> GrammarFunctor m a) -> m a
forall a. (g (GrammarFunctor m) -> GrammarFunctor m a) -> m a
forall (m :: * -> *) (g :: (* -> *) -> *) a.
(GrammarParsing m, g ~ ParserGrammar m, GrammarConstraint m g) =>
(g (GrammarFunctor m) -> GrammarFunctor m a) -> m a
forall (g :: (* -> *) -> *) a.
(g ~ ParserGrammar m, GrammarConstraint m g) =>
(g (GrammarFunctor m) -> GrammarFunctor m a) -> m a
nonTerminal g (GrammarFunctor m) -> g (GrammarFunctor m)
forall a. a -> a
id
   {-# INLINE selfReferring #-}
   fixGrammar = ((g m -> g m) -> g m -> g m
forall a b. (a -> b) -> a -> b
$ g m
forall (m :: * -> *) (g :: (* -> *) -> *).
(GrammarParsing m, g ~ ParserGrammar m, GrammarConstraint m g,
 Distributive g) =>
g m
forall (g :: (* -> *) -> *).
(g ~ ParserGrammar m, GrammarConstraint m g, Distributive g) =>
g m
selfReferring)
   {-# INLINE fixGrammar #-}
   recursive = m a -> m a
forall a. a -> a
id

class GrammarParsing m => TailsParsing m where
   -- | Parse the tails of the input together with memoized parse results
   parseTails :: GrammarConstraint m g => m r -> [(ParserInput m, g (GrammarFunctor m))] -> GrammarFunctor m r
   parseAllTails :: (GrammarConstraint m g, Rank2.Functor g) =>
                    g m -> [(ParserInput m, g (GrammarFunctor m))] -> [(ParserInput m, g (GrammarFunctor m))]
   parseAllTails g m
_ [] = []
   parseAllTails g m
final parsed :: [(ParserInput m, g (GrammarFunctor m))]
parsed@((ParserInput m
s, g (GrammarFunctor m)
_):[(ParserInput m, g (GrammarFunctor m))]
_) = (ParserInput m
s, g (GrammarFunctor m)
gd)(ParserInput m, g (GrammarFunctor m))
-> [(ParserInput m, g (GrammarFunctor m))]
-> [(ParserInput m, g (GrammarFunctor m))]
forall a. a -> [a] -> [a]
:[(ParserInput m, g (GrammarFunctor m))]
parsed
      where gd :: g (GrammarFunctor m)
gd = (forall a. m a -> GrammarFunctor m a)
-> g m -> g (GrammarFunctor m)
forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap (m a
-> [(ParserInput m, g (GrammarFunctor m))] -> GrammarFunctor m a
forall (m :: * -> *) (g :: (* -> *) -> *) r.
(TailsParsing m, GrammarConstraint m g) =>
m r
-> [(ParserInput m, g (GrammarFunctor m))] -> GrammarFunctor m r
forall (g :: (* -> *) -> *) r.
GrammarConstraint m g =>
m r
-> [(ParserInput m, g (GrammarFunctor m))] -> GrammarFunctor m r
`parseTails` [(ParserInput m, g (GrammarFunctor m))]
parsed) g m
final

-- | Parsers that can produce alternative parses and collect them into an 'Ambiguous' node
class Alternative m => AmbiguousParsing m where
   -- | Collect all alternative parses of the same length into a 'NonEmpty' list of results.
   ambiguous :: m a -> m (Ambiguous a)

-- | Parsers that can temporarily package and delay failure, in a way dual to Parsec's @try@ combinator. Where Parsec
-- would require something like
--
-- > alternatives  =  try intro1 *> expected1
-- >              <|> try intro2 *> expected2
-- >              <|> fallback
--
-- you can instead say
--
-- > alternatives = admit  $  intro1 *> commit expected1
-- >                      <|> intro2 *> commit expected2
-- >                      <|> commit fallback
--
-- A parsing failure inside an @intro@ parser leaves the other alternatives open, a failure inside an @expected@
-- parser bubbles up and out of the whole @admit@ block.
class Alternative m => CommittedParsing m where
   type CommittedResults m :: Type -> Type
   -- | Commits the argument parser to success.
   commit :: m a -> m (CommittedResults m a)
   -- | Admits a possible defeat of the argument parser.
   admit :: m (CommittedResults m a) -> m a
  
-- | If a grammar is 'Lexical', its parsers can instantiate the 'TokenParsing' class.
class (DeterministicParsing m, InputCharParsing m, TokenParsing m) => LexicalParsing m where
   -- | Always succeeds, consuming all white space and comments
   lexicalWhiteSpace :: m ()
   -- | Consumes all whitespace and comments, failing if there are none
   someLexicalSpace :: m ()
   -- | Consumes a single comment, defaults to 'empty'
   lexicalComment :: m ()
   -- | Consumes a single semicolon and any trailing whitespace, returning the character |';'|. The method can be
   -- overridden for automatic semicolon insertion, but if it succeeds on semicolon or white space input it must
   -- consume it.
   lexicalSemicolon :: m Char
   -- | Applies the argument parser and consumes the trailing 'lexicalWhitespace'
   lexicalToken :: m a -> m a
   -- | Applies the argument parser, determines whether its result is a legal identifier, and consumes the trailing
   -- 'lexicalWhitespace'
   identifierToken :: m (ParserInput m) -> m (ParserInput m)
   -- | Determines whether the given character can start an identifier token, allows only a letter or underscore by
   -- default
   isIdentifierStartChar :: Char -> Bool
   -- | Determines whether the given character can be any part of an identifier token, also allows numbers
   isIdentifierFollowChar :: Char -> Bool
   -- | Parses a valid identifier and consumes the trailing 'lexicalWhitespace'
   identifier :: m (ParserInput m)
   -- | Parses the argument word whole, not followed by any identifier character, and consumes the trailing
   -- 'lexicalWhitespace'
   keyword :: ParserInput m -> m ()

   default identifier :: TextualMonoid (ParserInput m) => m (ParserInput m)
   default keyword :: (Show (ParserInput m), TextualMonoid (ParserInput m)) => ParserInput m -> m ()

   lexicalWhiteSpace = (Char -> Bool) -> m (ParserInput m)
forall (m :: * -> *).
InputCharParsing m =>
(Char -> Bool) -> m (ParserInput m)
takeCharsWhile Char -> Bool
isSpace m (ParserInput m) -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m (ParserInput m) -> m ()
forall a. m a -> m ()
forall (m :: * -> *) a. DeterministicParsing m => m a -> m ()
skipAll (m ()
forall (m :: * -> *). LexicalParsing m => m ()
lexicalComment m () -> m (ParserInput m) -> m (ParserInput m)
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> m (ParserInput m)
forall (m :: * -> *).
InputCharParsing m =>
(Char -> Bool) -> m (ParserInput m)
takeCharsWhile Char -> Bool
isSpace)
   someLexicalSpace = (Char -> Bool) -> m (ParserInput m)
forall (m :: * -> *).
InputCharParsing m =>
(Char -> Bool) -> m (ParserInput m)
takeCharsWhile1 Char -> Bool
isSpace m (ParserInput m) -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (m ()
forall (m :: * -> *). LexicalParsing m => m ()
lexicalComment m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m ()
forall (m :: * -> *). LexicalParsing m => m ()
lexicalWhiteSpace m () -> m () -> m ()
forall a. m a -> m a -> m a
forall (m :: * -> *) a. DeterministicParsing m => m a -> m a -> m a
<<|> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
                      m () -> m () -> m ()
forall a. m a -> m a -> m a
forall (m :: * -> *) a. DeterministicParsing m => m a -> m a -> m a
<<|> m ()
forall (m :: * -> *). LexicalParsing m => m ()
lexicalComment m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m ()
forall (m :: * -> *). LexicalParsing m => m ()
lexicalWhiteSpace
                      m () -> String -> m ()
forall a. m a -> String -> m a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"whitespace"
   lexicalComment = m ()
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty
   lexicalSemicolon = m Char -> m Char
forall a. m a -> m a
forall (m :: * -> *) a. LexicalParsing m => m a -> m a
lexicalToken (Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
Text.Parser.Char.char Char
';')
   lexicalToken m a
p = m a
p m a -> m () -> m a
forall a b. m a -> m b -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m ()
forall (m :: * -> *). LexicalParsing m => m ()
lexicalWhiteSpace
   isIdentifierStartChar Char
c = Char -> Bool
isLetter Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'
   isIdentifierFollowChar Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'
   identifier = m (ParserInput m) -> m (ParserInput m)
forall (m :: * -> *).
LexicalParsing m =>
m (ParserInput m) -> m (ParserInput m)
identifierToken ((ParserInput m -> ParserInput m -> ParserInput m)
-> m (ParserInput m) -> m (ParserInput m) -> m (ParserInput m)
forall a b c. (a -> b -> c) -> m a -> m b -> m c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ParserInput m -> ParserInput m -> ParserInput m
forall a. Monoid a => a -> a -> a
mappend ((Char -> Bool) -> m (ParserInput m)
forall (m :: * -> *).
InputCharParsing m =>
(Char -> Bool) -> m (ParserInput m)
satisfyCharInput (forall (m :: * -> *). LexicalParsing m => Char -> Bool
isIdentifierStartChar @m))
                                                ((Char -> Bool) -> m (ParserInput m)
forall (m :: * -> *).
InputCharParsing m =>
(Char -> Bool) -> m (ParserInput m)
takeCharsWhile (forall (m :: * -> *). LexicalParsing m => Char -> Bool
isIdentifierFollowChar @m))) m (ParserInput m) -> String -> m (ParserInput m)
forall a. m a -> String -> m a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"an identifier"
   identifierToken = m (ParserInput m) -> m (ParserInput m)
forall a. m a -> m a
forall (m :: * -> *) a. LexicalParsing m => m a -> m a
lexicalToken
   keyword ParserInput m
s = m () -> m ()
forall a. m a -> m a
forall (m :: * -> *) a. LexicalParsing m => m a -> m a
lexicalToken (ParserInput m -> m (ParserInput m)
forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string ParserInput m
s m (ParserInput m) -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> m ()
forall (m :: * -> *). InputCharParsing m => (Char -> Bool) -> m ()
notSatisfyChar (forall (m :: * -> *). LexicalParsing m => Char -> Bool
isIdentifierFollowChar @m)) m () -> String -> m ()
forall a. m a -> String -> m a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> (String
"keyword " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ParserInput m -> String
forall a. Show a => a -> String
show ParserInput m
s)