{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
module Parsley.Combinator (
satisfy, char, item,
string, token,
oneOf, noneOf,
eof, more,
someTill,
try,
lookAhead, notFollowedBy
) where
import Prelude hiding (traverse, (*>))
import Data.List (sort)
import Parsley.Alternative (manyTill)
import Parsley.Applicative (($>), void, traverse, (<:>), (*>))
import Parsley.Internal (Code, Quapplicative(..), Parser, Defunc(LIFTED, EQ_H, CONST, LAM_S), pattern APP_H, pattern COMPOSE_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 = Defunc (Char -> Bool) -> Parser Char
forall (rep :: Type -> Type).
ParserOps rep =>
rep (Char -> Bool) -> Parser Char
satisfy (Defunc (Char -> Bool) -> Parser Char)
-> (String -> Defunc (Char -> Bool)) -> String -> Parser Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Defunc (Char -> Bool)
elem'
noneOf :: [Char] -> Parser Char
noneOf :: String -> Parser Char
noneOf = Defunc (Char -> Bool) -> Parser Char
forall (rep :: Type -> Type).
ParserOps rep =>
rep (Char -> Bool) -> Parser Char
satisfy (Defunc (Char -> Bool) -> Parser Char)
-> (String -> Defunc (Char -> Bool)) -> String -> Parser Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Defunc (Bool -> Bool)
-> Defunc (Char -> Bool) -> Defunc (Char -> Bool)
forall z x y b c a.
((x -> y -> z) ~ ((b -> c) -> (a -> b) -> a -> c)) =>
Defunc x -> Defunc y -> Defunc z
COMPOSE_H ((Bool -> Bool) -> Code (Bool -> Bool) -> Defunc (Bool -> Bool)
forall (q :: Type -> Type) a. Quapplicative q => a -> Code a -> q a
makeQ Bool -> Bool
not [||not||]) (Defunc (Char -> Bool) -> Defunc (Char -> Bool))
-> (String -> Defunc (Char -> Bool))
-> String
-> Defunc (Char -> Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Defunc (Char -> Bool)
elem'
elem' :: [Char] -> Defunc (Char -> Bool)
elem' :: String -> Defunc (Char -> Bool)
elem' String
cs = (Defunc Char -> Defunc Bool) -> Defunc (Char -> Bool)
forall a1 b. (Defunc a1 -> Defunc b) -> Defunc (a1 -> b)
LAM_S (\Defunc Char
c -> Bool -> Code Bool -> Defunc Bool
forall (q :: Type -> Type) a. Quapplicative q => a -> Code a -> q a
makeQ (Char -> String -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
elem (Defunc Char -> Char
forall (q :: Type -> Type) a. Quapplicative q => q a -> a
_val Defunc Char
c) String
cs) (String -> Code Char -> Code Bool
ofChars String
cs (Defunc Char -> Code Char
forall (q :: Type -> Type) a. Quapplicative q => q a -> Code a
_code Defunc Char
c)))
ofChars :: [Char] -> Code Char -> Code Bool
ofChars :: String -> Code Char -> Code Bool
ofChars [] Code Char
_ = [||False||]
ofChars String
cs Code Char
qc = (Code Bool -> Code Bool -> Code Bool) -> [Code Bool] -> Code Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> a -> a) -> t a -> a
foldr1 (\Code Bool
p Code Bool
q -> [|| $$p || $$q ||]) (((Char, Char) -> Code Bool) -> [(Char, Char)] -> [Code Bool]
forall a b. (a -> b) -> [a] -> [b]
map (Code Char -> (Char, Char) -> Code Bool
makePred Code Char
qc) (String -> [(Char, Char)]
ranges String
cs))
makePred :: Code Char -> (Char, Char) -> Code Bool
makePred :: Code Char -> (Char, Char) -> Code Bool
makePred Code Char
qc (Char
c, Char
c')
| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c' = [|| c == $$qc ||]
| Bool
otherwise = [|| c <= $$qc && $$qc <= c' ||]
ranges :: [Char] -> [(Char, Char)]
ranges :: String -> [(Char, Char)]
ranges (String -> String
forall a. Ord a => [a] -> [a]
sort -> Char
c:String
cs) = Char -> Int -> String -> [(Char, Char)]
go Char
c (Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c) String
cs
where
go :: Char -> Int -> [Char] -> [(Char, Char)]
go :: Char -> Int -> String -> [(Char, Char)]
go Char
lower Int
prev [] = [(Char
lower, Int -> Char
forall a. Enum a => Int -> a
toEnum Int
prev)]
go Char
lower Int
prev (Char
c:String
cs)
| Int
i <- Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c, Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
prev Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 = Char -> Int -> String -> [(Char, Char)]
go Char
lower Int
i String
cs
| Bool
otherwise = (Char
lower, Int -> Char
forall a. Enum a => Int -> a
toEnum Int
prev) (Char, Char) -> [(Char, Char)] -> [(Char, Char)]
forall a. a -> [a] -> [a]
: Char -> Int -> String -> [(Char, Char)]
go Char
c (Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c) String
cs
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)