module Parsley.Selective (
branch, select,
(>??>), filteredBy, (>?>),
predicate, (<?:>),
conditional, match, (||=),
when, while,
fromMaybeP
) where
import Prelude hiding (pure, (<$>))
import Data.Function (fix)
import Language.Haskell.TH.Syntax (Lift(..))
import Parsley.Alternative (empty)
import Parsley.Applicative (pure, (<$>), liftA2, unit, constp)
import Parsley.Internal (makeQ, Parser, Defunc(ID, EQ_H, IF_S, LAM_S, LET_S, APP_H), ParserOps, conditional, branch)
select :: Parser (Either a b) -> Parser (a -> b) -> Parser b
select :: Parser (Either a b) -> Parser (a -> b) -> Parser b
select Parser (Either a b)
p Parser (a -> b)
q = Parser (Either a b)
-> Parser (a -> b) -> Parser (b -> b) -> Parser b
forall a b c.
Parser (Either a b)
-> Parser (a -> c) -> Parser (b -> c) -> Parser c
branch Parser (Either a b)
p Parser (a -> b)
q (Defunc (b -> b) -> Parser (b -> b)
forall (rep :: Type -> Type) a. ParserOps rep => rep a -> Parser a
pure Defunc (b -> b)
forall a. Defunc (a -> a)
ID)
infixl 4 >??>
(>??>) :: Parser a -> Parser (a -> Bool) -> Parser a
Parser a
px >??> :: Parser a -> Parser (a -> Bool) -> Parser a
>??> Parser (a -> Bool)
pf = Parser (Either () a) -> Parser (() -> a) -> Parser a
forall a b. Parser (Either a b) -> Parser (a -> b) -> Parser b
select (Defunc ((a -> Bool) -> a -> Either () a)
-> Parser (a -> Bool) -> Parser a -> Parser (Either () a)
forall (rep :: Type -> Type) a b c.
ParserOps rep =>
rep (a -> b -> c) -> Parser a -> Parser b -> Parser c
liftA2 Defunc ((a -> Bool) -> a -> Either () a)
forall a. Defunc ((a -> Bool) -> a -> Either () a)
g Parser (a -> Bool)
pf Parser a
px) Parser (() -> a)
forall a. Parser a
empty
where
g :: Defunc ((a -> Bool) -> a -> Either () a)
g =
(Defunc (a -> Bool) -> Defunc (a -> Either () a))
-> Defunc ((a -> Bool) -> a -> Either () a)
forall a a. (Defunc a -> Defunc a) -> Defunc (a -> a)
LAM_S ((Defunc (a -> Bool) -> Defunc (a -> Either () a))
-> Defunc ((a -> Bool) -> a -> Either () a))
-> (Defunc (a -> Bool) -> Defunc (a -> Either () a))
-> Defunc ((a -> Bool) -> a -> Either () a)
forall a b. (a -> b) -> a -> b
$ \Defunc (a -> Bool)
f ->
(Defunc a -> Defunc (Either () a)) -> Defunc (a -> Either () a)
forall a a. (Defunc a -> Defunc a) -> Defunc (a -> a)
LAM_S ((Defunc a -> Defunc (Either () a)) -> Defunc (a -> Either () a))
-> (Defunc a -> Defunc (Either () a)) -> Defunc (a -> Either () a)
forall a b. (a -> b) -> a -> b
$ \Defunc a
x ->
Defunc a
-> (Defunc a -> Defunc (Either () a)) -> Defunc (Either () a)
forall a b. Defunc a -> (Defunc a -> Defunc b) -> Defunc b
LET_S Defunc a
x ((Defunc a -> Defunc (Either () a)) -> Defunc (Either () a))
-> (Defunc a -> Defunc (Either () a)) -> Defunc (Either () a)
forall a b. (a -> b) -> a -> b
$ \Defunc a
x ->
Defunc Bool
-> Defunc (Either () a)
-> Defunc (Either () a)
-> Defunc (Either () a)
forall a. Defunc Bool -> Defunc a -> Defunc a -> Defunc a
IF_S (Defunc (a -> Bool) -> Defunc a -> Defunc Bool
forall a b. Defunc (a -> b) -> Defunc a -> Defunc b
APP_H Defunc (a -> Bool)
f Defunc a
x)
(Defunc (a -> Either () a) -> Defunc a -> Defunc (Either () a)
forall a b. Defunc (a -> b) -> Defunc a -> Defunc b
APP_H ((a -> Either () a)
-> Code (a -> Either () a) -> Defunc (a -> Either () a)
forall (q :: Type -> Type) a. Quapplicative q => a -> Code a -> q a
makeQ a -> Either () a
forall a b. b -> Either a b
Right [||Right||]) Defunc a
x)
(Either () a -> Code (Either () a) -> Defunc (Either () a)
forall (q :: Type -> Type) a. Quapplicative q => a -> Code a -> q a
makeQ (() -> Either () a
forall a b. a -> Either a b
Left ()) [||Left ()||])
filteredBy :: ParserOps rep => Parser a -> rep (a -> Bool) -> Parser a
filteredBy :: Parser a -> rep (a -> Bool) -> Parser a
filteredBy Parser a
p rep (a -> Bool)
f = Parser a
p Parser a -> Parser (a -> Bool) -> Parser a
forall a. Parser a -> Parser (a -> Bool) -> Parser a
>??> rep (a -> Bool) -> Parser (a -> Bool)
forall (rep :: Type -> Type) a. ParserOps rep => rep a -> Parser a
pure rep (a -> Bool)
f
infixl 4 >?>
(>?>) :: ParserOps rep => Parser a -> rep (a -> Bool) -> Parser a
>?> :: Parser a -> rep (a -> Bool) -> Parser a
(>?>) = Parser a -> rep (a -> Bool) -> Parser a
forall (rep :: Type -> Type) a.
ParserOps rep =>
Parser a -> rep (a -> Bool) -> Parser a
filteredBy
predicate :: ParserOps rep => rep (a -> Bool) -> Parser a -> Parser b -> Parser b -> Parser b
predicate :: rep (a -> Bool) -> Parser a -> Parser b -> Parser b -> Parser b
predicate rep (a -> Bool)
cond Parser a
p Parser b
t Parser b
e = [(rep (a -> Bool), Parser b)] -> Parser a -> Parser b -> Parser b
forall (rep :: Type -> Type) a b.
ParserOps rep =>
[(rep (a -> Bool), Parser b)] -> Parser a -> Parser b -> Parser b
conditional [(rep (a -> Bool)
cond, Parser b
t)] Parser a
p Parser b
e
infixl 4 <?:>
(<?:>) :: Parser Bool -> (Parser a, Parser a) -> Parser a
Parser Bool
cond <?:> :: Parser Bool -> (Parser a, Parser a) -> Parser a
<?:> (Parser a
p, Parser a
q) = Defunc (Bool -> Bool)
-> Parser Bool -> Parser a -> Parser a -> Parser a
forall (rep :: Type -> Type) a b.
ParserOps rep =>
rep (a -> Bool) -> Parser a -> Parser b -> Parser b -> Parser b
predicate Defunc (Bool -> Bool)
forall a. Defunc (a -> a)
ID Parser Bool
cond Parser a
p Parser a
q
match :: (Eq a, Lift a)
=> [a]
-> Parser a
-> (a -> Parser b)
-> Parser b
-> Parser b
match :: [a] -> Parser a -> (a -> Parser b) -> Parser b -> Parser b
match [a]
vs Parser a
p a -> Parser b
f = [(Defunc (a -> Bool), Parser b)]
-> Parser a -> Parser b -> Parser b
forall (rep :: Type -> Type) a b.
ParserOps rep =>
[(rep (a -> Bool), Parser b)] -> Parser a -> Parser b -> Parser b
conditional ((a -> (Defunc (a -> Bool), Parser b))
-> [a] -> [(Defunc (a -> Bool), Parser b)]
forall a b. (a -> b) -> [a] -> [b]
map (\a
v -> (Defunc a -> Defunc (a -> Bool)
forall a. Eq a => Defunc a -> Defunc (a -> Bool)
EQ_H (a -> Code a -> Defunc a
forall (q :: Type -> Type) a. Quapplicative q => a -> Code a -> q a
makeQ a
v [||v||]), a -> Parser b
f a
v)) [a]
vs) Parser a
p
infixl 1 ||=
(||=) :: (Enum a, Bounded a, Eq a, Lift a) => Parser a -> (a -> Parser b) -> Parser b
Parser a
p ||= :: Parser a -> (a -> Parser b) -> Parser b
||= a -> Parser b
f = [a] -> Parser a -> (a -> Parser b) -> Parser b -> Parser b
forall a b.
(Eq a, Lift a) =>
[a] -> Parser a -> (a -> Parser b) -> Parser b -> Parser b
match [a
forall a. Bounded a => a
minBound..a
forall a. Bounded a => a
maxBound] Parser a
p a -> Parser b
f Parser b
forall a. Parser a
empty
when :: Parser Bool -> Parser () -> Parser ()
when :: Parser Bool -> Parser () -> Parser ()
when Parser Bool
p Parser ()
q = Parser Bool
p Parser Bool -> (Parser (), Parser ()) -> Parser ()
forall a. Parser Bool -> (Parser a, Parser a) -> Parser a
<?:> (Parser ()
q, Parser ()
unit)
while :: Parser Bool -> Parser ()
while :: Parser Bool -> Parser ()
while Parser Bool
x = (Parser () -> Parser ()) -> Parser ()
forall a. (a -> a) -> a
fix (Parser Bool -> Parser () -> Parser ()
when Parser Bool
x)
fromMaybeP :: Parser (Maybe a) -> Parser a -> Parser a
fromMaybeP :: Parser (Maybe a) -> Parser a -> Parser a
fromMaybeP Parser (Maybe a)
pm Parser a
px = Parser (Either () a) -> Parser (() -> a) -> Parser a
forall a b. Parser (Either a b) -> Parser (a -> b) -> Parser b
select ((Maybe a -> Either () a)
-> Code (Maybe a -> Either () a) -> Defunc (Maybe a -> Either () a)
forall (q :: Type -> Type) a. Quapplicative q => a -> Code a -> q a
makeQ (Either () a -> (a -> Either () a) -> Maybe a -> Either () a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Either () a
forall a b. a -> Either a b
Left ()) a -> Either () a
forall a b. b -> Either a b
Right) [||maybe (Left ()) Right||] Defunc (Maybe a -> Either () a)
-> Parser (Maybe a) -> Parser (Either () a)
forall (rep :: Type -> Type) a b.
ParserOps rep =>
rep (a -> b) -> Parser a -> Parser b
<$> Parser (Maybe a)
pm) (Parser a -> Parser (() -> a)
forall a b. Parser a -> Parser (b -> a)
constp Parser a
px)