-- | a collection of generic parsing combinators that can work with any token and error type.
{-# LANGUAGE CPP, TemplateHaskell, TypeOperators #-}
module Text.Boomerang.Combinators
    ( (<>), duck, duck1, opt
    , manyr, somer, chainr, chainr1, manyl, somel, chainl, chainl1
    , rFilter, printAs, push, rNil, rCons, rList, rList1, rListSep, rPair
    , rLeft, rRight, rEither, rNothing, rJust, rMaybe
    , rTrue, rFalse, rBool, rUnit
    )
    where

import Control.Arrow       (first, second)
import Prelude             hiding ((.), id, (/))
import Control.Category    (Category((.), id))
import Control.Monad       (guard)
import Text.Boomerang.Prim    (Parser(..), Boomerang(..), (.~), val, xpure)
import Text.Boomerang.HStack   ((:-)(..), arg, hhead)
import Text.Boomerang.TH      (makeBoomerangs)

#if MIN_VERSION_base(4,5,0)
import Data.Monoid         (Monoid(mappend), (<>))
#else
import Data.Monoid         (Monoid(mappend))

infixr 6 <>

-- | Infix operator for 'mappend'.
(<>) :: Monoid m => m -> m -> m
(<>) = mappend
#endif

-- | Convert a router to do what it does on the tail of the stack.
duck :: Boomerang e tok r1 r2 -> Boomerang e tok (h :- r1) (h :- r2)
duck :: Boomerang e tok r1 r2 -> Boomerang e tok (h :- r1) (h :- r2)
duck Boomerang e tok r1 r2
r = Parser e tok ((h :- r1) -> h :- r2)
-> ((h :- r2) -> [(tok -> tok, h :- r1)])
-> Boomerang e tok (h :- r1) (h :- r2)
forall e tok a b.
Parser e tok (a -> b)
-> (b -> [(tok -> tok, a)]) -> Boomerang e tok a b
Boomerang
  (((r1 -> r2) -> (h :- r1) -> h :- r2)
-> Parser e tok (r1 -> r2) -> Parser e tok ((h :- r1) -> h :- r2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\r1 -> r2
f (h
h :- r1
t) -> h
h h -> r2 -> h :- r2
forall a b. a -> b -> a :- b
:- r1 -> r2
f r1
t) (Parser e tok (r1 -> r2) -> Parser e tok ((h :- r1) -> h :- r2))
-> Parser e tok (r1 -> r2) -> Parser e tok ((h :- r1) -> h :- r2)
forall a b. (a -> b) -> a -> b
$ Boomerang e tok r1 r2 -> Parser e tok (r1 -> r2)
forall e tok a b. Boomerang e tok a b -> Parser e tok (a -> b)
prs Boomerang e tok r1 r2
r)
  (\(h
h :- r2
t) -> ((tok -> tok, r1) -> (tok -> tok, h :- r1))
-> [(tok -> tok, r1)] -> [(tok -> tok, h :- r1)]
forall a b. (a -> b) -> [a] -> [b]
map ((r1 -> h :- r1) -> (tok -> tok, r1) -> (tok -> tok, h :- r1)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (h
h h -> r1 -> h :- r1
forall a b. a -> b -> a :- b
:-)) ([(tok -> tok, r1)] -> [(tok -> tok, h :- r1)])
-> [(tok -> tok, r1)] -> [(tok -> tok, h :- r1)]
forall a b. (a -> b) -> a -> b
$ Boomerang e tok r1 r2 -> r2 -> [(tok -> tok, r1)]
forall e tok a b. Boomerang e tok a b -> b -> [(tok -> tok, a)]
ser Boomerang e tok r1 r2
r r2
t)

-- | Convert a router to do what it does on the tail of the stack.
duck1 :: Boomerang e tok r1 (a :- r2) -> Boomerang e tok (h :- r1) (a :- h :- r2)
duck1 :: Boomerang e tok r1 (a :- r2)
-> Boomerang e tok (h :- r1) (a :- (h :- r2))
duck1 Boomerang e tok r1 (a :- r2)
r = Parser e tok ((h :- r1) -> a :- (h :- r2))
-> ((a :- (h :- r2)) -> [(tok -> tok, h :- r1)])
-> Boomerang e tok (h :- r1) (a :- (h :- r2))
forall e tok a b.
Parser e tok (a -> b)
-> (b -> [(tok -> tok, a)]) -> Boomerang e tok a b
Boomerang
  (((r1 -> a :- r2) -> (h :- r1) -> a :- (h :- r2))
-> Parser e tok (r1 -> a :- r2)
-> Parser e tok ((h :- r1) -> a :- (h :- r2))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\r1 -> a :- r2
f (h
h :- r1
t) -> let a
a :- r2
t' = r1 -> a :- r2
f r1
t in a
a a -> (h :- r2) -> a :- (h :- r2)
forall a b. a -> b -> a :- b
:- h
h h -> r2 -> h :- r2
forall a b. a -> b -> a :- b
:- r2
t') (Parser e tok (r1 -> a :- r2)
 -> Parser e tok ((h :- r1) -> a :- (h :- r2)))
-> Parser e tok (r1 -> a :- r2)
-> Parser e tok ((h :- r1) -> a :- (h :- r2))
forall a b. (a -> b) -> a -> b
$ Boomerang e tok r1 (a :- r2) -> Parser e tok (r1 -> a :- r2)
forall e tok a b. Boomerang e tok a b -> Parser e tok (a -> b)
prs Boomerang e tok r1 (a :- r2)
r)
  (\(a
a :- h
h :- r2
t) -> ((tok -> tok, r1) -> (tok -> tok, h :- r1))
-> [(tok -> tok, r1)] -> [(tok -> tok, h :- r1)]
forall a b. (a -> b) -> [a] -> [b]
map ((r1 -> h :- r1) -> (tok -> tok, r1) -> (tok -> tok, h :- r1)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (h
h h -> r1 -> h :- r1
forall a b. a -> b -> a :- b
:-)) ([(tok -> tok, r1)] -> [(tok -> tok, h :- r1)])
-> [(tok -> tok, r1)] -> [(tok -> tok, h :- r1)]
forall a b. (a -> b) -> a -> b
$ Boomerang e tok r1 (a :- r2) -> (a :- r2) -> [(tok -> tok, r1)]
forall e tok a b. Boomerang e tok a b -> b -> [(tok -> tok, a)]
ser Boomerang e tok r1 (a :- r2)
r (a
a a -> r2 -> a :- r2
forall a b. a -> b -> a :- b
:- r2
t))

