{-# LANGUAGE TemplateHaskell #-}
module Control.Concatenative (
bi, tri, biSp, triSp, biAp, triAp, ifte,
biM, triM, biSpM, triSpM, biApM, triApM,
biM_, triM_, biApM_, triApM_,
(>>@), dup, swap, both,
(>>.), (&&.), (**.), first, second,
Concatenative(..),
cat, (&.), (.&.), (*.), (.*.),
catM, clM, cl, spM, sp,
apN, apM, apM_
) where
import Control.Arrow
import Control.Monad
import Language.Haskell.TH
bi :: (a -> b) -> (a -> c) -> (b -> c -> d) -> a -> d
bi :: forall a b c d. (a -> b) -> (a -> c) -> (b -> c -> d) -> a -> d
bi a -> b
f a -> c
g b -> c -> d
c a
x = b -> c -> d
c (a -> b
f a
x) (a -> c
g a
x)
tri :: (a -> b) -> (a -> c) -> (a -> d) -> (b -> c -> d -> e) -> a -> e
tri :: forall a b c d e.
(a -> b) -> (a -> c) -> (a -> d) -> (b -> c -> d -> e) -> a -> e
tri a -> b
f a -> c
g a -> d
h b -> c -> d -> e
c a
x = b -> c -> d -> e
c (a -> b
f a
x) (a -> c
g a
x) (a -> d
h a
x)
biSp :: (a -> c) -> (b -> d) -> (c -> d -> e) -> a -> b -> e
biSp :: forall a c b d e.
(a -> c) -> (b -> d) -> (c -> d -> e) -> a -> b -> e
biSp a -> c
f b -> d
g c -> d -> e
c a
x b
y = c -> d -> e
c (a -> c
f a
x) (b -> d
g b
y)
triSp :: (a -> d) -> (b -> e) -> (c -> f) -> (d -> e -> f -> g) -> a -> b -> c -> g
triSp :: forall a d b e c f g.
(a -> d)
-> (b -> e) -> (c -> f) -> (d -> e -> f -> g) -> a -> b -> c -> g
triSp a -> d
f b -> e
g c -> f
h d -> e -> f -> g
c a
x b
y c
z = d -> e -> f -> g
c (a -> d
f a
x) (b -> e
g b
y) (c -> f
h c
z)
biAp :: (t -> t1) -> (t1 -> t1 -> t2) -> t -> t -> t2
biAp :: forall t t1 t2. (t -> t1) -> (t1 -> t1 -> t2) -> t -> t -> t2
biAp t -> t1
f t1 -> t1 -> t2
c t
x t
y = t1 -> t1 -> t2
c (t -> t1
f t
x) (t -> t1
f t
y)
triAp :: (a -> b) -> (b -> b -> b -> c) -> a -> a -> a -> c
triAp :: forall a b c. (a -> b) -> (b -> b -> b -> c) -> a -> a -> a -> c
triAp a -> b
f b -> b -> b -> c
c a
x a
y a
z = b -> b -> b -> c
c (a -> b
f a
x) (a -> b
f a
y) (a -> b
f a
z)
ifte :: (a -> Bool)
-> (a -> b)
-> (a -> b)
-> a -> b
ifte :: forall a b. (a -> Bool) -> (a -> b) -> (a -> b) -> a -> b
ifte a -> Bool
test a -> b
ca a -> b
cb a
x =
if a -> Bool
test a
x then a -> b
ca a
x else a -> b
cb a
x
biM :: Monad m => (a -> m b) -> (a -> m c) -> (b -> c -> m d) -> a -> m d
biM :: forall (m :: * -> *) a b c d.
Monad m =>
(a -> m b) -> (a -> m c) -> (b -> c -> m d) -> a -> m d
biM a -> m b
f a -> m c
g b -> c -> m d
c a
a = do
b
x <- a -> m b
f a
a
c
y <- a -> m c
g a
a
b -> c -> m d
c b
x c
y
biM_ :: Monad m => (a -> m b) -> (a -> m c) -> a -> m ()
biM_ :: forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (a -> m c) -> a -> m ()
biM_ a -> m b
f a -> m c
g a
a = a -> m b
f a
a m b -> m c -> m c
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> m c
g a
a m c -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
triM :: Monad m => (a -> m b) -> (a -> m c) -> (a -> m d) -> (b -> c -> d -> m e) -> a -> m e
triM :: forall (m :: * -> *) a b c d e.
Monad m =>
(a -> m b)
-> (a -> m c) -> (a -> m d) -> (b -> c -> d -> m e) -> a -> m e
triM a -> m b
f a -> m c
g a -> m d
l b -> c -> d -> m e
c a
a = do
b
x <- a -> m b
f a
a
c
y <- a -> m c
g a
a
d
z <- a -> m d
l a
a
b -> c -> d -> m e
c b
x c
y d
z
triM_ :: Monad m => (a -> m b) -> (a -> m c) -> (a -> m d) -> a -> m ()
triM_ :: forall (m :: * -> *) a b c d.
Monad m =>
(a -> m b) -> (a -> m c) -> (a -> m d) -> a -> m ()
triM_ a -> m b
f a -> m c
g a -> m d
l a
a = a -> m b
f a
a m b -> m c -> m c
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> m c
g a
a m c -> m d -> m d
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> m d
l a
a m d -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
biSpM :: Monad m => (a -> m c) -> (b -> m d) -> (c -> d -> m e) -> a -> b -> m e
biSpM :: forall (m :: * -> *) a c b d e.
Monad m =>
(a -> m c) -> (b -> m d) -> (c -> d -> m e) -> a -> b -> m e
biSpM a -> m c
f b -> m d
g c -> d -> m e
c a
x b
y = do
c
a <- a -> m c
f a
x
d
b <- b -> m d
g b
y
c -> d -> m e
c c
a d
b
triSpM :: Monad m => (a -> m d) -> (b -> m e) -> (c -> m f) -> (d -> e -> f -> m g) -> a -> b -> c -> m g
triSpM :: forall (m :: * -> *) a d b e c f g.
Monad m =>
(a -> m d)
-> (b -> m e)
-> (c -> m f)
-> (d -> e -> f -> m g)
-> a
-> b
-> c
-> m g
triSpM a -> m d
f b -> m e
g c -> m f
h d -> e -> f -> m g
c a
x b
y c
z = do
d
a <- a -> m d
f a
x
e
b <- b -> m e
g b
y
f
n <- c -> m f
h c
z
d -> e -> f -> m g
c d
a e
b f
n
biApM :: Monad m => (t -> m t1) -> (t1 -> t1 -> m t2) -> t -> t -> m t2
biApM :: forall (m :: * -> *) t t1 t2.
Monad m =>
(t -> m t1) -> (t1 -> t1 -> m t2) -> t -> t -> m t2
biApM t -> m t1
f t1 -> t1 -> m t2
c t
x t
y = do
t1
a <- t -> m t1
f t
x
t1
b <- t -> m t1
f t
y
t1 -> t1 -> m t2
c t1
a t1
b
biApM_ :: Monad m => (t -> m t1) -> t -> t -> m ()
biApM_ :: forall (m :: * -> *) t t1. Monad m => (t -> m t1) -> t -> t -> m ()
biApM_ t -> m t1
f t
x t
y = t -> m t1
f t
x m t1 -> m t1 -> m t1
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> t -> m t1
f t
y m t1 -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
triApM :: Monad m => (a -> m b) -> (b -> b -> b -> m c) -> a -> a -> a -> m c
triApM :: forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> b -> b -> m c) -> a -> a -> a -> m c
triApM a -> m b
f b -> b -> b -> m c
c a
x a
y a
z = do
b
a <- a -> m b
f a
x
b
b <- a -> m b
f a
y
b
n <- a -> m b
f a
z
b -> b -> b -> m c
c b
a b
b b
n
triApM_ :: Monad m => (a -> m b) -> a -> a -> a-> m ()
triApM_ :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> a -> a -> a -> m ()
triApM_ a -> m b
f a
x a
y a
z = a -> m b
f a
x m b -> m b -> m b
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> m b
f a
y m b -> m b -> m b
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> m b
f a
z m b -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
infixl 3 >>@
infixl 3 &&.
infixl 3 **.
infixl 4 >>.
(&&.) :: Arrow a => a b c -> a b c' -> a b (c, c')
&&. :: forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
(&&.) = a b c -> a b c' -> a b (c, c')
forall b c c'. a b c -> a b c' -> a b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
(&&&)
(**.) :: Arrow a => a b c -> a b' c' -> a (b,b') (c,c')
**. :: forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
(**.) = a b c -> a b' c' -> a (b, b') (c, c')
forall b c b' c'. a b c -> a b' c' -> a (b, b') (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
(***)
(>>.) :: Arrow a => a b c -> a c d -> a b d
>>. :: forall (a :: * -> * -> *) b c d. Arrow a => a b c -> a c d -> a b d
(>>.) = a b c -> a c d -> a b d
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
(>>>)
(>>@) :: Arrow a => a b (x,y) -> (x -> y -> z) -> a b z
a b (x, y)
a >>@ :: forall (a :: * -> * -> *) b x y z.
Arrow a =>
a b (x, y) -> (x -> y -> z) -> a b z
>>@ x -> y -> z
f = a b (x, y)
a a b (x, y) -> a (x, y) z -> a b z
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ((x, y) -> z) -> a (x, y) z
forall b c. (b -> c) -> a b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\(x
x,y
y) -> x -> y -> z
f x
x y
y)
both :: Arrow a => a b c -> a (b,b) (c,c)
both :: forall (a :: * -> * -> *) b c. Arrow a => a b c -> a (b, b) (c, c)
both a b c
a = a b c -> a (b, b) (c, b)
forall b c d. a b c -> a (b, d) (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first a b c
a a (b, b) (c, b) -> a (c, b) (c, c) -> a (b, b) (c, c)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a b c -> a (c, b) (c, c)
forall b c d. a b c -> a (d, b) (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second a b c
a
dup :: Arrow a => a b (b,b)
dup :: forall (a :: * -> * -> *) b. Arrow a => a b (b, b)
dup = (b -> (b, b)) -> a b (b, b)
forall b c. (b -> c) -> a b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\b
x-> (b
x,b
x))
swap :: Arrow a => a (x,y) (y,x)
swap :: forall (a :: * -> * -> *) x y. Arrow a => a (x, y) (y, x)
swap = ((x, y) -> (y, x)) -> a (x, y) (y, x)
forall b c. (b -> c) -> a b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\(x
x,y
y) -> (y
y,x
x))
newtype Concatenative a b c d = Concatenative { forall a b c d. Concatenative a b c d -> (b -> c) -> a -> d
with :: (b -> c) -> (a -> d) }
cat :: (a -> b) -> Concatenative a b c c
cat :: forall a b c. (a -> b) -> Concatenative a b c c
cat a -> b
f = ((b -> c) -> a -> c) -> Concatenative a b c c
forall a b c d. ((b -> c) -> a -> d) -> Concatenative a b c d
Concatenative ((b -> c) -> (a -> b) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> b
f)
(.&.) :: Concatenative a b c d -> (a -> e) -> Concatenative a b (e -> c) d
(Concatenative (b -> c) -> a -> d
l) .&. :: forall a b c d e.
Concatenative a b c d -> (a -> e) -> Concatenative a b (e -> c) d
.&. a -> e
f = ((b -> e -> c) -> a -> d) -> Concatenative a b (e -> c) d
forall a b c d. ((b -> c) -> a -> d) -> Concatenative a b c d
Concatenative (((b -> e -> c) -> a -> d) -> Concatenative a b (e -> c) d)
-> ((b -> e -> c) -> a -> d) -> Concatenative a b (e -> c) d
forall a b. (a -> b) -> a -> b
$ \b -> e -> c
c a
a-> (b -> c) -> a -> d
l ((b -> e -> c) -> e -> b -> c
forall a b c. (a -> b -> c) -> b -> a -> c
flip b -> e -> c
c (a -> e
f a
a)) a
a
(&.) :: (a -> b) -> (a -> e) -> Concatenative a b (e -> c) c
a -> b
f &. :: forall a b e c.
(a -> b) -> (a -> e) -> Concatenative a b (e -> c) c
&. a -> e
g = ((a -> b) -> Concatenative a b c c
forall a b c. (a -> b) -> Concatenative a b c c
cat a -> b
f) Concatenative a b c c -> (a -> e) -> Concatenative a b (e -> c) c
forall a b c d e.
Concatenative a b c d -> (a -> e) -> Concatenative a b (e -> c) d
.&. a -> e
g
(.*.) :: Concatenative a b c d -> (e -> f) -> Concatenative e b (f -> c) (a -> d)
(Concatenative (b -> c) -> a -> d
l) .*. :: forall a b c d e f.
Concatenative a b c d
-> (e -> f) -> Concatenative e b (f -> c) (a -> d)
.*. e -> f
f = ((b -> f -> c) -> e -> a -> d)
-> Concatenative e b (f -> c) (a -> d)
forall a b c d. ((b -> c) -> a -> d) -> Concatenative a b c d
Concatenative (((b -> f -> c) -> e -> a -> d)
-> Concatenative e b (f -> c) (a -> d))
-> ((b -> f -> c) -> e -> a -> d)
-> Concatenative e b (f -> c) (a -> d)
forall a b. (a -> b) -> a -> b
$ \b -> f -> c
c e
e-> (b -> c) -> a -> d
l ((b -> f -> c) -> f -> b -> c
forall a b c. (a -> b -> c) -> b -> a -> c
flip b -> f -> c
c (e -> f
f e
e))
(*.) :: (t -> b) -> (a -> b1) -> Concatenative a b (b1 -> c) (t -> c)
t -> b
f *. :: forall t b a b1 c.
(t -> b) -> (a -> b1) -> Concatenative a b (b1 -> c) (t -> c)
*. a -> b1
g = ((t -> b) -> Concatenative t b c c
forall a b c. (a -> b) -> Concatenative a b c c
cat t -> b
f) Concatenative t b c c
-> (a -> b1) -> Concatenative a b (b1 -> c) (t -> c)
forall a b c d e f.
Concatenative a b c d
-> (e -> f) -> Concatenative e b (f -> c) (a -> d)
.*. a -> b1
g
catM :: Monad m => (a -> m b) -> Concatenative a b (m c) (m c)
catM :: forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> Concatenative a b (m c) (m c)
catM a -> m b
f = ((b -> m c) -> a -> m c) -> Concatenative a b (m c) (m c)
forall a b c d. ((b -> c) -> a -> d) -> Concatenative a b c d
Concatenative (((b -> m c) -> a -> m c) -> Concatenative a b (m c) (m c))
-> ((b -> m c) -> a -> m c) -> Concatenative a b (m c) (m c)
forall a b. (a -> b) -> a -> b
$ \b -> m c
c a
a-> a -> m b
f a
a m b -> (b -> m c) -> m c
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> m c
c
clM :: Monad m => Concatenative a b c (m d) -> (a -> m e) -> Concatenative a b (e -> c) (m d)
(Concatenative (b -> c) -> a -> m d
l) `clM ` a -> m e
f = ((b -> e -> c) -> a -> m d) -> Concatenative a b (e -> c) (m d)
forall a b c d. ((b -> c) -> a -> d) -> Concatenative a b c d
Concatenative (((b -> e -> c) -> a -> m d) -> Concatenative a b (e -> c) (m d))
-> ((b -> e -> c) -> a -> m d) -> Concatenative a b (e -> c) (m d)
forall a b. (a -> b) -> a -> b
$ \b -> e -> c
c a
a-> a -> m e
f a
a m e -> (e -> m d) -> m d
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\e
x-> (b -> c) -> a -> m d
l ((b -> e -> c) -> e -> b -> c
forall a b c. (a -> b -> c) -> b -> a -> c
flip b -> e -> c
c e
x) a
a)
cl :: (Monad m) => (a -> m b) -> (a -> m e) -> Concatenative a b (e -> m d) (m d)
a -> m b
f cl :: forall (m :: * -> *) a b e d.
Monad m =>
(a -> m b) -> (a -> m e) -> Concatenative a b (e -> m d) (m d)
`cl` a -> m e
g = ((a -> m b) -> Concatenative a b (m d) (m d)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> Concatenative a b (m c) (m c)
catM a -> m b
f) Concatenative a b (m d) (m d)
-> (a -> m e) -> Concatenative a b (e -> m d) (m d)
forall (m :: * -> *) a b c d e.
Monad m =>
Concatenative a b c (m d)
-> (a -> m e) -> Concatenative a b (e -> c) (m d)
`clM` a -> m e
g
spM :: Monad m => Concatenative a b c (m d) -> (e -> m f) -> Concatenative e b (f -> c) (a -> m d)
(Concatenative (b -> c) -> a -> m d
l) spM :: forall (m :: * -> *) a b c d e f.
Monad m =>
Concatenative a b c (m d)
-> (e -> m f) -> Concatenative e b (f -> c) (a -> m d)
`spM` e -> m f
f = ((b -> f -> c) -> e -> a -> m d)
-> Concatenative e b (f -> c) (a -> m d)
forall a b c d. ((b -> c) -> a -> d) -> Concatenative a b c d
Concatenative (((b -> f -> c) -> e -> a -> m d)
-> Concatenative e b (f -> c) (a -> m d))
-> ((b -> f -> c) -> e -> a -> m d)
-> Concatenative e b (f -> c) (a -> m d)
forall a b. (a -> b) -> a -> b
$ \b -> f -> c
c e
e a
a-> e -> m f
f e
e m f -> (f -> m d) -> m d
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \f
x-> (b -> c) -> a -> m d
l ((b -> f -> c) -> f -> b -> c
forall a b c. (a -> b -> c) -> b -> a -> c
flip b -> f -> c
c f
x) a
a
sp :: (Monad m) => (a -> m b) -> (e -> m f) -> Concatenative e b (f -> m d) (a -> m d)
a -> m b
f sp :: forall (m :: * -> *) a b e f d.
Monad m =>
(a -> m b) -> (e -> m f) -> Concatenative e b (f -> m d) (a -> m d)
`sp` e -> m f
g = ((a -> m b) -> Concatenative a b (m d) (m d)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> Concatenative a b (m c) (m c)
catM a -> m b
f) Concatenative a b (m d) (m d)
-> (e -> m f) -> Concatenative e b (f -> m d) (a -> m d)
forall (m :: * -> *) a b c d e f.
Monad m =>
Concatenative a b c (m d)
-> (e -> m f) -> Concatenative e b (f -> c) (a -> m d)
`spM` e -> m f
g
apN :: Int -> Q Exp
apN :: Int -> Q Exp
apN Int
n = [| \f-> $(Int -> Q Exp
apN' Int
n) f |] where
apN' :: Int -> Q Exp
apN' :: Int -> Q Exp
apN' Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 = [| \f-> $(Int -> Q Exp
apN' (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) f .*. f |]
| Bool
otherwise = [| cat |]
apM :: Int -> Q Exp
apM :: Int -> Q Exp
apM Int
n = [| \f-> $(Int -> Q Exp
apM' Int
n) f |] where
apM' :: Int -> Q Exp
apM' :: Int -> Q Exp
apM' Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 = [| \f-> $(Int -> Q Exp
apM' (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) f `spM` f |]
| Bool
otherwise = [| catM |]
apM_ :: Monad m => Int -> m a -> m ()
apM_ :: forall (m :: * -> *) a. Monad m => Int -> m a -> m ()
apM_ = Int -> m a -> m ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_