{-# LANGUAGE UndecidableInstances #-}

module ParserCombinators (IsMatch(..), satisfies, contains, notContains,
                          times, maybeTimes, anyTimes, someTimes, manyTimes,
                          within, maybeWithin, withinBoth, maybeWithinBoth,
                          anySeparatedBy, someSeparatedBy, manySeparatedBy,
                          (<|>), (<&>), (<#>), (>>>), (|?), (|*), (|+), (|++))  where

import Parser (Parser, char, isMatch, check, anyOf, allOf, except)
import Utils.Foldable (hasSome, hasMany)
import Utils.String (ToString(..))
import Utils.Applicative (extract)
import qualified Data.Foldable as Foldable

import Data.Maybe (listToMaybe)
import Data.List (isInfixOf)


class IsMatch a where
  is      :: a -> Parser a
  isNot   :: a -> Parser a
  oneOf   :: [a] -> Parser a
  noneOf  :: [a] -> Parser a
  inverse :: Parser a -> Parser a

  oneOf [a]
xs  = [Parser a] -> Parser a
forall a. [Parser a] -> Parser a
anyOf ([Parser a] -> Parser a) -> [Parser a] -> Parser a
forall a b. (a -> b) -> a -> b
$ a -> Parser a
forall a. IsMatch a => a -> Parser a
is (a -> Parser a) -> [a] -> [Parser a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
xs
  noneOf [a]
xs = [Parser a] -> Parser a
forall a. [Parser a] -> Parser a
allOf ([Parser a] -> Parser a) -> [Parser a] -> Parser a
forall a b. (a -> b) -> a -> b
$ a -> Parser a
forall a. IsMatch a => a -> Parser a
isNot (a -> Parser a) -> [a] -> [Parser a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
xs


instance IsMatch Char where
  is :: Char -> Parser Char
is      = (Char -> Char -> Bool) -> Parser Char -> Char -> Parser Char
isMatch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(==) Parser Char
char
  isNot :: Char -> Parser Char
isNot   = (Char -> Char -> Bool) -> Parser Char -> Char -> Parser Char
isMatch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(/=) Parser Char
char
  inverse :: Parser Char -> Parser Char
inverse = Parser Char -> Parser Char -> Parser Char
forall a. Show a => Parser a -> Parser a -> Parser a
except Parser Char
char

instance IsMatch String where
  is :: [Char] -> Parser [Char]
is      = (Char -> Parser Char) -> [Char] -> Parser [Char]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Char -> Parser Char
forall a. IsMatch a => a -> Parser a
is
  isNot :: [Char] -> Parser [Char]
isNot   = (Char -> Parser Char) -> [Char] -> Parser [Char]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Char -> Parser Char
forall a. IsMatch a => a -> Parser a
isNot
  inverse :: Parser [Char] -> Parser [Char]
inverse = Parser [Char] -> Parser [Char] -> Parser [Char]
forall a. Show a => Parser a -> Parser a -> Parser a
except (Parser Char
char Parser Char -> Parser [Char]
forall a. Parser a -> Parser [a]
|*)

instance {-# OVERLAPPABLE #-} (Num a, Read a, Show a) => IsMatch a where
  is :: a -> Parser a
is a
n      = [Char] -> a
forall a. Read a => [Char] -> a
read ([Char] -> a) -> Parser [Char] -> Parser a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> Parser [Char]
forall a. IsMatch a => a -> Parser a
is ([Char] -> Parser [Char]) -> (a -> [Char]) -> a -> Parser [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Char]
forall a. Show a => a -> [Char]
show) a
n
  isNot :: a -> Parser a
isNot a
n   = [Char] -> a
forall a. Read a => [Char] -> a
read ([Char] -> a) -> Parser [Char] -> Parser a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> Parser [Char]
forall a. IsMatch a => a -> Parser a
isNot ([Char] -> Parser [Char]) -> (a -> [Char]) -> a -> Parser [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Char]
forall a. Show a => a -> [Char]
show) a
n
  inverse :: Parser a -> Parser a
inverse Parser a
p = [Char] -> a
forall a. Read a => [Char] -> a
read ([Char] -> a) -> Parser [Char] -> Parser a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [Char] -> Parser [Char]
forall a. IsMatch a => Parser a -> Parser a
inverse (a -> [Char]
forall a. Show a => a -> [Char]
show (a -> [Char]) -> Parser a -> Parser [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
p)


-- Condition combinators
satisfies :: Parser a -> (a -> Bool) -> Parser a
satisfies :: Parser a -> (a -> Bool) -> Parser a
satisfies Parser a
parser a -> Bool
cond = [Char] -> (a -> Bool) -> Parser a -> Parser a
forall a. [Char] -> (a -> Bool) -> Parser a -> Parser a
check [Char]
"satisfies" a -> Bool
cond Parser a
parser

contains :: Eq a => Parser [a] -> [a] -> Parser [a]
contains :: Parser [a] -> [a] -> Parser [a]
contains Parser [a]
p [a]
str = [Char] -> ([a] -> Bool) -> Parser [a] -> Parser [a]
forall a. [Char] -> (a -> Bool) -> Parser a -> Parser a
check [Char]
"contains" ([a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isInfixOf [a]
str) Parser [a]
p

notContains :: Eq a => Parser [a] -> [a] -> Parser [a]
notContains :: Parser [a] -> [a] -> Parser [a]
notContains Parser [a]
p [a]
str = [Char] -> ([a] -> Bool) -> Parser [a] -> Parser [a]
forall a. [Char] -> (a -> Bool) -> Parser a -> Parser a
check [Char]
"notContains" ([a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isInfixOf [a]
str) Parser [a]
p


-- Frequency combinators
times :: Parser a -> Integer -> Parser [a]
times :: Parser a -> Integer -> Parser [a]
times Parser a
parser Integer
n = [Parser a] -> Parser [a]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Parser a] -> Parser [a]) -> [Parser a] -> Parser [a]
forall a b. (a -> b) -> a -> b
$ Parser a
parser Parser a -> [Integer] -> [Parser a]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Integer
1 .. Integer
n]

maybeTimes :: Parser a -> Parser (Maybe a)
maybeTimes :: Parser a -> Parser (Maybe a)
maybeTimes = ([a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe ([a] -> Maybe a) -> Parser [a] -> Parser (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Parser [a] -> Parser (Maybe a))
-> (Parser a -> Parser [a]) -> Parser a -> Parser (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ([a] -> Bool) -> Parser [a] -> Parser [a]
forall a. [Char] -> (a -> Bool) -> Parser a -> Parser a
check [Char]
"maybeTimes" (Bool -> Bool
not (Bool -> Bool) -> ([a] -> Bool) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Bool
forall (m :: * -> *) a. Foldable m => m a -> Bool
hasMany) (Parser [a] -> Parser [a])
-> (Parser a -> Parser [a]) -> Parser a -> Parser [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a -> Parser [a]
forall a. Parser a -> Parser [a]
anyTimes

anyTimes :: Parser a -> Parser [a]
anyTimes :: Parser a -> Parser [a]
anyTimes Parser a
parser = (Parser a
parser Parser a -> (a -> Parser [a]) -> Parser [a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
x -> (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [a]) -> Parser [a] -> Parser [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a -> Parser [a]
forall a. Parser a -> Parser [a]
anyTimes Parser a
parser) Parser [a] -> Parser [a] -> Parser [a]
forall a. Parser a -> Parser a -> Parser a
<|> [a] -> Parser [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

someTimes :: Parser a -> Parser [a]
someTimes :: Parser a -> Parser [a]
someTimes = [Char] -> ([a] -> Bool) -> Parser [a] -> Parser [a]
forall a. [Char] -> (a -> Bool) -> Parser a -> Parser a
check [Char]
"someTimes" [a] -> Bool
forall (m :: * -> *) a. Foldable m => m a -> Bool
hasSome (Parser [a] -> Parser [a])
-> (Parser a -> Parser [a]) -> Parser a -> Parser [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a -> Parser [a]
forall a. Parser a -> Parser [a]
anyTimes

manyTimes :: Parser a -> Parser [a]
manyTimes :: Parser a -> Parser [a]
manyTimes = [Char] -> ([a] -> Bool) -> Parser [a] -> Parser [a]
forall a. [Char] -> (a -> Bool) -> Parser a -> Parser a
check [Char]
"manyTimes" [a] -> Bool
forall (m :: * -> *) a. Foldable m => m a -> Bool
hasMany (Parser [a] -> Parser [a])
-> (Parser a -> Parser [a]) -> Parser a -> Parser [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a -> Parser [a]
forall a. Parser a -> Parser [a]
anyTimes


-- Within combinators
within :: Parser a -> Parser b -> Parser b
within :: Parser a -> Parser b -> Parser b
within Parser a
p = Parser a -> Parser a -> Parser b -> Parser b
forall (m :: * -> *) a1 a2 b.
Applicative m =>
m a1 -> m a2 -> m b -> m b
extract Parser a
p Parser a
p

maybeWithin :: Parser a -> Parser b -> Parser b
maybeWithin :: Parser a -> Parser b -> Parser b
maybeWithin Parser a
p = Parser (Maybe a) -> Parser b -> Parser b
forall a b. Parser a -> Parser b -> Parser b
within (Parser a
p Parser a -> Parser (Maybe a)
forall a. Parser a -> Parser (Maybe a)
|?)

withinBoth :: Parser a -> Parser b -> Parser c -> Parser c
withinBoth :: Parser a -> Parser b -> Parser c -> Parser c
withinBoth = Parser a -> Parser b -> Parser c -> Parser c
forall (m :: * -> *) a1 a2 b.
Applicative m =>
m a1 -> m a2 -> m b -> m b
extract

maybeWithinBoth :: Parser a -> Parser b -> Parser c -> Parser c
maybeWithinBoth :: Parser a -> Parser b -> Parser c -> Parser c
maybeWithinBoth Parser a
p1 Parser b
p2 = Parser (Maybe a) -> Parser (Maybe b) -> Parser c -> Parser c
forall (m :: * -> *) a1 a2 b.
Applicative m =>
m a1 -> m a2 -> m b -> m b
extract (Parser a
p1 Parser a -> Parser (Maybe a)
forall a. Parser a -> Parser (Maybe a)
|?) (Parser b
p2 Parser b -> Parser (Maybe b)
forall a. Parser a -> Parser (Maybe a)
|?)


-- Separated by combinators
separatedBy :: (Parser b -> Parser (Maybe b)) -> (Parser b -> Parser [b])
                -> Parser a -> Parser b -> Parser [b]
separatedBy :: (Parser b -> Parser (Maybe b))
-> (Parser b -> Parser [b]) -> Parser a -> Parser b -> Parser [b]
separatedBy Parser b -> Parser (Maybe b)
freq1 Parser b -> Parser [b]
freq2 Parser a
sep Parser b
p = [b] -> [b] -> [b]
forall a. [a] -> [a] -> [a]
(++) ([b] -> [b] -> [b]) -> Parser [b] -> Parser ([b] -> [b])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe b -> [b]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList (Maybe b -> [b]) -> Parser (Maybe b) -> Parser [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser b -> Parser (Maybe b)
freq1 Parser b
p)
                                     Parser ([b] -> [b]) -> Parser [b] -> Parser [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser b -> Parser [b]
freq2 (Parser a
sep Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser b
p)

anySeparatedBy :: Parser a -> Parser b -> Parser [b]
anySeparatedBy :: Parser a -> Parser b -> Parser [b]
anySeparatedBy = (Parser b -> Parser (Maybe b))
-> (Parser b -> Parser [b]) -> Parser a -> Parser b -> Parser [b]
forall b a.
(Parser b -> Parser (Maybe b))
-> (Parser b -> Parser [b]) -> Parser a -> Parser b -> Parser [b]
separatedBy Parser b -> Parser (Maybe b)
forall a. Parser a -> Parser (Maybe a)
(|?) Parser b -> Parser [b]
forall a. Parser a -> Parser [a]
(|*)

someSeparatedBy :: Parser a -> Parser b -> Parser [b]
someSeparatedBy :: Parser a -> Parser b -> Parser [b]
someSeparatedBy = (Parser b -> Parser (Maybe b))
-> (Parser b -> Parser [b]) -> Parser a -> Parser b -> Parser [b]
forall b a.
(Parser b -> Parser (Maybe b))
-> (Parser b -> Parser [b]) -> Parser a -> Parser b -> Parser [b]
separatedBy ((b -> Maybe b) -> Parser b -> Parser (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Maybe b
forall a. a -> Maybe a
Just) Parser b -> Parser [b]
forall a. Parser a -> Parser [a]
(|*)

manySeparatedBy :: Parser a -> Parser b -> Parser [b]
manySeparatedBy :: Parser a -> Parser b -> Parser [b]
manySeparatedBy = (Parser b -> Parser (Maybe b))
-> (Parser b -> Parser [b]) -> Parser a -> Parser b -> Parser [b]
forall b a.
(Parser b -> Parser (Maybe b))
-> (Parser b -> Parser [b]) -> Parser a -> Parser b -> Parser [b]
separatedBy ((b -> Maybe b) -> Parser b -> Parser (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Maybe b
forall a. a -> Maybe a
Just) Parser b -> Parser [b]
forall a. Parser a -> Parser [a]
(|+)

-- Parser Binary Operators
infixl 3 <|>
(<|>) :: Parser a -> Parser a -> Parser a
<|> :: Parser a -> Parser a -> Parser a
(<|>) Parser a
p1 Parser a
p2 = [Parser a] -> Parser a
forall a. [Parser a] -> Parser a
anyOf [Parser a
p1, Parser a
p2]

infixl 3 <&>
(<&>) :: Parser a -> Parser a -> Parser a
<&> :: Parser a -> Parser a -> Parser a
(<&>) Parser a
p1 Parser a
p2 = [Parser a] -> Parser a
forall a. [Parser a] -> Parser a
allOf [Parser a
p1, Parser a
p2]

infixl 6 <#>
(<#>) :: Parser a -> Integer -> Parser [a]
<#> :: Parser a -> Integer -> Parser [a]
(<#>) = Parser a -> Integer -> Parser [a]
forall a. Parser a -> Integer -> Parser [a]
times

infixl 6 >>>
(>>>) :: (ToString a, ToString b) => Parser a -> Parser b -> Parser String
>>> :: Parser a -> Parser b -> Parser [Char]
(>>>) Parser a
p1 Parser b
p2 = Parser a
p1 Parser a -> (a -> Parser [Char]) -> Parser [Char]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\[Char]
x -> ([Char]
x [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) ([Char] -> [Char]) -> Parser [Char] -> Parser [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (b -> [Char]
forall a. ToString a => a -> [Char]
toString (b -> [Char]) -> Parser b -> Parser [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser b
p2)) ([Char] -> Parser [Char]) -> (a -> [Char]) -> a -> Parser [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Char]
forall a. ToString a => a -> [Char]
toString


-- Parser Unary Operators
(|?) :: Parser a -> Parser (Maybe a)
|? :: Parser a -> Parser (Maybe a)
(|?) = Parser a -> Parser (Maybe a)
forall a. Parser a -> Parser (Maybe a)
maybeTimes

(|*) :: Parser a -> Parser [a]
|* :: Parser a -> Parser [a]
(|*) = Parser a -> Parser [a]
forall a. Parser a -> Parser [a]
anyTimes

(|+) :: Parser a -> Parser [a]
|+ :: Parser a -> Parser [a]
(|+) = Parser a -> Parser [a]
forall a. Parser a -> Parser [a]
someTimes

(|++) :: Parser a -> Parser [a]
|++ :: Parser a -> Parser [a]
(|++) = Parser a -> Parser [a]
forall a. Parser a -> Parser [a]
manyTimes