{-# LANGUAGE TypeFamilies, TypeOperators #-}
module Text.Grampa.Combinators (moptional, concatMany, concatSome, someNonEmpty,
flag, count, upto,
delimiter, operator, keyword) where
import Control.Applicative(Alternative(..))
import Data.List.NonEmpty (NonEmpty((:|)))
import Data.Monoid (Monoid, (<>))
import Data.Monoid.Factorial (FactorialMonoid)
import Data.Semigroup (Semigroup(sconcat))
import Data.Semigroup.Cancellative (LeftReductive)
import Text.Grampa.Class (InputParsing(ParserInput, string), LexicalParsing(lexicalToken, keyword))
import Text.Parser.Combinators (Parsing((<?>)), count)
moptional :: (Alternative p, Monoid a) => p a -> p a
moptional :: forall (p :: * -> *) a. (Alternative p, Monoid a) => p a -> p a
moptional p a
p = p a
p forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
concatMany :: (Alternative p, Monoid a) => p a -> p a
concatMany :: forall (p :: * -> *) a. (Alternative p, Monoid a) => p a -> p a
concatMany p a
p = forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many p a
p
concatSome :: (Alternative p, Semigroup a) => p a -> p a
concatSome :: forall (p :: * -> *) a. (Alternative p, Semigroup a) => p a -> p a
concatSome p a
p = forall a. Semigroup a => NonEmpty a -> a
sconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (p :: * -> *) a. Alternative p => p a -> p (NonEmpty a)
someNonEmpty p a
p
someNonEmpty :: Alternative p => p a -> p (NonEmpty a)
someNonEmpty :: forall (p :: * -> *) a. Alternative p => p a -> p (NonEmpty a)
someNonEmpty p a
p = forall a. a -> [a] -> NonEmpty a
(:|) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p a
p forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many p a
p
flag :: Alternative p => p a -> p Bool
flag :: forall (p :: * -> *) a. Alternative p => p a -> p Bool
flag p a
p = Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ p a
p forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
upto :: Alternative p => Int -> p a -> p [a]
upto :: forall (p :: * -> *) a. Alternative p => Int -> p a -> p [a]
upto Int
n p a
p
| Int
n forall a. Ord a => a -> a -> Bool
> Int
0 = (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p a
p forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (p :: * -> *) a. Alternative p => Int -> p a -> p [a]
upto (forall a. Enum a => a -> a
pred Int
n) p a
p
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
| Bool
otherwise = forall (f :: * -> *) a. Applicative f => a -> f a
pure []
delimiter :: (Show s, FactorialMonoid s, LeftReductive s, s ~ ParserInput m, LexicalParsing m) => s -> m s
delimiter :: forall s (m :: * -> *).
(Show s, FactorialMonoid s, LeftReductive s, s ~ ParserInput m,
LexicalParsing m) =>
s -> m s
delimiter s
s = forall (m :: * -> *) a. LexicalParsing m => m a -> m a
lexicalToken (forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string s
s) forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> (String
"delimiter " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show s
s)
operator :: (Show s, FactorialMonoid s, LeftReductive s, s ~ ParserInput m, LexicalParsing m) => s -> m s
operator :: forall s (m :: * -> *).
(Show s, FactorialMonoid s, LeftReductive s, s ~ ParserInput m,
LexicalParsing m) =>
s -> m s
operator s
s = forall (m :: * -> *) a. LexicalParsing m => m a -> m a
lexicalToken (forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string s
s) forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> (String
"operator " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show s
s)