{-# LANGUAGE UndecidableInstances #-}

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

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

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

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