{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE Rank2Types #-}
{- |
Copyright   :  (c) Henning Thielemann 2008
License     :  GPL

Maintainer  :  synthesizer@henning-thielemann.de
Stability   :  provisional
Portability :  requires multi-parameter type classes (Flat)


Basic definitions for causal signal processors
which are controlled by another signal.
Additionally to "Synthesizer.Dimensional.ControlledProcess"
you can convert those processes to plain causal processes
in the case of equal audio and control rates (synchronous control).

It is sensible to bundle the functions
"computation of internal parameters" and
"running the main process",
since computation of the internal parameters
depends on the sample rate of the main process
in case of frequency control values
even though the computation of internal parameters happens
at a different sample rate.

ToDo:
 - Is it better to provide the conversion method not by a record
   but by a type class?
   The difficulty with this is,
   how to handle global parameters like the filter order?
 - Note, that parameters might be computed by different ways.
   Thus a type class with functional dependencies
   for automatic selection of input types and conversion
   will not always be flexible enough.
 - Is it possible and reasonable to hide the type parameter
   for the internal control parameter
   since the user does not need to know it?
 - The internal parameters that the converter generate
   usually depend on the sample rate of the (target) audio signal.
   However, it does not depend on the sample rate of control signal
   where it is applied to.
   How can we ensure that it is not used somewhere else?
   We could discourage access to it at all.
   But it might be sensible to define new external parameters
   in terms of existing ones.
   We could add a phantom 's' type parameter
   to internal control parameters.
   Would this do the trick? Is this convenient?
-}
module Synthesizer.Dimensional.Causal.ControlledProcess where

import qualified Synthesizer.Dimensional.Process as Proc
import qualified Synthesizer.Dimensional.Rate as Rate
import qualified Synthesizer.Dimensional.RatePhantom as RP
import qualified Synthesizer.Dimensional.RateWrapper as SigP
import qualified Synthesizer.Dimensional.Straight.Signal as SigS
import qualified Synthesizer.Dimensional.Straight.Displacement as DispS
import qualified Synthesizer.Dimensional.Amplitude.Signal as SigA
import qualified Synthesizer.Dimensional.Causal.Process as CausalD
import qualified Synthesizer.Dimensional.Map as MapD
import qualified Synthesizer.Dimensional.Amplitude as Amp
import qualified Synthesizer.Causal.Process       as Causal
import qualified Synthesizer.Causal.Interpolation as Interpolation
import qualified Synthesizer.Interpolation.Class as Interpol
import qualified Synthesizer.State.Signal as Sig
import qualified Number.DimensionTerm        as DN
import qualified Algebra.DimensionTerm       as Dim

-- import Synthesizer.Dimensional.Process (($:), ($#), )
-- import Synthesizer.Dimensional.RateAmplitude.Signal (($-))

-- import Number.DimensionTerm ((*&), ) -- ((&*&), (&/&))

import qualified Algebra.RealField      as RealField
-- import qualified Algebra.Field          as Field
-- import qualified Algebra.Ring           as Ring
import qualified Algebra.Additive       as Additive

import Foreign.Storable.Newtype as Store
import Foreign.Storable (Storable(..))

import NumericPrelude
import PreludeBase as P


{- |
This is quite analogous to Dimensional.Causal.Process
but adds the @conv@ parameter for conversion
from intuitive external parameters to internal parameters.
-}
data T conv proc = Cons {
      converter :: conv,
      processor :: proc
   }


{- |
The Functor instance allows
to define an allpass phaser as ControlledProcess,
reusing the allpass cascade provided as ControlledProcess.
It is also possible to define a lowpass filter
with resonance as ControlledProcess
based on the universal filter ControlledProcess.
-}
instance Functor (T conv) where
   fmap f proc =
      Cons (converter proc) (f $ processor proc)

{- |
@ecAmp@ is a set of physical units for the external control parameters,
@ec@ is the type for the external control parameters,
@ic@ for internal control parameters.
-}
type Converter s ecAmp ec ic =
   MapD.T ecAmp Amp.Flat ec (RateDep s ic)

newtype RateDep s ic = RateDep {unRateDep :: ic}

instance Interpol.C a ic => Interpol.C a (RateDep s ic) where
   scaleAndAccumulate =
      Interpol.makeMac RateDep unRateDep

instance Storable ic => Storable (RateDep s ic) where
   sizeOf = Store.sizeOf unRateDep
   alignment = Store.alignment unRateDep
   peek = Store.peek RateDep
   poke = Store.poke unRateDep


{- |
This function is intended for implementing high-level dimensional processors
from low-level processors.
It introduces the sample rate tag @s@.
-}
{-# INLINE makeConverter #-}
makeConverter ::
   (ecAmp -> ec -> ic) -> Converter s ecAmp ec ic
makeConverter f =
   MapD.Cons $ (,) Amp.Flat . (RateDep.) . f

{-# INLINE causalFromConverter #-}
causalFromConverter ::
   Converter s ecAmp ec ic ->
   CausalD.T s ecAmp CausalD.Flat ec (RateDep s ic)
causalFromConverter = CausalD.map


{-# INLINE joinSynchronousPlain #-}
joinSynchronousPlain ::
   T (Converter s ecAmp ec ic)
     (CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut) ->
   CausalD.T s (ecAmp, ampIn) ampOut (ec, sampIn) sampOut
joinSynchronousPlain p =
   processor p CausalD.<<<
   MapD.swap CausalD.^<<
   CausalD.first (causalFromConverter (converter p))

{-# INLINE joinSynchronous #-}
joinSynchronous ::
   Proc.T s u t
      (T (Converter s ecAmp ec ic)
         (CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut)) ->
   Proc.T s u t (CausalD.T s (ecAmp, ampIn) ampOut (ec, sampIn) sampOut)
joinSynchronous cp =
   fmap joinSynchronousPlain cp


{-# INLINE joinFirstSynchronousPlain #-}
joinFirstSynchronousPlain ::
   T (Converter s ecAmp ec ic, a)
     (CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut) ->
   T a
     (CausalD.T s (ecAmp, ampIn) ampOut (ec, sampIn) sampOut)
joinFirstSynchronousPlain p =
   Cons {
      converter = snd (converter p),
      processor = joinSynchronousPlain (Cons (fst (converter p)) (processor p))
   }

{-
With this signature we deconstruct a right biased pair tree in the ampIn parameter of T
and build a left biased pair tree in the corresponding output parameter.
We could also use a pair of heterogeneous lists.
But the effect is always, that the list is reversed.
-}
{-# INLINE joinFirstSynchronous #-}
joinFirstSynchronous ::
   Proc.T s u t
      (T (Converter s ecAmp ec ic, a)
         (CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut)) ->
   Proc.T s u t
      (T a
         (CausalD.T s (ecAmp, ampIn) ampOut (ec, sampIn) sampOut))
joinFirstSynchronous cp =
   fmap joinFirstSynchronousPlain cp

{-
{-# INLINE runSynchronous #-}
runSynchronous ::
   Proc.T s u t (T s (Convert ecAmp ec ic) (CausalD.Flat, ampIn) ampOut (RateDep s ic, sampIn) sampOut) ->
   Proc.T s u t (CausalD.T s (ecAmp, ampIn) ampOut (ec, sampIn) sampOut)
runSynchronous cp =
   do p <- cp
      return (processor p . converter p)
-}

{-# INLINE runSynchronous1 #-}
runSynchronous1 :: (Dim.C v) =>
   Proc.T s u t
      (T (Converter s (DN.T v ecAmp) ec ic)
         (CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut)) ->
   Proc.T s u t
      (SigA.R s v ecAmp ec -> CausalD.T s ampIn ampOut sampIn sampOut)
runSynchronous1 =
   fmap CausalD.applyFst . joinSynchronous


{-# INLINE runSynchronousPlain2 #-}
runSynchronousPlain2 :: (Dim.C v0, Dim.C v1) =>
   (T (Converter s (DN.T v0 ecAmp0, DN.T v1 ecAmp1) (ec0, ec1) ic)
      (CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut)) ->
   (SigA.R s v0 ecAmp0 ec0 ->
    SigA.R s v1 ecAmp1 ec1 ->
    CausalD.T s ampIn ampOut sampIn sampOut)
runSynchronousPlain2 causal =
   let causalPairs =
          joinSynchronousPlain causal CausalD.<<^ MapD.balanceLeft
   in  \x y ->
          (causalPairs `CausalD.applyFst` x) `CausalD.applyFst` y

{-# INLINE runSynchronous2 #-}
runSynchronous2 :: (Dim.C v0, Dim.C v1) =>
   Proc.T s u t
      (T (Converter s (DN.T v0 ecAmp0, DN.T v1 ecAmp1) (ec0, ec1) ic)
         (CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut)) ->
   Proc.T s u t
      (SigA.R s v0 ecAmp0 ec0 ->
       SigA.R s v1 ecAmp1 ec1 ->
       CausalD.T s ampIn ampOut sampIn sampOut)
runSynchronous2 cp =
   fmap runSynchronousPlain2 cp

{-
{-# INLINE runSynchronous3 #-}
runSynchronous3 ::
   Proc.T s u t (T s (RP.T s sig0 ec0, RP.T s sig1 ec1, RP.T s sig2 ec2) ic a) ->
   Proc.T s u t (RP.T s sig0 ec0 -> RP.T s sig1 ec1 -> RP.T s sig2 ec2 -> a)
runSynchronous3 =
   fmap (\f x y z -> f (x,y,z)) . runSynchronous
-}


{-# INLINE runAsynchronous #-}
runAsynchronous ::
   (Dim.C u, RealField.C t) =>
   Interpolation.T t (RateDep s ic) ->
   Proc.T s u t
      (T (Converter s ecAmp ec ic)
         (CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut)) ->
   Rate.T r u t ->
   SigS.R r (RateDep s ic) ->
   Proc.T s u t
      (CausalD.T s ampIn ampOut sampIn sampOut)
runAsynchronous ip cp srcRate sig =
   do p <- cp
      k <- fmap
              (DN.divToScalar (Rate.toDimensionNumber srcRate))
              Proc.getSampleRate
      return $
         CausalD.applyFlatFst (processor p CausalD.<<^ MapD.swap) $
         RP.fromSignal $
         Causal.apply
            (Interpolation.relativeConstantPad ip zero (SigS.toSamples sig))
            (Sig.repeat k)

{-# INLINE runAsynchronousBuffered #-}
runAsynchronousBuffered ::
   (Dim.C u, RealField.C t) =>
   Interpolation.T t (RateDep s ic) ->
   Proc.T s u t
      (T (Converter s ecAmp ec ic)
         (CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut)) ->
   Rate.T r u t ->
   SigS.R r (RateDep s ic) ->
   Proc.T s u t
      (CausalD.T s ampIn ampOut sampIn sampOut)
runAsynchronousBuffered ip cp srcRate sig =
   do p <- cp
      k <- fmap
              (DN.divToScalar (Rate.toDimensionNumber srcRate))
              Proc.getSampleRate
      return $
         CausalD.applyFlatFst (processor p CausalD.<<^ MapD.swap) $
         RP.fromSignal $
         Causal.apply
            (Interpolation.relativeConstantPad ip zero
                (Sig.fromList $ Sig.toList $ SigS.toSamples sig))
            (Sig.repeat k)


{-# INLINE applyConverter1 #-}
applyConverter1 :: (Dim.C v) =>
   Converter s (DN.T v ecAmp) ec ic ->
   SigA.R s v ecAmp ec -> SigS.R s (RateDep s ic)
applyConverter1 (MapD.Cons f) x =
   DispS.map (snd $ f (SigA.amplitude x)) (SigA.phantomSignal x)

{-# INLINE runAsynchronous1 #-}
runAsynchronous1 ::
   (Dim.C u, Dim.C v, RealField.C t) =>
   Interpolation.T t (RateDep s ic) ->
   Proc.T s u t
      (T (Converter s (DN.T v ecAmp) ec ic)
         (CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut)) ->
   SigP.T u t (SigA.S v ecAmp) ec ->
   Proc.T s u t
      (CausalD.T s ampIn ampOut sampIn sampOut)
runAsynchronous1 ip cp x =
   let (srcRate,sig) = SigP.toSignal x
   in  do p <- cp
          runAsynchronous ip cp srcRate (applyConverter1 (converter p) sig)

{-# INLINE processAsynchronous1 #-}
processAsynchronous1 ::
   (Dim.C u, Dim.C v, RealField.C t) =>
   Interpolation.T t (RateDep s ic) ->
   Proc.T s u t
      (T (Converter s (DN.T v ecAmp) ec ic)
         (CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut)) ->
   DN.T (Dim.Recip u) t ->
   (forall r. Proc.T r u t (SigA.R r v ecAmp ec)) ->
   Proc.T s u t
      (CausalD.T s ampIn ampOut sampIn sampOut)
processAsynchronous1 ip cp rate x =
   let sig = RP.fromSignal $ Proc.run rate (fmap RP.toSignal x)
   in  do p <- cp
          runAsynchronous ip cp (Rate.fromDimensionNumber rate)
             (applyConverter1 (converter p) sig)


{-# INLINE applyConverter2 #-}
applyConverter2 :: (Dim.C v0, Dim.C v1) =>
   Converter s (DN.T v0 ecAmp0, DN.T v1 ecAmp1) (ec0, ec1) ic ->
   SigA.R s v0 ecAmp0 ec0 ->
   SigA.R s v1 ecAmp1 ec1 ->
   SigS.R s (RateDep s ic)
applyConverter2 (MapD.Cons f) x y =
   SigS.fromSamples $
   Sig.map (snd $ f (SigA.amplitude x, SigA.amplitude y)) $
   Sig.zip (SigA.samples x) (SigA.samples y)

{- |
Using two SigP.T's as input has the disadvantage
that their rates must be compared dynamically.
It is not possible with our data structures
to use one rate for multiple signals.
We could also allow the input of a Rate.T and two Proc.T's,
since this is the form we get from the computation routines.
But this way we lose sharing.
-}
{-# INLINE runAsynchronous2 #-}
runAsynchronous2 ::
   (Dim.C u, Dim.C v0, Dim.C v1, RealField.C t) =>
   Interpolation.T t (RateDep s ic) ->
   Proc.T s u t
      (T (Converter s (DN.T v0 ecAmp0, DN.T v1 ecAmp1) (ec0, ec1) ic)
         (CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut)) ->
   SigP.T u t (SigA.S v0 ecAmp0) ec0 ->
   SigP.T u t (SigA.S v1 ecAmp1) ec1 ->
   Proc.T s u t
      (CausalD.T s ampIn ampOut sampIn sampOut)
runAsynchronous2 ip cp x y =
   let (srcRateX,sigX) = SigP.toSignal x
       (srcRateY,sigY) = SigP.toSignal y
       srcRate = Rate.common "ControlledProcess.runAsynchronous2" srcRateX srcRateY
   in  do p <- cp
          runAsynchronous ip cp srcRate
             (applyConverter2 (converter p) sigX sigY)


{- |
This function will be more commonly used than 'runAsynchronous2',
but it disallows sharing of control signals.
It can be easily defined in terms of 'runAsynchronous2' and 'SigP.runProcess',
but the implementation here does not need the check for equal sample rates.
-}
{-# INLINE processAsynchronous2 #-}
processAsynchronous2 ::
   (Dim.C u, Dim.C v0, Dim.C v1, RealField.C t) =>
   Interpolation.T t (RateDep s ic) ->
   Proc.T s u t
      (T (Converter s (DN.T v0 ecAmp0, DN.T v1 ecAmp1) (ec0, ec1) ic)
         (CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut)) ->
   DN.T (Dim.Recip u) t ->
   (forall r. Proc.T r u t (SigA.R r v0 ecAmp0 ec0)) ->
   (forall r. Proc.T r u t (SigA.R r v1 ecAmp1 ec1)) ->
   Proc.T s u t
      (CausalD.T s ampIn ampOut sampIn sampOut)
processAsynchronous2 ip cp rate x y =
   let sigX = RP.fromSignal $ Proc.run rate (fmap RP.toSignal x)
       sigY = RP.fromSignal $ Proc.run rate (fmap RP.toSignal y)
   in  do p <- cp
          runAsynchronous ip cp (Rate.fromDimensionNumber rate)
             (applyConverter2 (converter p) sigX sigY)


{-# INLINE processAsynchronousNaive2 #-}
processAsynchronousNaive2 ::
   (Dim.C u, Dim.C v0, Dim.C v1, RealField.C t) =>
   Interpolation.T t (RateDep s ic) ->
   Proc.T s u t
      (T (Converter s (DN.T v0 ecAmp0, DN.T v1 ecAmp1) (ec0, ec1) ic)
         (CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut)) ->
   DN.T (Dim.Recip u) t ->
   (forall r. Proc.T r u t (SigA.R r v0 ecAmp0 ec0)) ->
   (forall r. Proc.T r u t (SigA.R r v1 ecAmp1 ec1)) ->
   Proc.T s u t
      (CausalD.T s ampIn ampOut sampIn sampOut)
processAsynchronousNaive2 ip cp rate x y =
   runAsynchronous2 ip cp
      (SigP.runProcess rate x) (SigP.runProcess rate y)


{-
This uses lazy StorableVector for buffering
of the internal control parameters.
This increases laziness granularity,
but it should be faster, since interpolation needs frequent look-ahead,
and this is faster on a Storable signal than on a plain stateful signal generator.
Since the look-ahead is constant,
it is interesting whether interpolation can be made more efficient
without Storable.

{-# INLINE processAsynchronousStorable2 #-}
processAsynchronousStorable2 ::
   (Dim.C u, Dim.C v0, Dim.C v1, Storable ic, RealField.C t) =>
   Interpolation.T t (RateDep s ic) ->
   Proc.T s u t
      (T (Converter s (DN.T v0 ecAmp0, DN.T v1 ecAmp1) (ec0, ec1) ic)
         (CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut)) ->
   DN.T (Dim.Recip u) t ->
   (forall r. Proc.T r u t (SigA.R r v0 ecAmp0 ec0)) ->
   (forall r. Proc.T r u t (SigA.R r v1 ecAmp1 ec1)) ->
   Proc.T s u t
      (CausalD.T s ampIn ampOut sampIn sampOut)
processAsynchronousStorable2 ip cp rate x y =
   let sigX = RP.fromSignal $ Proc.run rate (fmap RP.toSignal x)
       sigY = RP.fromSignal $ Proc.run rate (fmap RP.toSignal y)
   in  do p <- cp
          runAsynchronous ip cp (Rate.fromDimensionNumber rate)
             (applyConverter2 (converter p) sigX sigY)
-}

{- |
This buffers internal control parameters before interpolation.
This should be faster, since interpolation needs frequent look-ahead,
and this is faster on a buffered signal than on a plain stateful signal generator.

Since the look-ahead is constant,
it is interesting whether interpolation can be made more efficient
without the inefficient intermediate list structure.
-}
{-# INLINE processAsynchronousBuffered2 #-}
processAsynchronousBuffered2 ::
   (Dim.C u, Dim.C v0, Dim.C v1, RealField.C t) =>
   Interpolation.T t (RateDep s ic) ->
   Proc.T s u t
      (T (Converter s (DN.T v0 ecAmp0, DN.T v1 ecAmp1) (ec0, ec1) ic)
         (CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut)) ->
   DN.T (Dim.Recip u) t ->
   (forall r. Proc.T r u t (SigA.R r v0 ecAmp0 ec0)) ->
   (forall r. Proc.T r u t (SigA.R r v1 ecAmp1 ec1)) ->
   Proc.T s u t
      (CausalD.T s ampIn ampOut sampIn sampOut)
processAsynchronousBuffered2 ip cp rate x y =
   let sigX = RP.fromSignal $ Proc.run rate (fmap RP.toSignal x)
       sigY = RP.fromSignal $ Proc.run rate (fmap RP.toSignal y)
   in  do p <- cp
          runAsynchronousBuffered ip cp (Rate.fromDimensionNumber rate)
             (applyConverter2 (converter p) sigX sigY)


{-
{-# INLINE runAsynchronous3 #-}
runAsynchronous3 ::
   (Dim.C u, RealField.C t) =>
   Interpolation.T t (RateDep s ic) ->
   Proc.T s u t (T s (RP.T r sig0 ec0, RP.T r sig1 ec1, RP.T r sig2 ec2) ic a) ->
   SigP.T u t sig0 ec0 ->
   SigP.T u t sig1 ec1 ->
   SigP.T u t sig2 ec2 ->
   Proc.T s u t a
runAsynchronous3 ip cp x y z =
   let (srcRateX,sigX) = SigP.toSignal x
       (srcRateY,sigY) = SigP.toSignal y
       (srcRateZ,sigZ) = SigP.toSignal z
       common = Rate.common "ControlledProcess.runAsynchronous3"
       srcRate = srcRateX `common` srcRateY `common` srcRateZ
   in  runAsynchronous ip cp srcRate (sigX,sigY,sigZ)
-}