{-|
Module      : Parsley.Selective
Description : The @Selective@ combinators
License     : BSD-3-Clause
Maintainer  : Jamie Willis
Stability   : stable

A version of the @Selective@ combinators as described in [/Selective Applicative Functors/
(Mokhov et al. 2019)](https://dl.acm.org/doi/10.1145/3341694).

Like the @Applicative@ and @Alternative@ combinators, these cannot be properly described by the
@Selective@ typeclass, since the API relies on Template Haskell code being used by @Applicative@.

@since 0.1.0.0
-}
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)

{-|
Similar to `branch`, except the given branch is only executed on a @Left@ returned.

> select p q = branch p q (pure id)

@since 0.1.0.0
-}
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)

-- Filter Combinators
{-|
This combinator is used for filtering. Given @px >??> pf@, if @px@ succeeds, then @pf@ will be
attempted too. Then the result of @px@ is given to @pf@'s. If the function returns true then the
parser succeeds and returns the result of @px@, otherwise it will fail.

@since 0.1.0.0
-}
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
    -- Not sure if I need the LET_S?
    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 ()||])

{-|
An alias for @(`>?>`)@.

@since 0.1.0.0
-}
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

{-|
This combinator is used for filtering, similar to @(`>??>`)@ except the predicate is given without
parsing anything.

> px >?> f = px >??> pure f

@since 0.1.0.0
-}
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

-- Conditional Combinators
{-|
Similar to an @if@ statement: @predicate f p t e@ first parses @p@ and collects its result @x@.
If @f x@ is @True@ then @t@ is parsed, else @e@ is parsed.

@since 0.1.0.0
-}
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

{-|
A \"ternary\" combinator, essentially `predicate` given the identity function.

@since 0.1.0.0
-}
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 Combinators
{-|
The `match` combinator can be thought of as a restricted form of @(>>=)@, where there is a fixed
domain on the valid outputs of the second argument.

More concretely, @match dom p f def@ first parses @p@, and, if its result is an element of the list
@dom@, its result is applied to the function @f@ and the resulting parser is executed. If the result
was not in @dom@, then @def@ will be executed.

Note: To eliminate the dynamic nature of the operation, every possible outcome of the parser is
enumerated and tried in turn.

@since 0.1.0.0
-}
match :: (Eq a, Lift a)
      => [a]             -- ^ The domain of the function given as the third argument
      -> Parser a        -- ^ The parser whose result will be given to the function
      -> (a -> Parser b) -- ^ A function uses to generate the parser to execute
      -> Parser b        -- ^ A parser to execute if the result is not in the domain of the function
      -> 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

{-|
This combinator, known as @sbind@ in the literature, is best avoided for efficiency sake. It is
built on `match`, but where the domain of the function is /all/ of the possible values of the
datatype. This means the type must be finite, or else this combinator would never terminate.

The problem with the combinator is not so much that it takes linear time to take the right branch
(as opposed to monadic @(>>=)@) but that it generates a /massive/ amount of code when the datatype
gets too big. For instance, using it for `Char` would generate a 66535-way case split!

The role this combinator fulfils is the branching behaviour that monadic operations can provide.
For the persistence or duplication of data that monads can provide, `Parsley.Register.bind` is a much better
alternative.

@since 0.1.0.0
-}
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

-- Composite Combinators
{-|
This combinator will only execute its second argument if the first one returned @True@.

@since 0.1.0.0
-}
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)

{-|
The fixed-point of the `when` combinator: it will continuously parse its argument until either it
fails (in which case it fails), or until it returns @False@.

@since 0.1.0.0
-}
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)

{-|
Given @fromMaybeP p def@, if @p@ returns a @Nothing@ then @def@ is executed, otherwise the result
of @p@ will be returned with the @Just@ removed.

@since 0.1.0.0
-}
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)