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