{-# LANGUAGE TypeFamilies #-}
module Synthesizer.Causal.Class (
   module Synthesizer.Causal.Class,
   Util.chainControlled,
   Util.replicateControlled,
   ) where

import qualified Synthesizer.Causal.Utility as Util

import qualified Control.Category as Cat
import Control.Arrow (Arrow, arr, (<<<), (&&&), )


type family ProcessOf (signal :: * -> *) :: * -> * -> *

class (Arrow process, ProcessOf (SignalOf process) ~ process) => C process where
   type SignalOf process :: * -> *
   toSignal :: process () a -> SignalOf process a
   fromSignal :: SignalOf process b -> process a b


infixl 0 $<, $>, $*
-- infixr 0 $:*   -- can be used together with $

apply ::
   (C process) => process a b -> SignalOf process a -> SignalOf process b
apply :: forall (process :: * -> * -> *) a b.
C process =>
process a b -> SignalOf process a -> SignalOf process b
apply process a b
proc SignalOf process a
sig =
   process () b -> SignalOf process b
forall a. process () a -> SignalOf process a
forall (process :: * -> * -> *) a.
C process =>
process () a -> SignalOf process a
toSignal (process a b
proc process a b -> process () a -> process () b
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< SignalOf process a -> process () a
forall b a. SignalOf process b -> process a b
forall (process :: * -> * -> *) b a.
C process =>
SignalOf process b -> process a b
fromSignal SignalOf process a
sig)

applyFst, ($<) ::
   (C process) => process (a,b) c -> SignalOf process a -> process b c
applyFst :: forall (process :: * -> * -> *) a b c.
C process =>
process (a, b) c -> SignalOf process a -> process b c
applyFst process (a, b) c
proc SignalOf process a
sig =
   process (a, b) c
proc process (a, b) c -> process b (a, b) -> process b c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< SignalOf process a -> process b (a, b)
forall (process :: * -> * -> *) a b.
C process =>
SignalOf process a -> process b (a, b)
feedFst SignalOf process a
sig

applySnd, ($>) ::
   (C process) => process (a,b) c -> SignalOf process b -> process a c
applySnd :: forall (process :: * -> * -> *) a b c.
C process =>
process (a, b) c -> SignalOf process b -> process a c
applySnd process (a, b) c
proc SignalOf process b
sig =
   process (a, b) c
proc process (a, b) c -> process a (a, b) -> process a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< SignalOf process b -> process a (a, b)
forall (process :: * -> * -> *) a b.
C process =>
SignalOf process a -> process b (b, a)
feedSnd SignalOf process b
sig

applyConst ::
   (C process) => process a b -> a -> SignalOf process b
applyConst :: forall (process :: * -> * -> *) a b.
C process =>
process a b -> a -> SignalOf process b
applyConst process a b
proc a
a =
   process () b -> SignalOf process b
forall a. process () a -> SignalOf process a
forall (process :: * -> * -> *) a.
C process =>
process () a -> SignalOf process a
toSignal (process a b
proc process a b -> process () a -> process () b
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< (() -> a) -> process () a
forall b c. (b -> c) -> process b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\() -> a
a))

applyConstFst ::
   (Arrow process) => process (a,b) c -> a -> process b c
applyConstFst :: forall (process :: * -> * -> *) a b c.
Arrow process =>
process (a, b) c -> a -> process b c
applyConstFst process (a, b) c
proc a
a =
   process (a, b) c
proc process (a, b) c -> process b (a, b) -> process b c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< a -> process b (a, b)
forall (process :: * -> * -> *) a b.
Arrow process =>
a -> process b (a, b)
feedConstFst a
a

applyConstSnd ::
   (Arrow process) => process (a,b) c -> b -> process a c
applyConstSnd :: forall (process :: * -> * -> *) a b c.
Arrow process =>
process (a, b) c -> b -> process a c
applyConstSnd process (a, b) c
proc b
a =
   process (a, b) c
proc process (a, b) c -> process a (a, b) -> process a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< b -> process a (a, b)
forall (process :: * -> * -> *) a b.
Arrow process =>
a -> process b (b, a)
feedConstSnd b
a


feedFst :: (C process) => SignalOf process a -> process b (a,b)
feedFst :: forall (process :: * -> * -> *) a b.
C process =>
SignalOf process a -> process b (a, b)
feedFst SignalOf process a
sig =
   SignalOf process a -> process b a
forall b a. SignalOf process b -> process a b
forall (process :: * -> * -> *) b a.
C process =>
SignalOf process b -> process a b
fromSignal SignalOf process a
sig process b a -> process b b -> process b (a, b)
forall b c c'. process b c -> process b c' -> process b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& process b b
forall a. process a a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
Cat.id

feedSnd :: (C process) => SignalOf process a -> process b (b,a)
feedSnd :: forall (process :: * -> * -> *) a b.
C process =>
SignalOf process a -> process b (b, a)
feedSnd SignalOf process a
sig =
   process b b
forall a. process a a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
Cat.id process b b -> process b a -> process b (b, a)
forall b c c'. process b c -> process b c' -> process b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& SignalOf process a -> process b a
forall b a. SignalOf process b -> process a b
forall (process :: * -> * -> *) b a.
C process =>
SignalOf process b -> process a b
fromSignal SignalOf process a
sig

{-# INLINE feedConstFst #-}
feedConstFst :: (Arrow process) => a -> process b (a,b)
feedConstFst :: forall (process :: * -> * -> *) a b.
Arrow process =>
a -> process b (a, b)
feedConstFst a
a = (b -> (a, b)) -> process b (a, b)
forall b c. (b -> c) -> process b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\b
b -> (a
a,b
b))

{-# INLINE feedConstSnd #-}
feedConstSnd :: (Arrow process) => a -> process b (b,a)
feedConstSnd :: forall (process :: * -> * -> *) a b.
Arrow process =>
a -> process b (b, a)
feedConstSnd a
a = (b -> (b, a)) -> process b (b, a)
forall b c. (b -> c) -> process b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\b
b -> (b
b,a
a))


($*) ::
   (C process) =>
   process a b -> SignalOf process a -> SignalOf process b
$* :: forall (process :: * -> * -> *) a b.
C process =>
process a b -> SignalOf process a -> SignalOf process b
($*) = process a b -> SignalOf process a -> SignalOf process b
forall (process :: * -> * -> *) a b.
C process =>
process a b -> SignalOf process a -> SignalOf process b
apply
$< :: forall (process :: * -> * -> *) a b c.
C process =>
process (a, b) c -> SignalOf process a -> process b c
($<) = process (a, b) c -> SignalOf process a -> process b c
forall (process :: * -> * -> *) a b c.
C process =>
process (a, b) c -> SignalOf process a -> process b c
applyFst
$> :: forall (process :: * -> * -> *) a b c.
C process =>
process (a, b) c -> SignalOf process b -> process a c
($>) = process (a, b) c -> SignalOf process b -> process a c
forall (process :: * -> * -> *) a b c.
C process =>
process (a, b) c -> SignalOf process b -> process a c
applySnd