{-# LANGUAGE AllowAmbiguousTypes, ConstraintKinds, DefaultSignatures, DeriveDataTypeable, DeriveFunctor,
FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, OverloadedStrings,
RankNTypes, ScopedTypeVariables, TypeApplications, TypeFamilies, TypeOperators, TypeSynonymInstances,
UndecidableInstances #-}
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)
type ParseResults s = Either (ParseFailure Pos s)
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,
forall pos s. ParseFailure pos s -> [String]
errorAlternatives :: [String]
}
deriving (ParseFailure pos s -> ParseFailure pos s -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
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
$c== :: forall pos s.
(Eq pos, Eq s) =>
ParseFailure pos s -> ParseFailure pos s -> Bool
Eq, 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
<$ :: forall a b. a -> ParseFailure pos b -> ParseFailure pos a
$c<$ :: forall pos a b. a -> ParseFailure pos b -> ParseFailure pos a
fmap :: forall a b. (a -> b) -> ParseFailure pos a -> ParseFailure pos b
$cfmap :: forall pos a b.
(a -> b) -> ParseFailure pos a -> ParseFailure pos b
Functor, Int -> ParseFailure pos s -> ShowS
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
showList :: [ParseFailure pos s] -> ShowS
$cshowList :: forall pos s. (Show pos, Show s) => [ParseFailure pos s] -> ShowS
show :: ParseFailure pos s -> String
$cshow :: forall pos s. (Show pos, Show s) => ParseFailure pos s -> String
showsPrec :: Int -> ParseFailure pos s -> ShowS
$cshowsPrec :: forall pos s.
(Show pos, Show s) =>
Int -> ParseFailure pos s -> ShowS
Show)
type Pos = Down Int
data FailureDescription s = FailureDescription {forall s. FailureDescription s -> [String]
staticDescriptions :: [String],
forall s. FailureDescription s -> [s]
literalDescriptions :: [s]}
deriving (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
<$ :: forall a b. a -> FailureDescription b -> FailureDescription a
$c<$ :: forall a b. a -> FailureDescription b -> FailureDescription a
fmap :: forall a b.
(a -> b) -> FailureDescription a -> FailureDescription b
$cfmap :: forall a b.
(a -> b) -> FailureDescription a -> FailureDescription b
Functor, FailureDescription s -> FailureDescription s -> Bool
forall s.
Eq s =>
FailureDescription s -> FailureDescription s -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FailureDescription s -> FailureDescription s -> Bool
$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
Eq, FailureDescription s -> FailureDescription s -> Bool
FailureDescription s -> FailureDescription s -> Ordering
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
min :: FailureDescription s
-> FailureDescription s -> FailureDescription s
$cmin :: forall s.
Ord s =>
FailureDescription s
-> FailureDescription s -> FailureDescription s
max :: FailureDescription s
-> FailureDescription s -> FailureDescription s
$cmax :: forall s.
Ord s =>
FailureDescription s
-> FailureDescription s -> FailureDescription s
>= :: 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
$c< :: forall s.
Ord s =>
FailureDescription s -> FailureDescription s -> Bool
compare :: FailureDescription s -> FailureDescription s -> Ordering
$ccompare :: forall s.
Ord s =>
FailureDescription s -> FailureDescription s -> Ordering
Ord, ReadPrec [FailureDescription s]
ReadPrec (FailureDescription s)
ReadS [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
readListPrec :: ReadPrec [FailureDescription s]
$creadListPrec :: forall s. Read s => ReadPrec [FailureDescription s]
readPrec :: ReadPrec (FailureDescription s)
$creadPrec :: forall s. Read s => ReadPrec (FailureDescription s)
readList :: ReadS [FailureDescription s]
$creadList :: forall s. Read s => ReadS [FailureDescription s]
readsPrec :: Int -> ReadS (FailureDescription s)
$creadsPrec :: forall s. Read s => Int -> ReadS (FailureDescription s)
Read, Int -> FailureDescription s -> ShowS
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
showList :: [FailureDescription s] -> ShowS
$cshowList :: forall s. Show s => [FailureDescription s] -> ShowS
show :: FailureDescription s -> String
$cshow :: forall s. Show s => FailureDescription s -> String
showsPrec :: Int -> FailureDescription s -> ShowS
$cshowsPrec :: forall s. Show s => Int -> 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) = 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 forall a. Ord a => a -> a -> Bool
> pos
pos2 = ParseFailure pos s
f1
| pos
pos1 forall a. Ord a => a -> a -> Bool
< pos
pos2 = ParseFailure pos s
f2
| Bool
otherwise = forall pos s.
pos -> FailureDescription s -> [String] -> ParseFailure pos s
ParseFailure pos
pos1 (FailureDescription s
exp1 forall a. Semigroup a => a -> a -> a
<> FailureDescription s
exp2) (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 =
forall s. [String] -> [s] -> FailureDescription s
FailureDescription
(forall a. Ord a => [a] -> [a] -> [a]
mergeSorted (forall s. FailureDescription s -> [String]
staticDescriptions FailureDescription s
exp1) (forall s. FailureDescription s -> [String]
staticDescriptions FailureDescription s
exp2))
(forall a. Ord a => [a] -> [a] -> [a]
mergeSorted (forall s. FailureDescription s -> [s]
literalDescriptions FailureDescription s
exp1) (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 forall a. Ord a => a -> a -> Bool
< a
y = a
x forall a. a -> [a] -> [a]
: forall a. Ord a => [a] -> [a] -> [a]
mergeSorted [a]
xs' [a]
ys
| a
x forall a. Ord a => a -> a -> Bool
> a
y = a
y forall a. a -> [a] -> [a]
: forall a. Ord a => [a] -> [a] -> [a]
mergeSorted [a]
xs [a]
ys'
| Bool
otherwise = a
x forall 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 = forall pos s.
pos -> FailureDescription s -> [String] -> ParseFailure pos s
ParseFailure (forall a. a -> Down a
Down forall a. Bounded a => a
maxBound) forall a. Monoid a => a
mempty []
mappend :: ParseFailure Pos s -> ParseFailure Pos s -> ParseFailure Pos s
mappend = forall a. Semigroup a => a -> a -> a
(<>)
instance Ord s => Monoid (FailureDescription s) where
mempty :: FailureDescription s
mempty = forall s. [String] -> [s] -> FailureDescription s
FailureDescription forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty
newtype Ambiguous a = Ambiguous{forall a. Ambiguous a -> NonEmpty a
getAmbiguous :: NonEmpty a} deriving (Ambiguous a -> DataType
Ambiguous a -> Constr
forall {a}. Data a => Typeable (Ambiguous a)
forall a. Data a => Ambiguous a -> DataType
forall a. Data a => Ambiguous a -> Constr
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 (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))
gmapMo :: 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)
gmapMp :: forall (m :: * -> *).
MonadPlus 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)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Ambiguous a -> m (Ambiguous a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Ambiguous a -> m (Ambiguous a)
gmapQi :: forall u. Int -> (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
gmapQ :: forall u. (forall d. Data d => d -> u) -> Ambiguous a -> [u]
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> Ambiguous a -> [u]
gmapQr :: 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
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Ambiguous a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Ambiguous a -> r
gmapT :: (forall b. Data b => b -> b) -> Ambiguous a -> Ambiguous a
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> Ambiguous a -> Ambiguous a
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> 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))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Ambiguous a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Ambiguous a))
dataTypeOf :: Ambiguous a -> DataType
$cdataTypeOf :: forall a. Data a => Ambiguous a -> DataType
toConstr :: Ambiguous a -> Constr
$ctoConstr :: forall a. Data a => Ambiguous a -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> 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)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ambiguous a -> 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)
Data, Ambiguous a -> Ambiguous a -> Bool
forall a. Eq a => Ambiguous a -> Ambiguous a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ambiguous a -> Ambiguous a -> Bool
$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
Eq, 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
min :: Ambiguous a -> Ambiguous a -> Ambiguous a
$cmin :: forall a. Ord a => Ambiguous a -> Ambiguous a -> Ambiguous a
max :: Ambiguous a -> Ambiguous a -> Ambiguous a
$cmax :: forall a. Ord a => Ambiguous a -> Ambiguous a -> Ambiguous a
>= :: 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
$c< :: forall a. Ord a => Ambiguous a -> Ambiguous a -> Bool
compare :: Ambiguous a -> Ambiguous a -> Ordering
$ccompare :: forall a. Ord a => Ambiguous a -> Ambiguous a -> Ordering
Ord, Int -> Ambiguous a -> ShowS
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
showList :: [Ambiguous a] -> ShowS
$cshowList :: forall a. Show a => [Ambiguous a] -> ShowS
show :: Ambiguous a -> String
$cshow :: forall a. Show a => Ambiguous a -> String
showsPrec :: Int -> Ambiguous a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> 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 forall a. Ord a => a -> a -> Bool
> Int
5 = String
"(Ambiguous $ " forall a. Semigroup a => a -> a -> a
<> Int -> a -> ShowS
sp Int
0 a
h (String
" :| " forall a. Semigroup a => a -> a -> a
<> [a] -> ShowS
sl [a]
l (Char
')' forall a. a -> [a] -> [a]
: String
t))
| Bool
otherwise = String
"Ambiguous (" forall a. Semigroup a => a -> a -> a
<> Int -> a -> ShowS
sp Int
0 a
h (String
" :| " forall a. Semigroup a => a -> a -> a
<> [a] -> ShowS
sl [a]
l (Char
')' 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) = forall a. NonEmpty a -> Ambiguous a
Ambiguous (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 = forall a. NonEmpty a -> Ambiguous a
Ambiguous (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 = forall a. NonEmpty a -> Ambiguous a
Ambiguous (NonEmpty (a -> b)
f 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 = 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 = forall a. NonEmpty a -> Ambiguous a
Ambiguous (NonEmpty a
a forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Ambiguous a -> NonEmpty a
getAmbiguous 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) = 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) = forall a. NonEmpty a -> Ambiguous a
Ambiguous forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t 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 = forall a. NonEmpty a -> Ambiguous a
Ambiguous (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Semigroup a => a -> a -> a
(<>) NonEmpty a
xs NonEmpty a
ys)
instance Monoid a => Monoid (Ambiguous a) where
mempty :: Ambiguous a
mempty = forall a. NonEmpty a -> Ambiguous a
Ambiguous (forall a. Monoid a => a
mempty forall a. a -> [a] -> NonEmpty a
:| [])
mappend :: Ambiguous a -> Ambiguous a -> Ambiguous a
mappend = 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)) = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (forall a b. a -> Either a b
Left ParseFailure Pos s
failure)
completeParser (Compose (Right (Compose [(s, r)]
results))) =
case forall a. (a -> Bool) -> [a] -> [a]
filter (forall m. MonoidNull m => m -> Bool
Null.null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(s, r)]
results
of [] -> forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall pos s.
pos -> FailureDescription s -> [String] -> ParseFailure pos s
ParseFailure Pos
0 (forall s. [String] -> [s] -> FailureDescription s
FailureDescription [String
"a complete parse"] []) [])
[(s, r)]
completeResults -> forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(s, r)]
completeResults)
class InputParsing m => MultiParsing m where
type ResultFunctor m :: Type -> Type
type GrammarConstraint m (g :: (Type -> Type) -> Type) :: Constraint
type GrammarConstraint m g = Rank2.Functor g
parseComplete :: (ParserInput m ~ s, GrammarConstraint m g, Eq s, FactorialMonoid s) =>
g m -> s -> g (ResultFunctor m)
parsePrefix :: (ParserInput m ~ s, GrammarConstraint m g, Eq s, FactorialMonoid s) =>
g m -> s -> g (Compose (ResultFunctor m) ((,) s))
class MultiParsing m => GrammarParsing m where
type ParserGrammar m :: (Type -> Type) -> Type
type GrammarFunctor m :: Type -> Type
parsingResult :: ParserInput m -> GrammarFunctor m a -> ResultFunctor m (ParserInput m, a)
nonTerminal :: (g ~ ParserGrammar m, GrammarConstraint m g) => (g (GrammarFunctor m) -> GrammarFunctor m a) -> m a
selfReferring :: (g ~ ParserGrammar m, GrammarConstraint m g, Rank2.Distributive g) => g m
fixGrammar :: (g ~ ParserGrammar m, GrammarConstraint m g, Rank2.Distributive g) => (g m -> g m) -> g m
recursive :: m a -> m a
chainRecursive :: (g ~ ParserGrammar m, f ~ GrammarFunctor m, GrammarConstraint m g)
=> (f a -> g f -> g f)
-> m a
-> m a
-> m a
chainLongestRecursive :: (g ~ ParserGrammar m, f ~ GrammarFunctor m, GrammarConstraint m g)
=> (f a -> g f -> g f)
-> m a
-> m a
-> m a
selfReferring = 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
Rank2.cotraverse forall (m :: * -> *) (g :: (* -> *) -> *) a.
(GrammarParsing m, g ~ ParserGrammar m, GrammarConstraint m g) =>
(g (GrammarFunctor m) -> GrammarFunctor m a) -> m a
nonTerminal forall a. a -> a
id
{-# INLINE selfReferring #-}
fixGrammar = (forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (g :: (* -> *) -> *).
(GrammarParsing m, g ~ ParserGrammar m, GrammarConstraint m g,
Distributive g) =>
g m
selfReferring)
{-# INLINE fixGrammar #-}
recursive = forall a. a -> a
id
class GrammarParsing m => TailsParsing m where
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)forall a. a -> [a] -> [a]
:[(ParserInput m, g (GrammarFunctor m))]
parsed
where gd :: g (GrammarFunctor m)
gd = forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap (forall (m :: * -> *) (g :: (* -> *) -> *) r.
(TailsParsing m, GrammarConstraint m g) =>
m r
-> [(ParserInput m, g (GrammarFunctor m))] -> GrammarFunctor m r
`parseTails` [(ParserInput m, g (GrammarFunctor m))]
parsed) g m
final
class Alternative m => AmbiguousParsing m where
ambiguous :: m a -> m (Ambiguous a)
class Alternative m => CommittedParsing m where
type CommittedResults m :: Type -> Type
commit :: m a -> m (CommittedResults m a)
admit :: m (CommittedResults m a) -> m a
class (DeterministicParsing m, InputCharParsing m, TokenParsing m) => LexicalParsing m where
lexicalWhiteSpace :: m ()
someLexicalSpace :: m ()
:: m ()
lexicalSemicolon :: m Char
lexicalToken :: m a -> m a
identifierToken :: m (ParserInput m) -> m (ParserInput m)
isIdentifierStartChar :: Char -> Bool
isIdentifierFollowChar :: Char -> Bool
identifier :: m (ParserInput m)
keyword :: ParserInput m -> m ()
default identifier :: TextualMonoid (ParserInput m) => m (ParserInput m)
default keyword :: (Show (ParserInput m), TextualMonoid (ParserInput m)) => ParserInput m -> m ()
lexicalWhiteSpace = forall (m :: * -> *).
InputCharParsing m =>
(Char -> Bool) -> m (ParserInput m)
takeCharsWhile Char -> Bool
isSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a. DeterministicParsing m => m a -> m ()
skipAll (forall (m :: * -> *). LexicalParsing m => m ()
lexicalComment forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *).
InputCharParsing m =>
(Char -> Bool) -> m (ParserInput m)
takeCharsWhile Char -> Bool
isSpace)
someLexicalSpace = forall (m :: * -> *).
InputCharParsing m =>
(Char -> Bool) -> m (ParserInput m)
takeCharsWhile1 Char -> Bool
isSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (forall (m :: * -> *). LexicalParsing m => m ()
lexicalComment forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). LexicalParsing m => m ()
lexicalWhiteSpace forall (m :: * -> *) a. DeterministicParsing m => m a -> m a -> m a
<<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
forall (m :: * -> *) a. DeterministicParsing m => m a -> m a -> m a
<<|> forall (m :: * -> *). LexicalParsing m => m ()
lexicalComment forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). LexicalParsing m => m ()
lexicalWhiteSpace
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"whitespace"
lexicalComment = forall (f :: * -> *) a. Alternative f => f a
empty
lexicalSemicolon = forall (m :: * -> *) a. LexicalParsing m => m a -> m a
lexicalToken (forall (m :: * -> *). CharParsing m => Char -> m Char
Text.Parser.Char.char Char
';')
lexicalToken m a
p = m a
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). LexicalParsing m => m ()
lexicalWhiteSpace
isIdentifierStartChar Char
c = Char -> Bool
isLetter Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'_'
isIdentifierFollowChar Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'_'
identifier = forall (m :: * -> *).
LexicalParsing m =>
m (ParserInput m) -> m (ParserInput m)
identifierToken (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Monoid a => a -> a -> a
mappend (forall (m :: * -> *).
InputCharParsing m =>
(Char -> Bool) -> m (ParserInput m)
satisfyCharInput (forall (m :: * -> *). LexicalParsing m => Char -> Bool
isIdentifierStartChar @m))
(forall (m :: * -> *).
InputCharParsing m =>
(Char -> Bool) -> m (ParserInput m)
takeCharsWhile (forall (m :: * -> *). LexicalParsing m => Char -> Bool
isIdentifierFollowChar @m))) forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"an identifier"
identifierToken = forall (m :: * -> *) a. LexicalParsing m => m a -> m a
lexicalToken
keyword ParserInput m
s = forall (m :: * -> *) a. LexicalParsing m => m a -> m a
lexicalToken (forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string ParserInput m
s forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). InputCharParsing m => (Char -> Bool) -> m ()
notSatisfyChar (forall (m :: * -> *). LexicalParsing m => Char -> Bool
isIdentifierFollowChar @m)) forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> (String
"keyword " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show ParserInput m
s)