{-# LANGUAGE UndecidableInstances #-}

module Bookhound.ParserCombinators (IsMatch(..), satisfies, contains, notContains,
                          containsAnyOf, containsNoneOf,
                          times, maybeTimes, anyTimes, someTimes, multipleTimes,
                          within, maybeWithin, withinBoth, maybeWithinBoth,
                          anySepBy, someSepBy, multipleSepBy, sepByOp,
                          (<|>), (<?>), (<#>), (->>-), (|?), (|*), (|+), (|++))  where

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

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

import           Data.Bifunctor (Bifunctor (first))
import qualified Data.Foldable  as Foldable


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

  oneOf [a]
xs  = forall a. [Parser a] -> Parser a
anyOf forall a b. (a -> b) -> a -> b
$ forall a. IsMatch a => a -> Parser a
is forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
xs
  noneOf [a]
xs = forall a. [Parser a] -> Parser a
allOf forall a b. (a -> b) -> a -> b
$ forall a. IsMatch a => a -> Parser a
isNot 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 forall a. Eq a => a -> a -> Bool
(==) Parser Char
char
  isNot :: Char -> Parser Char
isNot   = (Char -> Char -> Bool) -> Parser Char -> Char -> Parser Char
isMatch forall a. Eq a => a -> a -> Bool
(/=) Parser Char
char
  inverse :: Parser Char -> Parser Char
inverse = forall a. Parser a -> Parser a -> Parser a
except Parser Char
char

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

instance {-# OVERLAPPABLE #-} (Num a, Read a, Show a) => IsMatch a where
  is :: a -> Parser a
is a
n      = forall a. Read a => String -> a
read forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. IsMatch a => a -> Parser a
is forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) a
n
  isNot :: a -> Parser a
isNot a
n   = forall a. Read a => String -> a
read forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. IsMatch a => a -> Parser a
isNot forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) a
n
  inverse :: Parser a -> Parser a
inverse Parser a
p = forall a. Read a => String -> a
read forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IsMatch a => Parser a -> Parser a
inverse (forall a. Show a => a -> String
show 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 :: forall a. (a -> Bool) -> Parser a -> Parser a
satisfies a -> Bool
cond Parser a
p = forall a. String -> (a -> Bool) -> Parser a -> Parser a
check String
"satisfies" a -> Bool
cond Parser a
p

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

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

containsAnyOf :: (Foldable t, Eq a) => t [a] -> Parser [a] -> Parser [a]
containsAnyOf :: forall (t :: * -> *) a.
(Foldable t, Eq a) =>
t [a] -> Parser [a] -> Parser [a]
containsAnyOf t [a]
x Parser [a]
y = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. Eq a => [a] -> Parser [a] -> Parser [a]
contains Parser [a]
y t [a]
x

containsNoneOf :: (Foldable t, Eq a) => t [a] -> Parser [a] -> Parser [a]
containsNoneOf :: forall (t :: * -> *) a.
(Foldable t, Eq a) =>
t [a] -> Parser [a] -> Parser [a]
containsNoneOf t [a]
x Parser [a]
y = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. Eq a => [a] -> Parser [a] -> Parser [a]
notContains Parser [a]
y t [a]
x


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


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

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

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

multipleTimes :: Parser a -> Parser [a]
multipleTimes :: forall a. Parser a -> Parser [a]
multipleTimes = forall a. String -> (a -> Bool) -> Parser a -> Parser a
check String
"multipleTimes" forall (m :: * -> *) a. Foldable m => m a -> Bool
hasMultiple forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> Parser [a]
anyTimes


-- Within combinators
within :: Parser a -> Parser b -> Parser b
within :: forall a b. Parser a -> Parser b -> Parser b
within Parser a
p = 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 :: forall a b. Parser a -> Parser b -> Parser b
maybeWithin Parser a
p = forall a b. Parser a -> Parser b -> Parser b
within (Parser a
p |?)

withinBoth :: Parser a -> Parser b -> Parser c -> Parser c
withinBoth :: forall a b c. Parser a -> Parser b -> Parser c -> Parser c
withinBoth = 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 :: forall a b c. Parser a -> Parser b -> Parser c -> Parser c
maybeWithinBoth Parser a
p1 Parser b
p2 = forall (m :: * -> *) a1 a2 b.
Applicative m =>
m a1 -> m a2 -> m b -> m b
extract (Parser a
p1 |?) (Parser b
p2 |?)


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

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

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

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

sepByOps :: Parser a -> Parser b -> Parser ([a], [b])
sepByOps :: forall a b. Parser a -> Parser b -> Parser ([a], [b])
sepByOps Parser a
sep Parser b
p = do b
x <-  Parser b
p
                    [(a, b)]
y <- (((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
sep forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser b
p) |+)
                    pure $ (forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(a, b)]
y, b
x forall a. a -> [a] -> [a]
: (forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(a, b)]
y))

sepByOp :: Parser a -> Parser b -> Parser (a, [b])
sepByOp :: forall a b. Parser a -> Parser b -> Parser (a, [b])
sepByOp Parser a
sep Parser b
p = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a. [a] -> a
head forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Parser a -> Parser b -> Parser ([a], [b])
sepByOps Parser a
sep Parser b
p


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

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

infixl 6 <?>
(<?>) :: Parser a -> String -> Parser a
<?> :: forall a. Parser a -> String -> Parser a
(<?>) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. String -> Parser a -> Parser a
withError

infixl 6 ->>-
(->>-) :: (ToString a, ToString b) => Parser a -> Parser b -> Parser String
->>- :: forall a b.
(ToString a, ToString b) =>
Parser a -> Parser b -> Parser String
(->>-) Parser a
p1 Parser b
p2 = forall a. Semigroup a => a -> a -> a
(<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. ToString a => a -> String
toString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
p1)
                 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. ToString a => a -> String
toString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser b
p2)


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

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

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

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