-- | Make a router optional.
opt :: Boomerang e tok r r -> Boomerang e tok r r
opt :: Boomerang e tok r r -> Boomerang e tok r r
opt = (Boomerang e tok r r
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id Boomerang e tok r r -> Boomerang e tok r r -> Boomerang e tok r r
forall a. Semigroup a => a -> a -> a
<>)

-- | Repeat a router zero or more times, combining the results from left to right.
manyr :: Boomerang e tok r r -> Boomerang e tok r r
manyr :: Boomerang e tok r r -> Boomerang e tok r r
manyr = Boomerang e tok r r -> Boomerang e tok r r
forall e tok r. Boomerang e tok r r -> Boomerang e tok r r
opt (Boomerang e tok r r -> Boomerang e tok r r)
-> (Boomerang e tok r r -> Boomerang e tok r r)
-> Boomerang e tok r r
-> Boomerang e tok r r
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Boomerang e tok r r -> Boomerang e tok r r
forall e tok r. Boomerang e tok r r -> Boomerang e tok r r
somer

-- | Repeat a router one or more times, combining the results from left to right.
somer :: Boomerang e tok r r -> Boomerang e tok r r
somer :: Boomerang e tok r r -> Boomerang e tok r r
somer Boomerang e tok r r
p = Boomerang e tok r r
p Boomerang e tok r r -> Boomerang e tok r r -> Boomerang e tok r r
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Boomerang e tok r r -> Boomerang e tok r r
forall e tok r. Boomerang e tok r r -> Boomerang e tok r r
manyr Boomerang e tok r r
p

