module Bookhound.ParserCombinators (IsMatch(..), satisfy, char, string, times, many, some, multiple,
                          between, maybeBetween, surroundedBy, maybeSurroundedBy,
                          manySepBy, someSepBy, multipleSepBy, sepByOps, sepByOp, manyEndBy, someEndBy, multipleEndBy,
                          (<?>), (<#>), (</\>), (<:>), (->>-), (|?), (|*), (|+), (|++), (||?), (||*), (||+), (||++))  where
import Bookhound.Parser (Parser, allOf, anyChar, anyOf, except, satisfy,
                         withError)

import Bookhound.Utils.List (hasMultiple, hasSome)
import Bookhound.Utils.Text (ToText (..))
import Control.Applicative  (liftA2, optional, (<|>))

import qualified Data.Foldable as Foldable
import           Data.Text     (Text, pack, unpack)
import qualified Data.Text     as Text


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 (f :: * -> *) a. Foldable f => f (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 (f :: * -> *) a. Foldable f => f (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
anyChar
  isNot :: Char -> Parser Char
isNot   = (Char -> Char -> Bool) -> Parser Char -> Char -> Parser Char
isMatch forall a. Eq a => a -> a -> Bool
(/=) Parser Char
anyChar
  inverse :: Parser Char -> Parser Char
inverse = forall a. Parser a -> Parser a -> Parser a
except Parser Char
anyChar

instance   IsMatch Text where
  is :: Text -> Parser Text
is      = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Char] -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a. IsMatch a => a -> Parser a
is forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
unpack
  isNot :: Text -> Parser Text
isNot   = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Char] -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a. IsMatch a => a -> Parser a
is forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
unpack
  inverse :: Parser Text -> Parser Text
inverse = forall a. Parser a -> Parser a -> Parser a
except (Parser Char
anyChar ||*)


isMatch :: (Char -> Char -> Bool) -> Parser Char -> Char -> Parser Char
isMatch :: (Char -> Char -> Bool) -> Parser Char -> Char -> Parser Char
isMatch Char -> Char -> Bool
cond Parser Char
p Char
c1 = forall a. (a -> Bool) -> Parser a -> Parser a
satisfy (Char -> Char -> Bool
cond Char
c1) Parser Char
p

char :: Char -> Parser Char
char :: Char -> Parser Char
char = forall a. IsMatch a => a -> Parser a
is

string :: Text -> Parser Text
string :: Text -> Parser Text
string = forall a. IsMatch a => a -> Parser a
is

 -- Frequency combinators
many :: Parser a -> Parser [a]
many :: forall a. Parser a -> Parser [a]
many 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]
many Parser a
p)
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure []

some :: Parser a -> Parser [a]
some :: forall a. Parser a -> Parser [a]
some = forall a. (a -> Bool) -> Parser a -> Parser a
satisfy forall a. [a] -> Bool
hasSome forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> Parser [a]
many

multiple :: Parser a -> Parser [a]
multiple :: forall a. Parser a -> Parser [a]
multiple = forall a. (a -> Bool) -> Parser a -> Parser a
satisfy forall a. [a] -> Bool
hasMultiple forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> Parser [a]
many

times :: Int -> Parser a  -> Parser [a]
times :: forall a. Int -> Parser a -> Parser [a]
times Int
n Parser a
p
  | Int
n forall a. Ord a => a -> a -> Bool
< Int
1 = forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  | Bool
otherwise = 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]


-- Between combinators
between :: Parser a -> Parser b -> Parser c -> Parser c
between :: forall a b c. Parser a -> Parser b -> Parser c -> Parser c
between Parser a
start Parser b
end Parser c
p = Parser a
start forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser c
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser b
end

maybeBetween :: Parser a -> Parser b -> Parser c -> Parser c
maybeBetween :: forall a b c. Parser a -> Parser b -> Parser c -> Parser c
maybeBetween Parser a
p1 Parser b
p2 = forall a b c. Parser a -> Parser b -> Parser c -> Parser c
between (Parser a
p1 |?) (Parser b
p2 |?)

surroundedBy :: Parser a -> Parser b -> Parser b
surroundedBy :: forall a b. Parser a -> Parser b -> Parser b
surroundedBy Parser a
p = forall a b c. Parser a -> Parser b -> Parser c -> Parser c
between Parser a
p Parser a
p

maybeSurroundedBy :: Parser a -> Parser b -> Parser b
maybeSurroundedBy :: forall a b. Parser a -> Parser b -> Parser b
maybeSurroundedBy Parser a
p = forall a b. Parser a -> Parser b -> Parser b
surroundedBy (Parser a
p |?)


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

