{- |
Utility functions based only on 'Arrow' class.
-}
module Synthesizer.Causal.Utility where

import Control.Arrow (Arrow, arr, (>>>), (&&&), (^<<), )

import Data.Function.HT (nest, )


map :: (Arrow arrow) => (b -> c) -> arrow a b -> arrow a c
map :: forall (arrow :: * -> * -> *) b c a.
Arrow arrow =>
(b -> c) -> arrow a b -> arrow a c
map = (b -> c) -> arrow a b -> arrow a c
forall (arrow :: * -> * -> *) b c a.
Arrow arrow =>
(b -> c) -> arrow a b -> arrow a c
(^<<)

pure :: (Arrow arrow) => b -> arrow a b
pure :: forall (arrow :: * -> * -> *) b a. Arrow arrow => b -> arrow a b
pure b
x = (a -> b) -> arrow a b
forall b c. (b -> c) -> arrow b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (b -> a -> b
forall a b. a -> b -> a
const b
x)

apply :: (Arrow arrow) => arrow a (b -> c) -> arrow a b -> arrow a c
apply :: forall (arrow :: * -> * -> *) a b c.
Arrow arrow =>
arrow a (b -> c) -> arrow a b -> arrow a c
apply arrow a (b -> c)
f arrow a b
x = ((b -> c) -> b -> c) -> (b -> c, b) -> c
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (b -> c) -> b -> c
forall a b. (a -> b) -> a -> b
($) ((b -> c, b) -> c) -> arrow a (b -> c, b) -> arrow a c
forall (arrow :: * -> * -> *) b c a.
Arrow arrow =>
(b -> c) -> arrow a b -> arrow a c
^<< arrow a (b -> c)
farrow a (b -> c) -> arrow a b -> arrow a (b -> c, b)
forall b c c'. arrow b c -> arrow b c' -> arrow b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&arrow a b
x


{-# INLINE chainControlled #-}
chainControlled ::
   (Arrow arrow) =>
   [arrow (c,x) x] -> arrow (c,x) x
chainControlled :: forall (arrow :: * -> * -> *) c x.
Arrow arrow =>
[arrow (c, x) x] -> arrow (c, x) x
chainControlled =
   (arrow (c, x) x -> arrow (c, x) x -> arrow (c, x) x)
-> arrow (c, x) x -> [arrow (c, x) x] -> arrow (c, x) x
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
      (\arrow (c, x) x
p arrow (c, x) x
rest -> ((c, x) -> c) -> arrow (c, x) c
forall b c. (b -> c) -> arrow b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (c, x) -> c
forall a b. (a, b) -> a
fst arrow (c, x) c -> arrow (c, x) x -> arrow (c, x) (c, x)
forall b c c'. arrow b c -> arrow b c' -> arrow b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& arrow (c, x) x
p  arrow (c, x) (c, x) -> arrow (c, x) x -> arrow (c, x) x
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>  arrow (c, x) x
rest)
      (((c, x) -> x) -> arrow (c, x) x
forall b c. (b -> c) -> arrow b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (c, x) -> x
forall a b. (a, b) -> b
snd)

{-# INLINE replicateControlled #-}
replicateControlled ::
   (Arrow arrow) =>
   Int -> arrow (c,x) x -> arrow (c,x) x
replicateControlled :: forall (arrow :: * -> * -> *) c x.
Arrow arrow =>
Int -> arrow (c, x) x -> arrow (c, x) x
replicateControlled Int
n arrow (c, x) x
p =
   Int
-> (arrow (c, x) x -> arrow (c, x) x)
-> arrow (c, x) x
-> arrow (c, x) x
forall a. Int -> (a -> a) -> a -> a
nest Int
n
      (((c, x) -> c) -> arrow (c, x) c
forall b c. (b -> c) -> arrow b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (c, x) -> c
forall a b. (a, b) -> a
fst arrow (c, x) c -> arrow (c, x) x -> arrow (c, x) (c, x)
forall b c c'. arrow b c -> arrow b c' -> arrow b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& arrow (c, x) x
p  arrow (c, x) (c, x) -> arrow (c, x) x -> arrow (c, x) x
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> )
      (((c, x) -> x) -> arrow (c, x) x
forall b c. (b -> c) -> arrow b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (c, x) -> x
forall a b. (a, b) -> b
snd)