{-# LANGUAGE PatternSynonyms #-}
module Parsley.Combinator (
satisfy, char, item,
string, token,
oneOf, noneOf,
eof, more,
someTill,
try,
lookAhead, notFollowedBy
) where
import Prelude hiding (traverse, (*>))
import Parsley.Alternative (manyTill)
import Parsley.Applicative (($>), void, traverse, (<:>), (*>))
import Parsley.Internal (Code, makeQ, Parser, Defunc(LIFTED, EQ_H, CONST), pattern APP_H, satisfy, lookAhead, try, notFollowedBy)
string :: String -> Parser String
string :: String -> Parser String
string = (Char -> Parser Char) -> String -> Parser String
forall a b. (a -> Parser b) -> [a] -> Parser [b]
traverse Char -> Parser Char
char
oneOf :: [Char] -> Parser Char
oneOf :: String -> Parser Char
oneOf String
cs = Defunc (Char -> Bool) -> Parser Char
forall (rep :: Type -> Type).
ParserOps rep =>
rep (Char -> Bool) -> Parser Char
satisfy ((Char -> Bool) -> Code (Char -> Bool) -> Defunc (Char -> Bool)
forall (q :: Type -> Type) a. Quapplicative q => a -> Code a -> q a
makeQ ((Char -> String -> Bool) -> String -> Char -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Char -> String -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
elem String
cs) [||\c -> $$(ofChars cs [||c||])||])
noneOf :: [Char] -> Parser Char
noneOf :: String -> Parser Char
noneOf String
cs = Defunc (Char -> Bool) -> Parser Char
forall (rep :: Type -> Type).
ParserOps rep =>
rep (Char -> Bool) -> Parser Char
satisfy ((Char -> Bool) -> Code (Char -> Bool) -> Defunc (Char -> Bool)
forall (q :: Type -> Type) a. Quapplicative q => a -> Code a -> q a
makeQ (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> String -> Bool) -> String -> Char -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Char -> String -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
elem String
cs) [||\c -> not $$(ofChars cs [||c||])||])
ofChars :: [Char] -> Code Char -> Code Bool
ofChars :: String -> Code Char -> Code Bool
ofChars = (Char -> (Code Char -> Code Bool) -> Code Char -> Code Bool)
-> (Code Char -> Code Bool) -> String -> Code Char -> Code Bool
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Char
c Code Char -> Code Bool
rest Code Char
qc -> [|| c == $$qc || $$(rest qc) ||]) (Code Bool -> Code Char -> Code Bool
forall a b. a -> b -> a
const [||False||])
token :: String -> Parser String
token :: String -> Parser String
token = Parser String -> Parser String
forall a. Parser a -> Parser a
try (Parser String -> Parser String)
-> (String -> Parser String) -> String -> Parser String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Parser String
string
eof :: Parser ()
eof :: Parser ()
eof = Parser Char -> Parser ()
forall a. Parser a -> Parser ()
notFollowedBy Parser Char
item
more :: Parser ()
more :: Parser ()
more = Parser () -> Parser ()
forall a. Parser a -> Parser a
lookAhead (Parser Char -> Parser ()
forall a. Parser a -> Parser ()
void Parser Char
item)
char :: Char -> Parser Char
char :: Char -> Parser Char
char Char
c = Defunc (Char -> Bool) -> Parser Char
forall (rep :: Type -> Type).
ParserOps rep =>
rep (Char -> Bool) -> Parser Char
satisfy (Defunc Char -> Defunc (Char -> Bool)
forall a1. Eq a1 => Defunc a1 -> Defunc (a1 -> Bool)
EQ_H (Char -> Defunc Char
forall a. (Show a, Lift a) => a -> Defunc a
LIFTED Char
c)) Parser Char -> Defunc Char -> Parser Char
forall (rep :: Type -> Type) a b.
ParserOps rep =>
Parser a -> rep b -> Parser b
$> Char -> Defunc Char
forall a. (Show a, Lift a) => a -> Defunc a
LIFTED Char
c
item :: Parser Char
item :: Parser Char
item = Defunc (Char -> Bool) -> Parser Char
forall (rep :: Type -> Type).
ParserOps rep =>
rep (Char -> Bool) -> Parser Char
satisfy (Defunc (Bool -> Char -> Bool)
-> Defunc Bool -> Defunc (Char -> Bool)
forall a1 a. Defunc (a1 -> a) -> Defunc a1 -> Defunc a
APP_H Defunc (Bool -> Char -> Bool)
forall a1 b. Defunc (a1 -> b -> a1)
CONST (Bool -> Defunc Bool
forall a. (Show a, Lift a) => a -> Defunc a
LIFTED Bool
True))
someTill :: Parser a -> Parser b -> Parser [a]
someTill :: Parser a -> Parser b -> Parser [a]
someTill Parser a
p Parser b
end = Parser b -> Parser ()
forall a. Parser a -> Parser ()
notFollowedBy Parser b
end Parser () -> Parser [a] -> Parser [a]
forall a b. Parser a -> Parser b -> Parser b
*> (Parser a
p Parser a -> Parser [a] -> Parser [a]
forall a. Parser a -> Parser [a] -> Parser [a]
<:> Parser a -> Parser b -> Parser [a]
forall a b. Parser a -> Parser b -> Parser [a]
manyTill Parser a
p Parser b
end)