{-# LANGUAGE FlexibleInstances, IncoherentInstances, PostfixOperators #-}

module ParserCombinators  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, maybeToList)
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 IsMatch Integer where
  is :: Integer -> Parser Integer
is Integer
n = [Char] -> Integer
forall a. Read a => [Char] -> a
read ([Char] -> Integer) -> Parser [Char] -> Parser Integer
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])
-> (Integer -> [Char]) -> Integer -> Parser [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> [Char]
forall a. Show a => a -> [Char]
show) Integer
n
  isNot :: Integer -> Parser Integer
isNot Integer
n = [Char] -> Integer
forall a. Read a => [Char] -> a
read ([Char] -> Integer) -> Parser [Char] -> Parser Integer
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])
-> (Integer -> [Char]) -> Integer -> Parser [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> [Char]
forall a. Show a => a -> [Char]
show) Integer
n
  inverse :: Parser Integer -> Parser Integer
inverse Parser Integer
p = [Char] -> Integer
forall a. Read a => [Char] -> a
read ([Char] -> Integer) -> Parser [Char] -> Parser Integer
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 (Integer -> [Char]
forall a. Show a => a -> [Char]
show (Integer -> [Char]) -> Parser Integer -> Parser [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Integer
p)

instance IsMatch Int where
  is :: Int -> Parser Int
is Int
n = [Char] -> Int
forall a. Read a => [Char] -> a
read ([Char] -> Int) -> Parser [Char] -> Parser Int
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])
-> (Int -> [Char]) -> Int -> Parser [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char]
forall a. Show a => a -> [Char]
show) Int
n
  isNot :: Int -> Parser Int
isNot Int
n = [Char] -> Int
forall a. Read a => [Char] -> a
read ([Char] -> Int) -> Parser [Char] -> Parser Int
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])
-> (Int -> [Char]) -> Int -> Parser [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char]
forall a. Show a => a -> [Char]
show) Int
n
  inverse :: Parser Int -> Parser Int
inverse Parser Int
p = [Char] -> Int
forall a. Read a => [Char] -> a
read ([Char] -> Int) -> Parser [Char] -> Parser Int
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 (Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> [Char]) -> Parser Int -> Parser [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int
p)

instance IsMatch Double where
  is :: Double -> Parser Double
is Double
n = [Char] -> Double
forall a. Read a => [Char] -> a
read ([Char] -> Double) -> Parser [Char] -> Parser Double
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])
-> (Double -> [Char]) -> Double -> Parser [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> [Char]
forall a. Show a => a -> [Char]
show) Double
n
  isNot :: Double -> Parser Double
isNot Double
n = [Char] -> Double
forall a. Read a => [Char] -> a
read ([Char] -> Double) -> Parser [Char] -> Parser Double
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])
-> (Double -> [Char]) -> Double -> Parser [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> [Char]
forall a. Show a => a -> [Char]
show) Double
n
  inverse :: Parser Double -> Parser Double
inverse Parser Double
p = [Char] -> Double
forall a. Read a => [Char] -> a
read ([Char] -> Double) -> Parser [Char] -> Parser Double
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 (Double -> [Char]
forall a. Show a => a -> [Char]
show (Double -> [Char]) -> Parser Double -> Parser [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Double
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
(<|>) :: 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]

(<&>) :: 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]

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

(>>>) :: (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