{-# LANGUAGE TypeFamilies, TypeOperators #-}
-- | A collection of useful parsing combinators not found in dependent libraries.
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)

-- | Attempts to parse a monoidal value, if the argument parser fails returns 'mempty'.
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

-- | Zero or more argument occurrences like 'many', with concatenated monoidal results.
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

-- | One or more argument occurrences like 'some', with concatenated monoidal results.
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

-- | One or more argument occurrences like 'some', returned in a 'NonEmpty' list.
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

-- | Returns 'True' if the argument parser succeeds and 'False' otherwise.
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

-- | 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 :: 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 []

-- | Parses the given delimiter, such as a comma or a brace
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)

-- | Parses the given operator symbol
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)