-- | @chainr p op@ repeats @p@ zero or more times, separated by @op@.
--   The result is a right associative fold of the results of @p@ with the results of @op@.
chainr :: Boomerang e tok r r -> Boomerang e tok r r -> Boomerang e tok r r
chainr :: Boomerang e tok r r -> Boomerang e tok r r -> Boomerang e tok r r
chainr Boomerang e tok r r
p Boomerang e tok r r
op = Boomerang e tok r r -> Boomerang e tok r r
forall e tok r. Boomerang e tok r r -> Boomerang e tok r r
opt (Boomerang e tok r r -> Boomerang e tok r r
forall e tok r. Boomerang e tok r r -> Boomerang e tok r r
manyr (Boomerang e tok r r
p Boomerang e tok r r -> Boomerang e tok r r -> Boomerang e tok r r
forall e tok a b c.
Boomerang e tok a b -> Boomerang e tok b c -> Boomerang e tok a c
.~ Boomerang e tok r r
op) Boomerang e tok r r -> Boomerang e tok r r -> Boomerang e tok r r
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Boomerang e tok r r
p)

-- | @chainr1 p op@ repeats @p@ one or more times, separated by @op@.
--   The result is a right associative fold of the results of @p@ with the results of @op@.
chainr1 :: Boomerang e tok r (a :- r) -> Boomerang e tok (a :- a :- r) (a :- r) -> Boomerang e tok r (a :- r)
chainr1 :: Boomerang e tok r (a :- r)
-> Boomerang e tok (a :- (a :- r)) (a :- r)
-> Boomerang e tok r (a :- r)
chainr1 Boomerang e tok r (a :- r)
p Boomerang e tok (a :- (a :- r)) (a :- r)
op = Boomerang e tok (a :- r) (a :- r)
-> Boomerang e tok (a :- r) (a :- r)
forall e tok r. Boomerang e tok r r -> Boomerang e tok r r
manyr (Boomerang e tok r (a :- r)
-> Boomerang e tok (a :- r) (a :- (a :- r))
forall e tok r1 r2 h.
Boomerang e tok r1 r2 -> Boomerang e tok (h :- r1) (h :- r2)
duck Boomerang e tok r (a :- r)
p Boomerang e tok (a :- r) (a :- (a :- r))
-> Boomerang e tok (a :- (a :- r)) (a :- r)
-> Boomerang e tok (a :- r) (a :- r)
forall e tok a b c.
Boomerang e tok a b -> Boomerang e tok b c -> Boomerang e tok a c
.~ Boomerang e tok (a :- (a :- r)) (a :- r)
op) Boomerang e tok (a :- r) (a :- r)
-> Boomerang e tok r (a :- r) -> Boomerang e tok r (a :- r)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Boomerang e tok r (a :- r)
p

-- | Repeat a router zero or more times, combining the results from right to left.
manyl :: Boomerang e tok r r -> Boomerang e tok r r
manyl :: Boomerang e tok r r -> Boomerang e tok r r
manyl = Boomerang e tok r r -> Boomerang e tok r r
forall e tok r. Boomerang e tok r r -> Boomerang e tok r r
opt (Boomerang e tok r r -> Boomerang e tok r r)
-> (Boomerang e tok r r -> Boomerang e tok r r)
-> Boomerang e tok r r
-> Boomerang e tok r r
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Boomerang e tok r r -> Boomerang e tok r r
forall e tok r. Boomerang e tok r r -> Boomerang e tok r r
somel

-- | Repeat a router one or more times, combining the results from right to left.
somel :: Boomerang e tok r r -> Boomerang e tok r r
somel :: Boomerang e tok r r -> Boomerang e tok r r
somel Boomerang e tok r r
p = Boomerang e tok r r
p Boomerang e tok r r -> Boomerang e tok r r -> Boomerang e tok r r
forall e tok a b c.
Boomerang e tok a b -> Boomerang e tok b c -> Boomerang e tok a c
.~ Boomerang e tok r r -> Boomerang e tok r r
forall e tok r. Boomerang e tok r r -> Boomerang e tok r r
manyl Boomerang e tok r r
p

-- | @chainl1 p op@ repeats @p@ zero or more times, separated by @op@.
--   The result is a left associative fold of the results of @p@ with the results of @op@.
chainl :: Boomerang e tok r r -> Boomerang e tok r r -> Boomerang e tok r r
chainl :: Boomerang e tok r r -> Boomerang e tok r r -> Boomerang e tok r r
chainl Boomerang e tok r r
p Boomerang e tok r r
op = Boomerang e tok r r -> Boomerang e tok r r
forall e tok r. Boomerang e tok r r -> Boomerang e tok r r
opt (Boomerang e tok r r
p Boomerang e tok r r -> Boomerang e tok r r -> Boomerang e tok r r
forall e tok a b c.
Boomerang e tok a b -> Boomerang e tok b c -> Boomerang e tok a c
.~ Boomerang e tok r r -> Boomerang e tok r r
forall e tok r. Boomerang e tok r r -> Boomerang e tok r r
manyl (Boomerang e tok r r
op Boomerang e tok r r -> Boomerang e tok r r -> Boomerang e tok r r
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Boomerang e tok r r
p))