manySepBy :: Parser a -> Parser b -> Parser [b]
manySepBy :: forall a b. Parser a -> Parser b -> Parser [b]
manySepBy = forall b a.
(Parser b -> Parser (Maybe b))
-> (Parser b -> Parser [b]) -> Parser a -> Parser b -> Parser [b]
sepBy forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a. Parser a -> Parser [a]
many

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

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

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 a. Parser a -> Parser [a]
(|+) (Parser a
sep forall (f :: * -> *) a b. Applicative f => f a -> f b -> f (a, b)
</\> Parser b
p)
                    pure (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst [(a, b)]
y, b
x forall a. a -> [a] -> [a]
: forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd [(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
sepP Parser b
p = do
  b
x1 <- Parser b
p
  a
sep <- Parser a
sepP
  b
x2 <- Parser b
p
  [b]
xs <- forall a. Parser a -> Parser [a]
(|*) (Parser a
sepP forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser b
p)
  pure (a
sep, b
x1 forall a. a -> [a] -> [a]
: b
x2 forall a. a -> [a] -> [a]
: [b]
xs)

-- End by combinators
endBy
  :: forall a b
   . (Parser b -> Parser (Maybe b))
  -> (Parser b -> Parser [b])
  -> Parser a
  -> Parser b
  -> Parser [b]
endBy :: forall a b.
(Parser b -> Parser (Maybe b))
-> (Parser b -> Parser [b]) -> Parser a -> Parser b -> Parser [b]
endBy Parser b -> Parser (Maybe b)
freq1 Parser b -> Parser [b]
freq2 Parser a
sep Parser b
p =
  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 (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser a
sep

manyEndBy :: forall a b. Parser a -> Parser b -> Parser [ b]
manyEndBy :: forall a b. Parser a -> Parser b -> Parser [b]
manyEndBy = forall a b.
(Parser b -> Parser (Maybe b))
-> (Parser b -> Parser [b]) -> Parser a -> Parser b -> Parser [b]
endBy forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a. Parser a -> Parser [a]
many

someEndBy :: forall a b. Parser a -> Parser b -> Parser [ b]
someEndBy :: forall a b. Parser a -> Parser b -> Parser [b]
someEndBy = forall a b.
(Parser b -> Parser (Maybe b))
-> (Parser b -> Parser [b]) -> Parser a -> Parser b -> Parser [b]
endBy (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]
many

multipleEndBy :: forall a b. Parser a -> Parser b -> Parser [ b]
multipleEndBy :: forall a b. Parser a -> Parser b -> Parser [b]
multipleEndBy = forall a b.
(Parser b -> Parser (Maybe b))
-> (Parser b -> Parser [b]) -> Parser a -> Parser b -> Parser [b]
endBy (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]
some


-- Parser Binary Operators
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 -> Text -> Parser a
<?> :: forall a. Parser a -> Text -> Parser a
(<?>) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Text -> Parser a -> Parser a
withError

infixl 6 ->>-
(->>-) :: (ToText a, ToText b) => Parser a -> Parser b -> Parser Text
->>- :: forall a b.
(ToText a, ToText b) =>
Parser a -> Parser b -> Parser Text
(->>-) 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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. ToText a => a -> Text
toText Parser a
p1
                 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. ToText a => a -> Text
toText Parser b
p2

-- Apply Binary Operators
infixl 6 </\>
(</\>) :: Applicative f => f a -> f b -> f (a, b)
</\> :: forall (f :: * -> *) a b. Applicative f => f a -> f b -> f (a, b)
(</\>) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,)

infixl 6 <:>
(<:>) :: Applicative f => f a -> f [a] -> f [a]
<:> :: forall (f :: * -> *) a. Applicative f => f a -> f [a] -> f [a]
(<:>) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:)

-- Parser Unary Operators
(|?) :: Parser a -> Parser (Maybe a)
|? :: forall a. Parser a -> Parser (Maybe a)
(|?) = forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional

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

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

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

(||?) :: Parser Char -> Parser Text
||? :: Parser Char -> Parser Text
(||?) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty Char -> Text
Text.singleton) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional

(||*) :: Parser Char -> Parser Text
||* :: Parser Char -> Parser Text
(||*) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Char] -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> Parser [a]
many

(||+) :: Parser Char -> Parser Text
||+ :: Parser Char -> Parser Text
(||+) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Char] -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> Parser [a]
some

(||++) :: Parser Char -> Parser Text
||++ :: Parser Char -> Parser Text
(||++) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Char] -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> Parser [a]
multiple