{- |
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 = 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 = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (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 = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a b. (a -> b) -> a -> b
($) forall (arrow :: * -> * -> *) b c a.
Arrow arrow =>
(b -> c) -> arrow a b -> arrow a c
^<< arrow a (b -> c)
fforall (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 =
   forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
      (\arrow (c, x) x
p arrow (c, x) x
rest -> forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall a b. (a, b) -> a
fst forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& arrow (c, x) x
p  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)
      (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr 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 =
   forall a. Int -> (a -> a) -> a -> a
nest Int
n
      (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall a b. (a, b) -> a
fst forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& arrow (c, x) x
p  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 forall a b. (a, b) -> b
snd)