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 *>)))