module Text.Grampa.Combinators (moptional, concatMany, concatSome,
                                flag, count, upto,
                                delimiter, operator, keyword) where

import Control.Applicative(Applicative(..), Alternative(..))
import Data.Monoid.Cancellative (LeftReductiveMonoid)
import Data.Monoid (Monoid, (<>))
import Data.Monoid.Factorial (FactorialMonoid)

import Text.Grampa.Class (MonoidParsing(concatMany, string), 
                          Lexical(LexicalConstraint, lexicalToken, keyword))
import Text.Parser.Combinators (Parsing((<?>)), count)

-- | Attempts to parse a monoidal value, if the argument parser fails returns 'mempty'.
moptional :: (Monoid x, Alternative p) => p x -> p x
moptional :: p x -> p x
moptional p :: p x
p = p x
p p x -> p x -> p x
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> x -> p x
forall (f :: * -> *) a. Applicative f => a -> f a
pure x
forall a. Monoid a => a
mempty

-- | One or more argument occurrences like 'some', with concatenated monoidal results.
concatSome :: (Monoid x, Applicative (p s), MonoidParsing p) => p s x -> p s x
concatSome :: p s x -> p s x
concatSome p :: p s x
p = x -> x -> x
forall a. Semigroup a => a -> a -> a
(<>) (x -> x -> x) -> p s x -> p s (x -> x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p s x
p p s (x -> x) -> p s x -> p s x
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> p s x -> p s x
forall (m :: * -> * -> *) a s.
(MonoidParsing m, Monoid a) =>
m s a -> m s a
concatMany p s x
p

-- | Returns 'True' if the argument parser succeeds and 'False' otherwise.
flag :: Alternative p => p a -> p Bool
flag :: p a -> p Bool
flag p :: p a
p = Bool
True Bool -> p a -> p Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ p a
p p Bool -> p Bool -> p Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> p Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False

-- | Parses between 0 and N occurrences of the argument parser in sequence and returns the list of results.
upto :: Alternative p => Int -> p a -> p [a]
upto :: Int -> p a -> p [a]
upto n :: Int
n p :: p a
p
   | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = (:) (a -> [a] -> [a]) -> p a -> p ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p a
p p ([a] -> [a]) -> p [a] -> p [a]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> p a -> p [a]
forall (p :: * -> *) a. Alternative p => Int -> p a -> p [a]
upto (Int -> Int
forall a. Enum a => a -> a
pred Int
n) p a
p 
             p [a] -> p [a] -> p [a]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [a] -> p [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
   | Bool
otherwise = [a] -> p [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

-- | Parses the given delimiter, such as a comma or a brace
delimiter :: (Show s, FactorialMonoid s, LeftReductiveMonoid s,
              Parsing (p g s), MonoidParsing (p g), Lexical g, LexicalConstraint p g s) => s -> p g s s
delimiter :: s -> p g s s
delimiter s :: s
s = p g s s -> p g s s
forall (g :: (* -> *) -> *) (m :: ((* -> *) -> *) -> * -> * -> *) s
       a.
(Lexical g, LexicalConstraint m g s) =>
m g s a -> m g s a
lexicalToken (s -> p g s s
forall (m :: * -> * -> *) s.
(MonoidParsing m, FactorialMonoid s, LeftReductiveMonoid s,
 Show s) =>
s -> m s s
string s
s) p g s s -> String -> p g s s
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> ("delimiter " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> s -> String
forall a. Show a => a -> String
show s
s)

-- | Parses the given operator symbol
operator :: (Show s, FactorialMonoid s, LeftReductiveMonoid s,
             Parsing (p g s), MonoidParsing (p g), Lexical g, LexicalConstraint p g s) => s -> p g s s
operator :: s -> p g s s
operator s :: s
s = p g s s -> p g s s
forall (g :: (* -> *) -> *) (m :: ((* -> *) -> *) -> * -> * -> *) s
       a.
(Lexical g, LexicalConstraint m g s) =>
m g s a -> m g s a
lexicalToken (s -> p g s s
forall (m :: * -> * -> *) s.
(MonoidParsing m, FactorialMonoid s, LeftReductiveMonoid s,
 Show s) =>
s -> m s s
string s
s) p g s s -> String -> p g s s
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> ("operator " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> s -> String
forall a. Show a => a -> String
show s
s)