```module Synthesizer.Dimensional.Causal.Process where

import qualified Synthesizer.Causal.Process as Causal

import qualified Synthesizer.Dimensional.Amplitude.Signal as SigA

import qualified Algebra.Module as Module
import qualified Algebra.Field  as Field
import Algebra.Module ((*>))

import qualified Number.DimensionTerm        as DN
import qualified Algebra.DimensionTerm       as Dim

import qualified Control.Arrow as Arrow

import Prelude hiding (map, )

{-
TODO:
This differs from Rate.Process and Amplitude.Signal in the following way:
Here we expect, that @amp@ are types that contain physical units,
whereas Rate.Process.T has separate type variables for unit and values.
Thus Rate.Process.T is limited to DimensionalTerm numbers.
We need the additional flexibility here
because @amp@ can also be a pair of amplitudes
or a more complicated ensemble of amplitudes.
-}
newtype T amp0 amp1 yv0 yv1 =
Cons (amp0 -> (amp1, Causal.T yv0 yv1))

{-# INLINE apply #-}
apply :: (Dim.C v0) =>
T (DN.T v0 y0) (DN.T v1 y1) yv0 yv1 ->
SigA.R s v0 y0 yv0 -> SigA.R s v1 y1 yv1
apply (Cons f) x =
let (yAmp, causal) = f (SigA.amplitude x)
in  SigA.fromSamples yAmp (Causal.apply causal (SigA.samples x))

{-# INLINE applyFst #-}
applyFst :: (Dim.C v0) =>
T (DN.T v0 y0, restAmp) (DN.T v1 y1) (yv0, restSamp) yv1 ->
SigA.R s v0 y0 yv0 ->
T restAmp (DN.T v1 y1) restSamp yv1
applyFst (Cons f) x =
Cons \$ \yAmp ->
let (zAmp, causal) = f (SigA.amplitude x, yAmp)
in  (zAmp, Causal.applyFst causal (SigA.samples x))

{-# INLINE map #-}
map ::
(amp0 -> amp1) ->
(yv0 -> yv1) ->
T amp0 amp1 yv0 yv1
map f g =
Cons \$ \ xAmp -> (f xAmp, Causal.map g)

infixr 3 ***
infixr 3 &&&
infixr 1 >>>, ^>>, >>^
infixr 1 <<<, ^<<, <<^

{-# INLINE compose #-}
{-# INLINE (>>>) #-}
compose, (>>>) ::
T amp0 amp1 yv0 yv1 ->
T amp1 amp2 yv1 yv2 ->
T amp0 amp2 yv0 yv2
compose (Cons f) (Cons g) =
Cons \$ \ xAmp ->
let (yAmp, causalXY) = f xAmp
(zAmp, causalYZ) = g yAmp
in  (zAmp, Causal.compose causalXY causalYZ)

(>>>) = compose

{-# INLINE (<<<) #-}
(<<<) ::
T amp1 amp2 yv1 yv2 ->
T amp0 amp1 yv0 yv1 ->
T amp0 amp2 yv0 yv2
(<<<) = flip (>>>)

{-# INLINE first #-}
first ::
T amp0 amp1 yv0 yv1 ->
T (amp0, amp) (amp1, amp) (yv0, yv) (yv1, yv)
first (Cons f) =
Cons \$ \ (xAmp, amp) ->
let (yAmp, causal) = f xAmp
in  ((yAmp, amp), Causal.first causal)

{-# INLINE second #-}
second ::
T amp0 amp1 yv0 yv1 ->
T (amp, amp0) (amp, amp1) (yv, yv0) (yv, yv1)
second (Cons f) =
Cons \$ \ (amp, xAmp) ->
let (yAmp, causal) = f xAmp
in  ((amp, yAmp), Causal.second causal)

{-# INLINE split #-}
{-# INLINE (***) #-}
split, (***) ::
T amp0 amp1 yv0 yv1 ->
T amp2 amp3 yv2 yv3 ->
T (amp0, amp2) (amp1, amp3) (yv0, yv2) (yv1, yv3)
split f g =
compose (first f) (second g)

(***) = split

{-# INLINE fanout #-}
{-# INLINE (&&&) #-}
fanout, (&&&) ::
T amp amp0 yv yv0 ->
T amp amp1 yv yv1 ->
T amp (amp0, amp1) yv (yv0, yv1)
fanout f g =
compose (map (\amp -> (amp,amp)) (\y -> (y,y))) (split f g)

(&&&) = fanout

{-# INLINE (^>>) #-}
-- | Precomposition with a pure function.
(^>>) ::
(amp0 -> amp1, yv0 -> yv1) ->
T amp1 amp2 yv1 yv2 ->
T amp0 amp2 yv0 yv2
f ^>> a = uncurry map f >>> a

{-# INLINE (>>^) #-}
-- | Postcomposition with a pure function.
(>>^) ::
T amp0 amp1 yv0 yv1 ->
(amp1 -> amp2, yv1 -> yv2) ->
T amp0 amp2 yv0 yv2
a >>^ f = a >>> uncurry map f

{-# INLINE (<<^) #-}
-- | Precomposition with a pure function (right-to-left variant).
(<<^) ::
T amp1 amp2 yv1 yv2 ->
(amp0 -> amp1, yv0 -> yv1) ->
T amp0 amp2 yv0 yv2
a <<^ f = a <<< uncurry map f

{-# INLINE (^<<) #-}
-- | Postcomposition with a pure function (right-to-left variant).
(^<<) ::
(amp1 -> amp2, yv1 -> yv2) ->
T amp0 amp1 yv0 yv1 ->
T amp0 amp2 yv0 yv2
f ^<< a = uncurry map f <<< a

{-# INLINE loop #-}
-- loop :: a (b, d) (c, d) -> a b c
loop ::
(Field.C y, Module.C y yv, Dim.C v) =>
DN.T v y ->
T (restAmp0, DN.T v y) (restAmp1, DN.T v y) (restSamp0, yv) (restSamp1, yv) ->
T restAmp0 restAmp1 restSamp0 restSamp1
loop ampIn (Cons f) =
Cons \$ \restAmp0 ->
let ((restAmp1, ampOut), causal) = f (restAmp0, ampIn)
in  (restAmp1,
Causal.loop (causal Arrow.>>^
Arrow.second (DN.divToScalar ampOut ampIn *>)))
```