-- | @chainl1 p op@ repeats @p@ one or more times, separated by @op@.
--   The result is a left associative fold of the results of @p@ with the results of @op@.
chainl1 :: Boomerang e tok r (a :- r) -> Boomerang e tok (a :- a :- r) (a :- r) -> Boomerang e tok r (a :- r)
chainl1 :: Boomerang e tok r (a :- r)
-> Boomerang e tok (a :- (a :- r)) (a :- r)
-> Boomerang e tok r (a :- r)
chainl1 Boomerang e tok r (a :- r)
p Boomerang e tok (a :- (a :- r)) (a :- r)
op = Boomerang e tok r (a :- r)
p Boomerang e tok r (a :- r)
-> Boomerang e tok (a :- r) (a :- r) -> Boomerang e tok r (a :- r)
forall e tok a b c.
Boomerang e tok a b -> Boomerang e tok b c -> Boomerang e tok a c
.~ Boomerang e tok (a :- r) (a :- r)
-> Boomerang e tok (a :- r) (a :- r)
forall e tok r. Boomerang e tok r r -> Boomerang e tok r r
manyl (Boomerang e tok (a :- (a :- r)) (a :- r)
op Boomerang e tok (a :- (a :- r)) (a :- r)
-> Boomerang e tok (a :- r) (a :- (a :- r))
-> Boomerang e tok (a :- r) (a :- r)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Boomerang e tok r (a :- r)
-> Boomerang e tok (a :- r) (a :- (a :- r))
forall e tok r1 r2 h.
Boomerang e tok r1 r2 -> Boomerang e tok (h :- r1) (h :- r2)
duck Boomerang e tok r (a :- r)
p)

-- | Filtering on routers.
--
-- TODO: We remove any parse errors, not sure if the should be preserved. Also, if the predicate fails we silently remove the element, but perhaps we should replace the value with an error message?
rFilter :: (a -> Bool) -> Boomerang e tok () (a :- ()) -> Boomerang e tok r (a :- r)
rFilter :: (a -> Bool)
-> Boomerang e tok () (a :- ()) -> Boomerang e tok r (a :- r)
rFilter a -> Bool
p Boomerang e tok () (a :- ())
r = Parser e tok a -> (a -> [tok -> tok]) -> Boomerang e tok r (a :- r)
forall e tok a r.
Parser e tok a -> (a -> [tok -> tok]) -> Boomerang e tok r (a :- r)
val Parser e tok a
ps a -> [tok -> tok]
ss
    where
      ps :: Parser e tok a
ps = (tok -> Pos e -> [Either e ((a, tok), Pos e)]) -> Parser e tok a
forall e tok a.
(tok -> Pos e -> [Either e ((a, tok), Pos e)]) -> Parser e tok a
Parser ((tok -> Pos e -> [Either e ((a, tok), Pos e)]) -> Parser e tok a)
-> (tok -> Pos e -> [Either e ((a, tok), Pos e)]) -> Parser e tok a
forall a b. (a -> b) -> a -> b
$ \tok
tok Pos e
pos ->
           let parses :: [Either e ((() -> a :- (), tok), Pos e)]
parses = Parser e tok (() -> a :- ())
-> tok -> Pos e -> [Either e ((() -> a :- (), tok), Pos e)]
forall e tok a.
Parser e tok a -> tok -> Pos e -> [Either e ((a, tok), Pos e)]
runParser (Boomerang e tok () (a :- ()) -> Parser e tok (() -> a :- ())
forall e tok a b. Boomerang e tok a b -> Parser e tok (a -> b)
prs Boomerang e tok () (a :- ())
r) tok
tok Pos e
pos
           in [ ((a, tok), Pos e) -> Either e ((a, tok), Pos e)
forall a b. b -> Either a b
Right ((a
a, tok
tok), Pos e
pos) | (Right ((() -> a :- ()
f, tok
tok), Pos e
pos)) <- [Either e ((() -> a :- (), tok), Pos e)]
parses, let a :: a
a = (a :- ()) -> a
forall a b. (a :- b) -> a
hhead (() -> a :- ()
f ()), a -> Bool
p a
a]
      ss :: a -> [tok -> tok]
