{-# 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 :: (a -> Bool) -> Parser a -> Parser a
satisfies :: (a -> Bool) -> Parser a -> Parser a
satisfies a -> Bool
cond Parser a
p = [Char] -> (a -> Bool) -> Parser a -> Parser a
forall a. [Char] -> (a -> Bool) -> Parser a -> Parser a
check [Char]
"satisfies" a -> Bool
cond Parser a
p

contains :: Eq a => [a] -> Parser [a] -> Parser [a]
contains :: [a] -> Parser [a] -> Parser [a]
contains [a]
val Parser [a]
p = [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]
val) Parser [a]
p

notContains :: Eq a => [a] -> Parser [a] -> Parser [a]
notContains :: [a] -> Parser [a] -> Parser [a]
notContains [a]
val Parser [a]
p = [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]
val) Parser [a]
p


 -- Frequency combinators
times :: Integer -> Parser a  -> Parser [a]
times :: Integer -> Parser a -> Parser [a]
times Integer
n Parser a
p = [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
p 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]
(<#>) = (Integer -> Parser a -> Parser [a])
-> Parser a -> Integer -> Parser [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Integer -> Parser a -> Parser [a]
forall a. Integer -> Parser a -> 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 = [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
(++) ([Char] -> [Char] -> [Char])
-> Parser [Char] -> Parser ([Char] -> [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> [Char]
forall a. ToString a => a -> [Char]
toString (a -> [Char]) -> Parser a -> Parser [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
p1)
                   Parser ([Char] -> [Char]) -> Parser [Char] -> Parser [Char]
forall (f :: * -> *) a b. Applicative f => 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)


-- 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