{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# HLINT ignore "Use optional" #-}

module Bookhound.ParserCombinators (IsMatch(..), satisfies, contains, notContains,
                          containsAnyOf, containsNoneOf,
                          times, maybeTimes, anyTimes, someTimes, multipleTimes,
                          within, maybeWithin, withinBoth, maybeWithinBoth,
                          anySepBy, someSepBy, multipleSepBy, sepByOps, 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.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 = forall a. String -> (a -> Bool) -> Parser a -> Parser a
check String
"satisfies"

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

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

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 :: Int -> Parser a  -> Parser [a]
times :: forall a. Int -> Parser a -> Parser [a]
times Int
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
<$ [Int
1 .. Int
n]


maybeTimes :: Parser a -> Parser (Maybe a)
maybeTimes :: forall a. Parser a -> Parser (Maybe a)
maybeTimes Parser a
p = forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
p forall a. Parser a -> Parser a -> Parser a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing

anyTimes :: Parser a -> Parser [a]
anyTimes :: forall a. Parser a -> Parser [a]
anyTimes Parser a
p = (Parser a
p 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
p) 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
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 a b c. Parser a -> Parser b -> Parser c -> Parser c
withinBoth (Parser a
p1 |?) (Parser b
p2 |?)

within :: Parser a -> Parser b -> Parser b
within :: forall a b. Parser a -> Parser b -> Parser b
within Parser a
p = forall a b c. Parser a -> Parser b -> Parser c -> Parser c
withinBoth 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 |?)


-- 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 -> Int -> Parser [a]
<#> :: forall a. Parser a -> Int -> Parser [a]
(<#>) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Int -> 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