ss = \a
a -> [ tok -> tok
f | a -> Bool
p a
a, (tok -> tok
f, ()
_) <- Boomerang e tok () (a :- ()) -> (a :- ()) -> [(tok -> tok, ())]
forall e tok a b. Boomerang e tok a b -> b -> [(tok -> tok, a)]
ser Boomerang e tok () (a :- ())
r (a
a a -> () -> a :- ()
forall a b. a -> b -> a :- b
:- ()) ]

-- | @r \`printAs\` s@ uses ther serializer of @r@ to test if serializing succeeds,
--   and if it does, instead serializes as @s@.
--
-- TODO: can this be more general so that it can work on @tok@ instead of @[tok]@
printAs :: Boomerang e [tok] a b -> tok -> Boomerang e [tok] a b
printAs :: Boomerang e [tok] a b -> tok -> Boomerang e [tok] a b
printAs Boomerang e [tok] a b
r tok
s = Boomerang e [tok] a b
r { ser :: b -> [([tok] -> [tok], a)]
ser = (([tok] -> [tok], a) -> ([tok] -> [tok], a))
-> [([tok] -> [tok], a)] -> [([tok] -> [tok], a)]
forall a b. (a -> b) -> [a] -> [b]
map ((([tok] -> [tok]) -> [tok] -> [tok])
-> ([tok] -> [tok], a) -> ([tok] -> [tok], a)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (([tok] -> [tok]) -> ([tok] -> [tok]) -> [tok] -> [tok]
forall a b. a -> b -> a
const (tok
s tok -> [tok] -> [tok]
forall a. a -> [a] -> [a]
:))) ([([tok] -> [tok], a)] -> [([tok] -> [tok], a)])
-> (b -> [([tok] -> [tok], a)]) -> b -> [([tok] -> [tok], a)]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> [([tok] -> [tok], a)] -> [([tok] -> [tok], a)]
forall a. Int -> [a] -> [a]
take Int
1 ([([tok] -> [tok], a)] -> [([tok] -> [tok], a)])
-> (b -> [([tok] -> [tok], a)]) -> b -> [([tok] -> [tok], a)]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Boomerang e [tok] a b -> b -> [([tok] -> [tok], a)]
forall e tok a b. Boomerang e tok a b -> b -> [(tok -> tok, a)]
ser Boomerang e [tok] a b
r }

-- | Push a value on the stack (during parsing, pop it from the stack when serializing).
push :: Eq a => a -> Boomerang e tok r (a :- r)
push :: a -> Boomerang e tok r (a :- r)
push a
a = (r -> a :- r)
-> ((a :- r) -> Maybe r) -> Boomerang e tok r (a :- r)
forall a b e tok. (a -> b) -> (b -> Maybe a) -> Boomerang e tok a b
xpure (a
a a -> r -> a :- r
forall a b. a -> b -> a :- b
:-) (\(a
a' :- r
t) -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (a
a' a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a) Maybe () -> Maybe r -> Maybe r
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> r -> Maybe r
forall a. a -> Maybe a
Just r
t)

rNil :: Boomerang e tok r ([a] :- r)
rNil :: Boomerang e tok r ([a] :- r)
rNil = (r -> [a] :- r)
-> (([a] :- r) -> Maybe r) -> Boomerang e tok r ([a] :- r)
forall a b e tok. (a -> b) -> (b -> Maybe a) -> Boomerang e tok a b
xpure ([] [a] -> r -> [a] :- r
forall a b. a -> b -> a :- b
:-) ((([a] :- r) -> Maybe r) -> Boomerang e tok r ([a] :- r))
-> (([a] :- r) -> Maybe r) -> Boomerang e tok r ([a] :- r)
forall a b. (a -> b) -> a -> b
$ \([a]
xs :- r
t) -> do [] <- [a] -> Maybe [a]
forall a. a -> Maybe a
Just [a]
xs; r -> Maybe r
forall a. a -> Maybe a
Just r
t

rCons :: Boomerang e tok (a :- [a] :- r) ([a] :- r)
rCons :: Boomerang e tok (a :- ([a] :- r)) ([a] :- r)
rCons = ((a :- ([a] :- r)) -> [a] :- r)
-> (([a] :- r) -> Maybe (a :- ([a] :- r)))
-> Boomerang e tok (a :- ([a] :- r)) ([a] :- r)
forall a b e tok. (a -> b) -> (b -> Maybe a) -> Boomerang e tok a b
xpure ((([a] -> [a]) -> ([a] :- r) -> [a] :- r)
-> (a -> [a] -> [a]) -> (a :- ([a] :- r)) -> [a] :- r
forall ty r s a. (ty -> r -> s) -> (a -> ty) -> (a :- r) -> s
arg (([a] -> r -> [a] :- r) -> ([a] -> [a]) -> ([a] :- r) -> [a] :- r
forall ty r s a. (ty -> r -> s) -> (a -> ty) -> (a :- r) -> s
arg [a] -> r -> [a] :- r
forall a b. a -> b -> a :- b
(:-)) (:)) ((([a] :- r) -> Maybe (a :- ([a] :- r)))
 -> Boomerang e tok (a :- ([a] :- r)) ([a] :- r))
-> (([a] :- r) -> Maybe (a :- ([a] :- r)))
-> Boomerang e tok (a :- ([a] :- r)) ([a] :- r)
forall a b. (a -> b) -> a -> b
$ \([a]
xs :- r
t) -> do a
a:[a]
as <- [a] -> Maybe [a]
forall a. a -> Maybe a
Just [a]
xs; (a :- ([a] :- r)) -> Maybe (a :- ([a] :- r))
forall a. a -> Maybe a
Just (a
a a -> ([a] :- r) -> a :- ([a] :- r)
forall a b. a -> b -> a :- b
:- [a]
as [a] -> r -> [a] :- r
forall a b. a -> b -> a :- b
:- r
t)

-- | Converts a router for a value @a@ to a router for a list of @a@.
rList :: Boomerang e tok r (a :- r) -> Boomerang e tok r ([a] :- r)
rList :: Boomerang e tok r (a :- r) -> Boomerang e tok r ([a] :- r)
rList Boomerang e tok r (a :- r)
r = Boomerang e tok ([a] :- r) ([a] :- r)
-> Boomerang e tok ([a] :- r) ([a] :- r)
forall e tok r. Boomerang e tok r r -> Boomerang e tok r r
manyr (Boomerang e tok (a :- ([a] :- r)) ([a] :- r)
forall e tok a r. Boomerang e tok (a :- ([a] :- r)) ([a] :- r)
rCons Boomerang e tok (a :- ([a] :- r)) ([a] :- r)
-> Boomerang e tok ([a] :- r) (a :- ([a] :- r))
-> Boomerang e tok ([a] :- r) ([a] :- r)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Boomerang e tok r (a :- r)
-> Boomerang e tok ([a] :- r) (a :- ([a] :- r))
forall e tok r1 a r2 h.
Boomerang e tok r1 (a :- r2)
-> Boomerang e tok (h :- r1) (a :- (h :- r2))
duck1 Boomerang e tok r (a :- r)
r) Boomerang e tok ([a] :- r) ([a] :- r)
-> Boomerang e tok r ([a] :- r) -> Boomerang e tok r ([a] :- r)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Boomerang e tok r ([a] :- r)
forall e tok r a. Boomerang e tok r ([a] :- r)
rNil

-- | Converts a router for a value @a@ to a router for a list of @a@.
rList1 :: Boomerang e tok r (a :- r) -> Boomerang e tok r ([a] :- r)
rList1 :: Boomerang e tok r (a :- r) -> Boomerang e tok r ([a] :- r)
rList1 Boomerang e tok r (a :- r)
r = Boomerang e tok ([a] :- r) ([a] :- r)
-> Boomerang e tok ([a] :- r) ([a] :- r)
forall e tok r. Boomerang e tok r r -> Boomerang e tok r r
somer (Boomerang e tok (a :- ([a] :- r)) ([a] :- r)
forall e tok a r. Boomerang e tok (a :- ([a] :- r)) ([a] :- r)
rCons Boomerang e tok (a :- ([a] :- r)) ([a] :- r)
-> Boomerang e tok ([a] :- r) (a :- ([a] :- r))
-> Boomerang e tok ([a] :- r) ([a] :- r)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Boomerang e tok r (a :- r)
-> Boomerang e tok ([a] :- r) (a :- ([a] :- r))
forall e tok r1 a r2 h.
Boomerang e tok r1 (a :- r2)
-> Boomerang e tok (h :- r1) (a :- (h :- r2))
duck1 Boomerang e tok r (a :- r)
r) Boomerang e tok ([a] :- r) ([a] :- r)
-> Boomerang e tok r ([a] :- r) -> Boomerang e tok r ([a] :- r)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Boomerang e tok r ([a] :- r)
forall e tok r a. Boomerang e tok r ([a] :- r)
rNil

-- | Converts a router for a value @a@ to a router for a list of @a@, with a separator.
rListSep :: Boomerang e tok r (a :- r) -> Boomerang e tok ([a] :- r) ([a] :- r) -> Boomerang e tok r ([a] :- r)
rListSep :: Boomerang e tok r (a :- r)
-> Boomerang e tok ([a] :- r) ([a] :- r)
-> Boomerang e tok r ([a] :- r)
rListSep Boomerang e tok r (a :- r)
r Boomerang e tok ([a] :- r) ([a] :- r)
sep = Boomerang e tok ([a] :- r) ([a] :- r)
-> Boomerang e tok ([a] :- r) ([a] :- r)
-> Boomerang e tok ([a] :- r) ([a] :- r)
forall e tok r.
Boomerang e tok r r -> Boomerang e tok r r -> Boomerang e tok r r
chainr (Boomerang e tok (a :- ([a] :- r)) ([a] :- r)
forall e tok a r. Boomerang e tok (a :- ([a] :- r)) ([a] :- r)
rCons Boomerang e tok (a :- ([a] :- r)) ([a] :- r)
-> Boomerang e tok ([a] :- r) (a :- ([a] :- r))
-> Boomerang e tok ([a] :- r) ([a] :- r)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Boomerang e tok r (a :- r)
-> Boomerang e tok ([a] :- r) (a :- ([a] :- r))
forall e tok r1 a r2 h.
Boomerang e tok r1 (a :- r2)
-> Boomerang e tok (h :- r1) (a :- (h :- r2))
duck1 Boomerang e tok r (a :- r)
r) Boomerang e tok ([a] :- r) ([a] :- r)
sep Boomerang e tok ([a] :- r) ([a] :- r)
-> Boomerang e tok r ([a] :- r) -> Boomerang e tok r ([a] :- r)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Boomerang e tok r ([a] :- r)
forall e tok r a. Boomerang e tok r ([a] :- r)
rNil

rPair :: Boomerang e tok (f :- s :- r) ((f, s) :- r)
rPair :: Boomerang e tok (f :- (s :- r)) ((f, s) :- r)
rPair = ((f :- (s :- r)) -> (f, s) :- r)
-> (((f, s) :- r) -> Maybe (f :- (s :- r)))
-> Boomerang e tok (f :- (s :- r)) ((f, s) :- r)
forall a b e tok. (a -> b) -> (b -> Maybe a) -> Boomerang e tok a b
xpure (((s -> (f, s)) -> (s :- r) -> (f, s) :- r)
-> (f -> s -> (f, s)) -> (f :- (s :- r)) -> (f, s) :- r
forall ty r s a. (ty -> r -> s) -> (a -> ty) -> (a :- r) -> s
arg (((f, s) -> r -> (f, s) :- r)
-> (s -> (f, s)) -> (s :- r) -> (f, s) :- r
forall ty r s a. (ty -> r -> s) -> (a -> ty) -> (a :- r) -> s
arg (f, s) -> r -> (f, s) :- r
forall a b. a -> b -> a :- b
(:-)) (,)) ((((f, s) :- r) -> Maybe (f :- (s :- r)))
 -> Boomerang e tok (f :- (s :- r)) ((f, s) :- r))
-> (((f, s) :- r) -> Maybe (f :- (s :- r)))
-> Boomerang e tok (f :- (s :- r)) ((f, s) :- r)
forall a b. (a -> b) -> a -> b
$ \((f, s)
ab :- r
t) -> do (f
a,s
b) <- (f, s) -> Maybe (f, s)
forall a. a -> Maybe a
Just (f, s)
ab; (f :- (s :- r)) -> Maybe (f :- (s :- r))
forall a. a -> Maybe a
Just (f
a f -> (s :- r) -> f :- (s :- r)
forall a b. a -> b -> a :- b
:- s
b s -> r -> s :- r
forall a b. a -> b -> a :- b
:- r
t)

$(makeBoomerangs ''Either)

-- | Combines a router for a value @a@ and a router for a value @b@ into a router for @Either a b@.
rEither :: Boomerang e tok r (a :- r) -> Boomerang e tok r (b :- r) -> Boomerang e tok r (Either a b :- r)
rEither :: Boomerang e tok r (a :- r)
-> Boomerang e tok r (b :- r)
-> Boomerang e tok r (Either a b :- r)
rEither Boomerang e tok r (a :- r)
l Boomerang e tok r (b :- r)
r = Boomerang e tok (a :- r) (Either a b :- r)
forall tok e r a b. Boomerang e tok (a :- r) (Either a b :- r)
rLeft Boomerang e tok (a :- r) (Either a b :- r)
-> Boomerang e tok r (a :- r)
-> Boomerang e tok r (Either a b :- r)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Boomerang e tok r (a :- r)
l Boomerang e tok r (Either a b :- r)
-> Boomerang e tok r (Either a b :- r)
-> Boomerang e tok r (Either a b :- r)
forall a. Semigroup a => a -> a -> a
<> Boomerang e tok (b :- r) (Either a b :- r)
forall tok e r a b. Boomerang e tok (b :- r) (Either a b :- r)
rRight Boomerang e tok (b :- r) (Either a b :- r)
-> Boomerang e tok r (b :- r)
-> Boomerang e tok r (Either a b :- r)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Boomerang e tok r (b :- r)
r

$(makeBoomerangs ''Maybe)

-- | Converts a router for a value @a@ to a router for a @Maybe a@.
rMaybe :: Boomerang e tok r (a :- r) -> Boomerang e tok r (Maybe a :- r)
rMaybe :: Boomerang e tok r (a :- r) -> Boomerang e tok r (Maybe a :- r)
rMaybe Boomerang e tok r (a :- r)
r = Boomerang e tok (a :- r) (Maybe a :- r)
forall tok e r a. Boomerang e tok (a :- r) (Maybe a :- r)
rJust Boomerang e tok (a :- r) (Maybe a :- r)
-> Boomerang e tok r (a :- r) -> Boomerang e tok r (Maybe a :- r)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Boomerang e tok r (a :- r)
r Boomerang e tok r (Maybe a :- r)
-> Boomerang e tok r (Maybe a :- r)
-> Boomerang e tok r (Maybe a :- r)
forall a. Semigroup a => a -> a -> a
<> Boomerang e tok r (Maybe a :- r)
forall tok e r a. Boomerang e tok r (Maybe a :- r)
rNothing

$(makeBoomerangs ''Bool)

rBool :: Boomerang e tok a r -- ^ 'True' parser
      -> Boomerang e tok a r -- ^ 'False' parser
      -> Boomerang e tok a (Bool :- r)
rBool :: Boomerang e tok a r
-> Boomerang e tok a r -> Boomerang e tok a (Bool :- r)
rBool Boomerang e tok a r
t Boomerang e tok a r
f = Boomerang e tok r (Bool :- r)
forall tok e r. Boomerang e tok r (Bool :- r)
rTrue Boomerang e tok r (Bool :- r)
-> Boomerang e tok a r -> Boomerang e tok a (Bool :- r)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Boomerang e tok a r
t Boomerang e tok a (Bool :- r)
-> Boomerang e tok a (Bool :- r) -> Boomerang e tok a (Bool :- r)
forall a. Semigroup a => a -> a -> a
<> Boomerang e tok r (Bool :- r)
forall tok e r. Boomerang e tok r (Bool :- r)
rFalse Boomerang e tok r (Bool :- r)
-> Boomerang e tok a r -> Boomerang e tok a (Bool :- r)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Boomerang e tok a r
f

rUnit :: Boomerang e tok r (() :- r)
rUnit :: Boomerang e tok r (() :- r)
rUnit = (r -> () :- r)
-> ((() :- r) -> Maybe r) -> Boomerang e tok r (() :- r)
forall a b e tok. (a -> b) -> (b -> Maybe a) -> Boomerang e tok a b
xpure (() -> r -> () :- r
forall a b. a -> b -> a :- b
(:-) ()) (\ (() :- r
x) -> r -> Maybe r
forall a. a -> Maybe a
Just r
x)