{-# 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 <>
(<>) :: Monoid m => m -> m -> m
(<>) = mappend
#endif
duck :: Boomerang e tok r1 r2 -> Boomerang e tok (h :- r1) (h :- r2)
duck :: forall e tok r1 r2 h.
Boomerang e tok r1 r2 -> Boomerang e tok (h :- r1) (h :- r2)
duck Boomerang e tok r1 r2
r = forall e tok a b.
Parser e tok (a -> b)
-> (b -> [(tok -> tok, a)]) -> Boomerang e tok a b
Boomerang
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\r1 -> r2
f (h
h :- r1
t) -> h
h forall a b. a -> b -> a :- b
:- r1 -> r2
f r1
t) forall a b. (a -> b) -> a -> b
$ 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) -> forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (h
h forall a b. a -> b -> a :- b
:-)) forall a b. (a -> b) -> a -> b
$ forall e tok a b. Boomerang e tok a b -> b -> [(tok -> tok, a)]
ser Boomerang e tok r1 r2
r r2
t)
duck1 :: Boomerang e tok r1 (a :- r2) -> Boomerang e tok (h :- r1) (a :- h :- r2)
duck1 :: 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 r1 (a :- r2)
r = forall e tok a b.
Parser e tok (a -> b)
-> (b -> [(tok -> tok, a)]) -> Boomerang e tok a b
Boomerang
(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 forall a b. a -> b -> a :- b
:- h
h forall a b. a -> b -> a :- b
:- r2
t') forall a b. (a -> b) -> a -> b
$ 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) -> forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (h
h forall a b. a -> b -> a :- b
:-)) forall a b. (a -> b) -> a -> b
$ forall e tok a b. Boomerang e tok a b -> b -> [(tok -> tok, a)]
ser Boomerang e tok r1 (a :- r2)
r (a
a forall a b. a -> b -> a :- b
:- r2
t))
opt :: Boomerang e tok r r -> Boomerang e tok r r
opt :: forall e tok r. Boomerang e tok r r -> Boomerang e tok r r
opt = (forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id forall a. Semigroup a => a -> a -> a
<>)
manyr :: Boomerang e tok r r -> Boomerang e tok r r
manyr :: forall e tok r. Boomerang e tok r r -> Boomerang e tok r r
manyr = forall e tok r. Boomerang e tok r r -> Boomerang e tok r r
opt forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall e tok r. Boomerang e tok r r -> Boomerang e tok r r
somer
somer :: Boomerang e tok r r -> Boomerang e tok r r
somer :: forall e tok r. Boomerang e tok r r -> Boomerang e tok r r
somer Boomerang e tok r r
p = Boomerang e tok r r
p forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall e tok r. Boomerang e tok r r -> Boomerang e tok r r
manyr Boomerang e tok r r
p
chainr :: Boomerang e tok r r -> Boomerang e tok r r -> Boomerang e tok r r
chainr :: forall e tok r.
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 = forall e tok r. Boomerang e tok r r -> Boomerang e tok r r
opt (forall e tok r. Boomerang e tok r r -> Boomerang e tok r r
manyr (Boomerang e tok r r
p 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) 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 :: Boomerang e tok r (a :- r) -> Boomerang e tok (a :- a :- r) (a :- r) -> Boomerang e tok r (a :- r)
chainr1 :: forall e tok r a.
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 = forall e tok r. Boomerang e tok r r -> Boomerang e tok r r
manyr (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 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) 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
manyl :: Boomerang e tok r r -> Boomerang e tok r r
manyl :: forall e tok r. Boomerang e tok r r -> Boomerang e tok r r
manyl = forall e tok r. Boomerang e tok r r -> Boomerang e tok r r
opt forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall e tok r. Boomerang e tok r r -> Boomerang e tok r r
somel
somel :: Boomerang e tok r r -> Boomerang e tok r r
somel :: forall e tok r. Boomerang e tok r r -> Boomerang e tok r r
somel Boomerang e tok r r
p = Boomerang e tok r r
p forall e tok a b c.
Boomerang e tok a b -> Boomerang e tok b c -> Boomerang e tok a c
.~ forall e tok r. Boomerang e tok r r -> Boomerang e tok r r
manyl Boomerang e tok r r
p
chainl :: Boomerang e tok r r -> Boomerang e tok r r -> Boomerang e tok r r
chainl :: forall e tok r.
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 = forall e tok r. Boomerang e tok r r -> Boomerang e tok r r
opt (Boomerang e tok r r
p forall e tok a b c.
Boomerang e tok a b -> Boomerang e tok b c -> Boomerang e tok a c
.~ forall e tok r. Boomerang e tok r r -> Boomerang e tok r r
manyl (Boomerang e tok r r
op 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 :: Boomerang e tok r (a :- r) -> Boomerang e tok (a :- a :- r) (a :- r) -> Boomerang e tok r (a :- r)
chainl1 :: forall e tok r a.
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 forall e tok a b c.
Boomerang e tok a b -> Boomerang e tok b c -> Boomerang e tok a c
.~ forall e tok r. Boomerang e tok r r -> Boomerang e tok r r
manyl (Boomerang e tok (a :- (a :- r)) (a :- r)
op forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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)
rFilter :: (a -> Bool) -> Boomerang e tok () (a :- ()) -> Boomerang e tok r (a :- r)
rFilter :: forall a e tok r.
(a -> Bool)
-> Boomerang e tok () (a :- ()) -> Boomerang e tok r (a :- r)
rFilter a -> Bool
p Boomerang e tok () (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 = forall e tok a.
(tok -> Pos e -> [Either e ((a, tok), Pos e)]) -> Parser e tok a
Parser forall a b. (a -> b) -> a -> b
$ \tok
tok Pos e
pos ->
let parses :: [Either e ((() -> a :- (), tok), Pos e)]
parses = forall e tok a.
Parser e tok a -> tok -> Pos e -> [Either e ((a, tok), Pos e)]
runParser (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 [ 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 = 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, ()
_) <- forall e tok a b. Boomerang e tok a b -> b -> [(tok -> tok, a)]
ser Boomerang e tok () (a :- ())
r (a
a forall a b. a -> b -> a :- b
:- ()) ]
printAs :: Boomerang e [tok] a b -> tok -> Boomerang e [tok] a b
printAs :: forall e tok a b.
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 = forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (forall a b. a -> b -> a
const (tok
s forall a. a -> [a] -> [a]
:))) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Int -> [a] -> [a]
take Int
1 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall e tok a b. Boomerang e tok a b -> b -> [(tok -> tok, a)]
ser Boomerang e [tok] a b
r }
push :: Eq a => a -> Boomerang e tok r (a :- r)
push :: forall a e tok r. Eq a => a -> Boomerang e tok r (a :- r)
push a
a = forall a b e tok. (a -> b) -> (b -> Maybe a) -> Boomerang e tok a b
xpure (a
a forall a b. a -> b -> a :- b
:-) (\(a
a' :- r
t) -> forall (f :: * -> *). Alternative f => Bool -> f ()
guard (a
a' forall a. Eq a => a -> a -> Bool
== a
a) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. a -> Maybe a
Just r
t)
rNil :: Boomerang e tok r ([a] :- r)
rNil :: forall e tok r a. Boomerang e tok r ([a] :- r)
rNil = forall a b e tok. (a -> b) -> (b -> Maybe a) -> Boomerang e tok a b
xpure ([] forall a b. a -> b -> a :- b
:-) forall a b. (a -> b) -> a -> b
$ \([a]
xs :- r
t) -> do [] <- forall a. a -> Maybe a
Just [a]
xs; forall a. a -> Maybe a
Just r
t
rCons :: Boomerang e tok (a :- [a] :- r) ([a] :- r)
rCons :: forall e tok a r. Boomerang e tok (a :- ([a] :- r)) ([a] :- r)
rCons = forall a b e tok. (a -> b) -> (b -> Maybe a) -> Boomerang e tok a b
xpure (forall ty r s a. (ty -> r -> s) -> (a -> ty) -> (a :- r) -> s
arg (forall ty r s a. (ty -> r -> s) -> (a -> ty) -> (a :- r) -> s
arg forall a b. a -> b -> a :- b
(:-)) (:)) forall a b. (a -> b) -> a -> b
$ \([a]
xs :- r
t) -> do a
a:[a]
as <- forall a. a -> Maybe a
Just [a]
xs; forall a. a -> Maybe a
Just (a
a forall a b. a -> b -> a :- b
:- [a]
as forall a b. a -> b -> a :- b
:- r
t)
rList :: Boomerang e tok r (a :- r) -> Boomerang e tok r ([a] :- r)
rList :: forall e tok r a.
Boomerang e tok r (a :- r) -> Boomerang e tok r ([a] :- r)
rList Boomerang e tok r (a :- r)
r = forall e tok r. Boomerang e tok r r -> Boomerang e tok r r
manyr (forall e tok a r. Boomerang e tok (a :- ([a] :- r)) ([a] :- r)
rCons forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall e tok r a. Boomerang e tok r ([a] :- r)
rNil
rList1 :: Boomerang e tok r (a :- r) -> Boomerang e tok r ([a] :- r)
rList1 :: forall e tok r a.
Boomerang e tok r (a :- r) -> Boomerang e tok r ([a] :- r)
rList1 Boomerang e tok r (a :- r)
r = forall e tok r. Boomerang e tok r r -> Boomerang e tok r r
somer (forall e tok a r. Boomerang e tok (a :- ([a] :- r)) ([a] :- r)
rCons forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall e tok r a. Boomerang e tok r ([a] :- r)
rNil
rListSep :: Boomerang e tok r (a :- r) -> Boomerang e tok ([a] :- r) ([a] :- r) -> Boomerang e tok r ([a] :- r)
rListSep :: forall e tok r a.
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 = forall e tok r.
Boomerang e tok r r -> Boomerang e tok r r -> Boomerang e tok r r
chainr (forall e tok a r. Boomerang e tok (a :- ([a] :- r)) ([a] :- r)
rCons forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall e tok r a. Boomerang e tok r ([a] :- r)
rNil
rPair :: Boomerang e tok (f :- s :- r) ((f, s) :- r)
rPair :: forall e tok f s r. Boomerang e tok (f :- (s :- r)) ((f, s) :- r)
rPair = forall a b e tok. (a -> b) -> (b -> Maybe a) -> Boomerang e tok a b
xpure (forall ty r s a. (ty -> r -> s) -> (a -> ty) -> (a :- r) -> s
arg (forall ty r s a. (ty -> r -> s) -> (a -> ty) -> (a :- r) -> s
arg forall a b. a -> b -> a :- b
(:-)) (,)) forall a b. (a -> b) -> a -> b
$ \((f, s)
ab :- r
t) -> do (f
a,s
b) <- forall a. a -> Maybe a
Just (f, s)
ab; forall a. a -> Maybe a
Just (f
a forall a b. a -> b -> a :- b
:- s
b forall a b. a -> b -> a :- b
:- r
t)
$(makeBoomerangs ''Either)
rEither :: Boomerang e tok r (a :- r) -> Boomerang e tok r (b :- r) -> Boomerang e tok r (Either a b :- r)
rEither :: forall e tok r a b.
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 = forall tok e r a b. Boomerang e tok (a :- r) (Either a b :- r)
rLeft 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 forall a. Semigroup a => a -> a -> a
<> forall tok e r a b. Boomerang e tok (b :- r) (Either a b :- r)
rRight 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)
rMaybe :: Boomerang e tok r (a :- r) -> Boomerang e tok r (Maybe a :- r)
rMaybe :: forall e tok r a.
Boomerang e tok r (a :- r) -> Boomerang e tok r (Maybe a :- r)
rMaybe Boomerang e tok r (a :- r)
r = forall tok e r a. Boomerang e tok (a :- r) (Maybe a :- r)
rJust 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 forall a. Semigroup a => a -> a -> a
<> forall tok e r a. Boomerang e tok r (Maybe a :- r)
rNothing
$(makeBoomerangs ''Bool)
rBool :: Boomerang e tok a r
-> Boomerang e tok a r
-> Boomerang e tok a (Bool :- r)
rBool :: forall e tok a r.
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 = forall tok e r. Boomerang e tok r (Bool :- r)
rTrue 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 forall a. Semigroup a => a -> a -> a
<> forall tok e r. Boomerang e tok r (Bool :- r)
rFalse 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 :: forall e tok r. Boomerang e tok r (() :- r)
rUnit = forall a b e tok. (a -> b) -> (b -> Maybe a) -> Boomerang e tok a b
xpure (forall a b. a -> b -> a :- b
(:-) ()) (\ (() :- r
x) -> forall a. a -> Maybe a
Just r
x)