{-# 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 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> m c
g a
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> m c
g a
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> m d
l a
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> t -> m t1
f t
y forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> m b
f a
y forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> m b
f a
z forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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')
(&&.) = 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')
(**.) = 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
(>>.) = 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 forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a 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 = forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first a b c
a forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a 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 = 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 = 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 = forall a b c d. ((b -> c) -> a -> d) -> Concatenative a b c d
Concatenative (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 = forall a b c d. ((b -> c) -> a -> d) -> Concatenative a b c d
Concatenative forall a b. (a -> b) -> a -> b
$ \b -> e -> c
c a
a-> (b -> c) -> a -> d
l (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 = (forall a b c. (a -> b) -> Concatenative a b c c
cat a -> b
f) 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 = forall a b c d. ((b -> c) -> a -> d) -> Concatenative a b c d
Concatenative forall a b. (a -> b) -> a -> b
$ \b -> f -> c
c e
e-> (b -> c) -> a -> d
l (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 = (forall a b c. (a -> b) -> Concatenative a b c c
cat t -> b
f) 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 = forall a b c d. ((b -> c) -> a -> d) -> Concatenative a b c d
Concatenative forall a b. (a -> b) -> a -> b
$ \b -> m c
c a
a-> a -> m b
f a
a 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 = forall a b c d. ((b -> c) -> a -> d) -> Concatenative a b c d
Concatenative forall a b. (a -> b) -> a -> b
$ \b -> e -> c
c a
a-> a -> m e
f a
a forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\e
x-> (b -> c) -> a -> m d
l (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 = (forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> Concatenative a b (m c) (m c)
catM a -> m b
f) 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 = forall a b c d. ((b -> c) -> a -> d) -> Concatenative a b c d
Concatenative forall a b. (a -> b) -> a -> b
$ \b -> f -> c
c e
e a
a-> e -> m f
f e
e forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \f
x-> (b -> c) -> a -> m d
l (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 = (forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> Concatenative a b (m c) (m c)
catM a -> m b
f) 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-> $(apN' n) f |] where
apN' :: Int -> Q Exp
apN' :: Int -> Q Exp
apN' Int
n | Int
n forall a. Ord a => a -> a -> Bool
> Int
1 = [| \f-> $(apN' (n-1)) f .*. f |]
| Bool
otherwise = [| cat |]
apM :: Int -> Q Exp
apM :: Int -> Q Exp
apM Int
n = [| \f-> $(apM' n) f |] where
apM' :: Int -> Q Exp
apM' :: Int -> Q Exp
apM' Int
n | Int
n forall a. Ord a => a -> a -> Bool
> Int
1 = [| \f-> $(apM' (n-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_ = forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_