{-# LANGUAGE TypeFamilies #-}
-- | 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(Applicative(..), Alternative(..))
import Data.List.NonEmpty (NonEmpty((:|)), fromList)
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 :: p a -> p a
moptional p a
p = 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 a
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 :: p a -> p a
concatMany p a
p = [a] -> a
forall a. Monoid a => [a] -> a
mconcat ([a] -> a) -> p [a] -> p a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p a -> p [a]
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 :: p a -> p a
concatSome p a
p = NonEmpty a -> a
forall a. Semigroup a => NonEmpty a -> a
sconcat (NonEmpty a -> a) -> p (NonEmpty a) -> p a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p a -> p (NonEmpty a)
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 :: p a -> p (NonEmpty a)
someNonEmpty p a
p = a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
(:|) (a -> [a] -> NonEmpty a) -> p a -> p ([a] -> NonEmpty a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p a
p p ([a] -> NonEmpty a) -> p [a] -> p (NonEmpty a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> p a -> p [a]
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 :: p a -> p Bool
flag 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 Int
n p a
p
   | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
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, LeftReductive s, s ~ ParserInput m, LexicalParsing m) => s -> m s
delimiter :: s -> m s
delimiter s
s = m s -> m s
forall (m :: * -> *) a. LexicalParsing m => m a -> m a
lexicalToken (ParserInput m -> m (ParserInput m)
forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string s
ParserInput m
s) m s -> String -> m s
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> (String
"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, LeftReductive s, s ~ ParserInput m, LexicalParsing m) => s -> m s
operator :: s -> m s
operator s
s = m s -> m s
forall (m :: * -> *) a. LexicalParsing m => m a -> m a
lexicalToken (ParserInput m -> m (ParserInput m)
forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string s
ParserInput m
s) m s -> String -> m s
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> (String
"operator " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> s -> String
forall a. Show a => a -> String
show s
s)