{-# LANGUAGE AllowAmbiguousTypes, ConstraintKinds, DefaultSignatures, OverloadedStrings, RankNTypes,
ScopedTypeVariables, TypeApplications, TypeFamilies, DeriveDataTypeable #-}
module Text.Grampa.Class (MultiParsing(..), GrammarParsing(..), AmbiguousParsing(..), MonoidParsing(..), Lexical(..),
ParseResults, ParseFailure(..), Ambiguous(..), Position, positionOffset, 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.List.NonEmpty (NonEmpty((:|)))
import Data.Data (Data)
import Data.Typeable (Typeable)
import Data.Monoid (Monoid(mempty, mappend))
import Data.Monoid.Cancellative (LeftReductiveMonoid)
import qualified Data.Monoid.Null as Null
import Data.Monoid.Null (MonoidNull)
import qualified Data.Monoid.Factorial as Factorial
import Data.Monoid.Factorial (FactorialMonoid)
import Data.Monoid.Textual (TextualMonoid)
import Data.Semigroup (Semigroup((<>)))
import Text.Parser.Combinators (Parsing((<?>)), skipMany)
import Text.Parser.Char (CharParsing(char))
import GHC.Exts (Constraint)
import qualified Rank2
type ParseResults = Either ParseFailure
data ParseFailure = ParseFailure Int [String] deriving (ParseFailure -> ParseFailure -> Bool
(ParseFailure -> ParseFailure -> Bool)
-> (ParseFailure -> ParseFailure -> Bool) -> Eq ParseFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParseFailure -> ParseFailure -> Bool
$c/= :: ParseFailure -> ParseFailure -> Bool
== :: ParseFailure -> ParseFailure -> Bool
$c== :: ParseFailure -> ParseFailure -> Bool
Eq, Int -> ParseFailure -> ShowS
[ParseFailure] -> ShowS
ParseFailure -> String
(Int -> ParseFailure -> ShowS)
-> (ParseFailure -> String)
-> ([ParseFailure] -> ShowS)
-> Show ParseFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseFailure] -> ShowS
$cshowList :: [ParseFailure] -> ShowS
show :: ParseFailure -> String
$cshow :: ParseFailure -> String
showsPrec :: Int -> ParseFailure -> ShowS
$cshowsPrec :: Int -> ParseFailure -> ShowS
Show)
newtype Position s = Position{
Position s -> Int
remainderLength :: Int}
positionOffset :: FactorialMonoid s => s -> Position s -> Int
positionOffset :: s -> Position s -> Int
positionOffset wholeInput :: s
wholeInput = (Int
wholeLength Int -> Int -> Int
forall a. Num a => a -> a -> a
-) (Int -> Int) -> (Position s -> Int) -> Position s -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position s -> Int
forall s. Position s -> Int
remainderLength
where wholeLength :: Int
wholeLength = s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
wholeInput
{-# INLINE positionOffset #-}
newtype Ambiguous a = Ambiguous (NonEmpty a) deriving (Typeable (Ambiguous a)
DataType
Constr
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 -> DataType
Ambiguous a -> Constr
(forall d. Data d => c (t d)) -> Maybe (c (Ambiguous a))
(forall b. Data b => b -> b) -> Ambiguous a -> Ambiguous a
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ambiguous a -> c (Ambiguous a)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Ambiguous a)
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 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))
$cAmbiguous :: Constr
$tAmbiguous :: DataType
gmapMo :: (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 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 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 :: 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 d. Data d => d -> u) -> Ambiguous a -> [u]
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> Ambiguous a -> [u]
gmapQr :: (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 :: (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 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 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 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 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)
$cp1Data :: forall a. Data a => Typeable (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
/= :: 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, 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
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
$cp1Ord :: forall a. Ord a => Eq (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
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 :: (Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> Ambiguous a -> ShowS
liftShowsPrec sp :: Int -> a -> ShowS
sp sl :: [a] -> ShowS
sl d :: Int
d (Ambiguous (h :: a
h :| l :: [a]
l)) t :: String
t
| Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 5 = "(Ambiguous $ " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> a -> ShowS
sp 0 a
h (" :| " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [a] -> ShowS
sl [a]
l (')' Char -> ShowS
forall a. a -> [a] -> [a]
: String
t))
| Bool
otherwise = "Ambiguous (" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> a -> ShowS
sp 0 a
h (" :| " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [a] -> ShowS
sl [a]
l (')' Char -> ShowS
forall a. a -> [a] -> [a]
: String
t))
instance Functor Ambiguous where
fmap :: (a -> b) -> Ambiguous a -> Ambiguous b
fmap f :: a -> b
f (Ambiguous a :: NonEmpty a
a) = NonEmpty b -> Ambiguous b
forall a. NonEmpty a -> Ambiguous a
Ambiguous ((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 :: a -> Ambiguous a
pure a :: a
a = NonEmpty a -> Ambiguous a
forall a. NonEmpty a -> Ambiguous a
Ambiguous (a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a)
Ambiguous f :: NonEmpty (a -> b)
f <*> :: Ambiguous (a -> b) -> Ambiguous a -> Ambiguous b
<*> Ambiguous a :: 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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NonEmpty a
a)
instance Foldable Ambiguous where
foldMap :: (a -> m) -> Ambiguous a -> m
foldMap f :: a -> m
f (Ambiguous a :: NonEmpty a
a) = (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 :: (a -> f b) -> Ambiguous a -> f (Ambiguous b)
traverse f :: a -> f b
f (Ambiguous a :: 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)
traverse a -> f b
f NonEmpty a
a
instance Semigroup a => Semigroup (Ambiguous a) where
Ambiguous xs :: NonEmpty a
xs <> :: Ambiguous a -> Ambiguous a -> Ambiguous a
<> Ambiguous ys :: NonEmpty a
ys = NonEmpty a -> Ambiguous a
forall a. NonEmpty a -> Ambiguous a
Ambiguous ((a -> a -> a) -> NonEmpty a -> NonEmpty a -> NonEmpty a
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
:| [])
Ambiguous xs :: NonEmpty a
xs mappend :: Ambiguous a -> Ambiguous a -> Ambiguous a
`mappend` Ambiguous ys :: NonEmpty a
ys = NonEmpty a -> Ambiguous a
forall a. NonEmpty a -> Ambiguous a
Ambiguous ((a -> a -> a) -> NonEmpty a -> NonEmpty a -> NonEmpty a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Monoid a => a -> a -> a
mappend NonEmpty a
xs NonEmpty a
ys)
completeParser :: MonoidNull s => Compose ParseResults (Compose [] ((,) s)) r -> Compose ParseResults [] r
completeParser :: Compose ParseResults (Compose [] ((,) s)) r
-> Compose ParseResults [] r
completeParser (Compose (Left failure :: ParseFailure
failure)) = Either ParseFailure [r] -> Compose ParseResults [] r
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (ParseFailure -> Either ParseFailure [r]
forall a b. a -> Either a b
Left ParseFailure
failure)
completeParser (Compose (Right (Compose results :: [(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 [] -> Either ParseFailure [r] -> Compose ParseResults [] r
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (ParseFailure -> Either ParseFailure [r]
forall a b. a -> Either a b
Left (ParseFailure -> Either ParseFailure [r])
-> ParseFailure -> Either ParseFailure [r]
forall a b. (a -> b) -> a -> b
$ Int -> [String] -> ParseFailure
ParseFailure 0 ["complete parse"])
completeResults :: [(s, r)]
completeResults -> Either ParseFailure [r] -> Compose ParseResults [] r
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose ([r] -> Either ParseFailure [r]
forall a b. b -> Either a b
Right ([r] -> Either ParseFailure [r]) -> [r] -> Either ParseFailure [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)
class MultiParsing m where
type ResultFunctor m :: * -> *
type GrammarConstraint m (g :: (* -> *) -> *) :: Constraint
type GrammarConstraint m g = Rank2.Functor g
parseComplete :: (GrammarConstraint m g, FactorialMonoid s) => g (m g s) -> s -> g (ResultFunctor m)
parsePrefix :: (GrammarConstraint m g, FactorialMonoid s) =>
g (m g s) -> s -> g (Compose (ResultFunctor m) ((,) s))
class MultiParsing m => GrammarParsing m where
type GrammarFunctor m :: ((* -> *) -> *) -> * -> * -> *
nonTerminal :: GrammarConstraint m g => (g (GrammarFunctor m g s) -> GrammarFunctor m g s a) -> m g s a
selfReferring :: (GrammarConstraint m g, Rank2.Distributive g) => g (m g s)
fixGrammar :: forall g s. (GrammarConstraint m g, Rank2.Distributive g) => (g (m g s) -> g (m g s)) -> g (m g s)
recursive :: m g s a -> m g s a
selfReferring = (forall a.
(g (GrammarFunctor m g s) -> GrammarFunctor m g s a) -> m g s a)
-> (g (GrammarFunctor m g s) -> g (GrammarFunctor m g s))
-> g (m g s)
forall k (g :: (k -> *) -> *) (m :: * -> *) (p :: k -> *)
(q :: k -> *).
(Distributive g, Functor m) =>
(forall (a :: k). m (p a) -> q a) -> m (g p) -> g q
Rank2.cotraverse forall a.
(g (GrammarFunctor m g s) -> GrammarFunctor m g s a) -> m g s a
forall (m :: ((* -> *) -> *) -> * -> * -> *) (g :: (* -> *) -> *) s
a.
(GrammarParsing m, GrammarConstraint m g) =>
(g (GrammarFunctor m g s) -> GrammarFunctor m g s a) -> m g s a
nonTerminal g (GrammarFunctor m g s) -> g (GrammarFunctor m g s)
forall a. a -> a
id
{-# INLINE selfReferring #-}
fixGrammar = ((g (m g s) -> g (m g s)) -> g (m g s) -> g (m g s)
forall a b. (a -> b) -> a -> b
$ g (m g s)
forall (m :: ((* -> *) -> *) -> * -> * -> *) (g :: (* -> *) -> *)
s.
(GrammarParsing m, GrammarConstraint m g, Distributive g) =>
g (m g s)
selfReferring)
{-# INLINE fixGrammar #-}
recursive = m g s a -> m g s a
forall a. a -> a
id
class MonoidParsing m where
endOfInput :: FactorialMonoid s => m s ()
getInput :: FactorialMonoid s => m s s
getSourcePos :: FactorialMonoid s => m s (Position s)
anyToken :: FactorialMonoid s => m s s
satisfy :: FactorialMonoid s => (s -> Bool) -> m s s
satisfyChar :: TextualMonoid s => (Char -> Bool) -> m s Char
satisfyCharInput :: TextualMonoid s => (Char -> Bool) -> m s s
notSatisfy :: FactorialMonoid s => (s -> Bool) -> m s ()
notSatisfyChar :: TextualMonoid s => (Char -> Bool) -> m s ()
scan :: FactorialMonoid t => s -> (s -> t -> Maybe s) -> m t t
scanChars :: TextualMonoid t => s -> (s -> Char -> Maybe s) -> m t t
string :: (FactorialMonoid s, LeftReductiveMonoid s, Show s) => s -> m s s
takeWhile :: FactorialMonoid s => (s -> Bool) -> m s s
takeWhile1 :: FactorialMonoid s => (s -> Bool) -> m s s
takeCharsWhile :: TextualMonoid s => (Char -> Bool) -> m s s
takeCharsWhile1 :: TextualMonoid s => (Char -> Bool) -> m s s
concatMany :: Monoid a => m s a -> m s a
default concatMany :: (Monoid a, Alternative (m s)) => m s a -> m s a
concatMany p :: m s a
p = m s a
go
where go :: m s a
go = a -> a -> a
forall a. Monoid a => a -> a -> a
mappend (a -> a -> a) -> m s a -> m s (a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m s a
p m s (a -> a) -> m s a -> m s a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m s a
go m s a -> m s a -> m s a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> m s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty
default getSourcePos :: (FactorialMonoid s, Functor (m s)) => m s (Position s)
getSourcePos = Int -> Position s
forall s. Int -> Position s
Position (Int -> Position s) -> (s -> Int) -> s -> Position s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Int
forall m. Factorial m => m -> Int
Factorial.length (s -> Position s) -> m s s -> m s (Position s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m s s
forall (m :: * -> * -> *) s.
(MonoidParsing m, FactorialMonoid s) =>
m s s
getInput
{-# INLINE concatMany #-}
{-# INLINE getSourcePos #-}
class AmbiguousParsing m where
ambiguous :: m a -> m (Ambiguous a)
class Lexical (g :: (* -> *) -> *) where
type LexicalConstraint (m :: ((* -> *) -> *) -> * -> * -> *) g s :: Constraint
lexicalWhiteSpace :: LexicalConstraint m g s => m g s ()
someLexicalSpace :: LexicalConstraint m g s => m g s ()
:: LexicalConstraint m g s => m g s ()
lexicalSemicolon :: LexicalConstraint m g s => m g s Char
lexicalToken :: LexicalConstraint m g s => m g s a -> m g s a
identifierToken :: LexicalConstraint m g s => m g s s -> m g s s
isIdentifierStartChar :: Char -> Bool
isIdentifierFollowChar :: Char -> Bool
identifier :: LexicalConstraint m g s => m g s s
keyword :: LexicalConstraint m g s => s -> m g s ()
type instance LexicalConstraint m g s = (Applicative (m g ()), Monad (m g s),
CharParsing (m g s), MonoidParsing (m g),
Show s, TextualMonoid s)
default :: Alternative (m g s) => m g s ()
default lexicalWhiteSpace :: (LexicalConstraint m g s, Parsing (m g s), MonoidParsing (m g), TextualMonoid s)
=> m g s ()
default someLexicalSpace :: (LexicalConstraint m g s, Parsing (m g s), MonoidParsing (m g), TextualMonoid s)
=> m g s ()
default lexicalSemicolon :: (LexicalConstraint m g s, CharParsing (m g s), MonoidParsing (m g), TextualMonoid s)
=> m g s Char
default lexicalToken :: (LexicalConstraint m g s, Parsing (m g s), MonoidParsing (m g), TextualMonoid s)
=> m g s a -> m g s a
default identifierToken :: (LexicalConstraint m g s, Parsing (m g s), MonoidParsing (m g), TextualMonoid s)
=> m g s s -> m g s s
default identifier :: (LexicalConstraint m g s, Monad (m g s), Alternative (m g s),
Parsing (m g s), MonoidParsing (m g), TextualMonoid s) => m g s s
default keyword :: (LexicalConstraint m g s, Parsing (m g s), MonoidParsing (m g), Show s, TextualMonoid s)
=> s -> m g s ()
lexicalWhiteSpace = (Char -> Bool) -> m g s s
forall (m :: * -> * -> *) s.
(MonoidParsing m, TextualMonoid s) =>
(Char -> Bool) -> m s s
takeCharsWhile Char -> Bool
isSpace m g s s -> m g s () -> m g s ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m g s s -> m g s ()
forall (m :: * -> *) a. Parsing m => m a -> m ()
skipMany (m g s ()
forall (g :: (* -> *) -> *) (m :: ((* -> *) -> *) -> * -> * -> *)
s.
(Lexical g, LexicalConstraint m g s) =>
m g s ()
lexicalComment m g s () -> m g s s -> m g s s
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> m g s s
forall (m :: * -> * -> *) s.
(MonoidParsing m, TextualMonoid s) =>
(Char -> Bool) -> m s s
takeCharsWhile Char -> Bool
isSpace)
someLexicalSpace = (Char -> Bool) -> m g s s
forall (m :: * -> * -> *) s.
(MonoidParsing m, TextualMonoid s) =>
(Char -> Bool) -> m s s
takeCharsWhile1 Char -> Bool
isSpace m g s s -> m g s () -> m g s ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m g s s -> m g s ()
forall (m :: * -> *) a. Parsing m => m a -> m ()
skipMany (m g s ()
forall (g :: (* -> *) -> *) (m :: ((* -> *) -> *) -> * -> * -> *)
s.
(Lexical g, LexicalConstraint m g s) =>
m g s ()
lexicalComment m g s () -> m g s s -> m g s s
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> m g s s
forall (m :: * -> * -> *) s.
(MonoidParsing m, TextualMonoid s) =>
(Char -> Bool) -> m s s
takeCharsWhile Char -> Bool
isSpace)
m g s () -> m g s () -> m g s ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m g s ()
forall (g :: (* -> *) -> *) (m :: ((* -> *) -> *) -> * -> * -> *)
s.
(Lexical g, LexicalConstraint m g s) =>
m g s ()
lexicalComment m g s () -> m g s () -> m g s ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m g s () -> m g s ()
forall (m :: * -> *) a. Parsing m => m a -> m ()
skipMany ((Char -> Bool) -> m g s s
forall (m :: * -> * -> *) s.
(MonoidParsing m, TextualMonoid s) =>
(Char -> Bool) -> m s s
takeCharsWhile Char -> Bool
isSpace m g s s -> m g s () -> m g s ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m g s ()
forall (g :: (* -> *) -> *) (m :: ((* -> *) -> *) -> * -> * -> *)
s.
(Lexical g, LexicalConstraint m g s) =>
m g s ()
lexicalComment)
lexicalComment = m g s ()
forall (f :: * -> *) a. Alternative f => f a
empty
lexicalSemicolon = m g s Char -> m g s Char
forall (g :: (* -> *) -> *) (m :: ((* -> *) -> *) -> * -> * -> *) s
a.
(Lexical g, LexicalConstraint m g s) =>
m g s a -> m g s a
lexicalToken (Char -> m g s Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char ';')
lexicalToken p :: m g s a
p = m g s a
p m g s a -> m g s () -> m g s a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m g s ()
forall (g :: (* -> *) -> *) (m :: ((* -> *) -> *) -> * -> * -> *)
s.
(Lexical g, LexicalConstraint m g s) =>
m g s ()
lexicalWhiteSpace
isIdentifierStartChar c :: Char
c = Char -> Bool
isLetter Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '_'
isIdentifierFollowChar c :: Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '_'
identifier = m g s s -> m g s s
forall (g :: (* -> *) -> *) (m :: ((* -> *) -> *) -> * -> * -> *)
s.
(Lexical g, LexicalConstraint m g s) =>
m g s s -> m g s s
identifierToken ((s -> s -> s) -> m g s s -> m g s s -> m g s s
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 s -> s -> s
forall a. Monoid a => a -> a -> a
mappend ((Char -> Bool) -> m g s s
forall (m :: * -> * -> *) s.
(MonoidParsing m, TextualMonoid s) =>
(Char -> Bool) -> m s s
satisfyCharInput (Lexical g => Char -> Bool
forall (g :: (* -> *) -> *). Lexical g => Char -> Bool
isIdentifierStartChar @g))
((Char -> Bool) -> m g s s
forall (m :: * -> * -> *) s.
(MonoidParsing m, TextualMonoid s) =>
(Char -> Bool) -> m s s
takeCharsWhile (Lexical g => Char -> Bool
forall (g :: (* -> *) -> *). Lexical g => Char -> Bool
isIdentifierFollowChar @g))) m g s s -> String -> m g s s
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> "an identifier"
identifierToken = m g s s -> m g s s
forall (g :: (* -> *) -> *) (m :: ((* -> *) -> *) -> * -> * -> *) s
a.
(Lexical g, LexicalConstraint m g s) =>
m g s a -> m g s a
lexicalToken
keyword s :: s
s = m g s () -> m g s ()
forall (g :: (* -> *) -> *) (m :: ((* -> *) -> *) -> * -> * -> *) s
a.
(Lexical g, LexicalConstraint m g s) =>
m g s a -> m g s a
lexicalToken (s -> m g s s
forall (m :: * -> * -> *) s.
(MonoidParsing m, FactorialMonoid s, LeftReductiveMonoid s,
Show s) =>
s -> m s s
string s
s m g s s -> m g s () -> m g s ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> m g s ()
forall (m :: * -> * -> *) s.
(MonoidParsing m, TextualMonoid s) =>
(Char -> Bool) -> m s ()
notSatisfyChar (Lexical g => Char -> Bool
forall (g :: (* -> *) -> *). Lexical g => Char -> Bool
isIdentifierFollowChar @g)) m g s () -> String -> m g s ()
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> ("keyword " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> s -> String
forall a. Show a => a -> String
show s
s)