{-# 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)
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
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 :: 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 |?)
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
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 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