{- |
In this modules we try to infer sampling parameters
using the unique-logic package.

Every signal is equipped with input and output parameters
that allow inference of sampling parameters.
However, this way, signals are functions
and their body cannot easily be shared.
In general signals should not be used explicitly.
Instead you should combine small signal processors to larger signal processors.
In fact, this boils down to "Control.Arrow" operations,
although we cannot use the @Arrow@ class.
We can however use the same set of combinators adapted to our needs.
We even cannot hide the peano numbers of unique-logic in the arrows,
since the number of needed peano counters depends on the number of inputs
and outputs of an arrow.
-}

{-
Inference by expressing a 'let' construct by a fixed point.

@
let input  = ping
    output = mix input (delay output)
in  output
@

@
snd $ fix (\ ~(input, output) -> (ping, mix input (delay output)))
@


Split into atomic equations which fit the equation solver framework.
@
let input         = ping
    delayedOutput = delay output
    output        = mix input delayedOutput
in  output
@

Enrich equations with information for the lazy knot.
Signal parameters for the function results
are included in the signals,
but signal parameters of the inputs are returned separately.
@
let input =
       ping [parametersOf input, inputParam0]
    (delayedOutput, outputParam0) =
       delay [parametersOf delayedOutput, delayOutputParam0] output
    (output, (inputParam0, delayOutputParam0)) =
       mix [parametersOf output, outputParam0] input delayedOutput
in  output
@

@
let input =
       ping input [inputParam0]
    (delayedOutput, outputParam0) =
       delay delayedOutput [delayOutputParam0] output
    (output, (inputParam0, delayOutputParam0)) =
       mix output [outputParam0] input delayedOutput
in  output
@

@
let input@(inputStream, inputParam0) =
       ping [inputParam0, inputParam1]
    (delayedOutput@(delayedOutputStream, delayedOutputParam0), outputParam1) =
       delay [delayedOutputParam0, delayOutputParam1] output
    (output@(outputStream, outputParam0), (inputParam1, delayOutputParam1)) =
       mix [outputParam0, outputParam1] input delayedOutput
in  output
@

The first list argument of each computation function contains signals,
but only the parameters are used and the data stream is ignored.
@
let input = ping [input]
    (delayedOutput, output0) =
       delay [delayedOutput, delayedOutput0] output
    (output, (input0,delayedOutput0)) =
       mix [output,output0] input delayedOutput
in  output
@





Develop a simpler example:

Work out
@
envelope exponential oscillator
@

@
\zp0 ->
  let x = exponential xp0
      y = oscillator yp0
      (z,(xp1,yp1)) = envelope zp0 x y
      xp0 = closeCycle xp1
      yp0 = closeCycle yp1
  in  z
@

Now with sharing of the 'exponential'.
The model is
@
let x = exponential
in  envelope x (oscillator x)
@
or
@
snd $ fix \ (x, _) ->
    (exponential, envelope x (oscillator x))
@

@
\zp0 ->
  let x       = exponential xp0
      (y,xp1) = oscillator yp0 x
      (z,(xp2,yp1)) = envelope zp0 (replaceParam xp1 x) y
      xp0 = closeCycle xp2
      yp0 = closeCycle yp1
  in  z
@

With fixed point operator
@
\((x,xp0), (_,zp0)) ->
  let (y,xp1) = oscillator yp0 x
      (z,(xp2,yp1)) = envelope zp0 (replaceParam xp1 x) y
      yp0 = closeCycle yp1
  in  ((xp2, exponential xp0), (undefined,z))
@

Many generators with the same sample rate
can be handled elegantly with the monad (SharedVariable a).
@
\zp0 -> evalSharing $ mdo
   x <- initial exponential
   y <- share (oscillator yp0) x
   (z,yp1) <- share (envelope zp0 y) x
   let yp0 = closeCycle yp1
   return z
@
-}

module Synthesizer.Inference.Fix where


import qualified Synthesizer.Physical.Signal as SigP

import qualified UniqueLogicNP.Lazy.SingleStep as Logic


-- * custom interface

type Parameter a = Logic.Variable a

type Result a = Parameter a

type Parameters t y = (Parameter t, Parameter y)

type Results t y = (Result t, Result y)

type InputSignal  t t' y y' yv = SigP.T t (Parameter t') y (Parameter y') yv

type OutputSignal t t' y y' yv = SigP.T t (Result t') y (Result y') yv



infixr 9 .%, .%&
infixr 0 $%, $%%, $$%&



{- |
Combinator function:
Since the interim signal is not seen anywhere else,
we know of all influences to its value.
These are the backward-constraints of @f@
and the forward-constraints of @g@
and we can simply fuse them using 'Logic.closeCycle'.

*** The order of input and output values should be flipped,
in order to match that of @(->)@.
-}
{-
(.%) ::
   ((Parameters tc' yc', InputSignal tb tb' yb yb' ybv) ->
       (OutputSignal tc tc' yc yc' ycv, Results tb' yb')) ->
   ((Parameters tb' yb', InputSignal ta ta' ya ya' yav) ->
       (OutputSignal tb tb' yb yb' ybv, Results ta' ya')) ->
   ((Parameters tc' yc', InputSignal ta ta' ya ya' yav) ->
       (OutputSignal tc tc' yc yc' ycv, Results ta' ya'))
-}
(.%) ::
   ((params, InputSignal ta ta' ya ya' yav) ->
       (output, Results ta' ya')) ->
   ((Parameters ta' ya', input) ->
       (OutputSignal ta ta' ya ya' yav, result)) ->
   ((params, input) ->
       (output, result))
(f .% g) (zParams, x) =
   let (y,xResults) = g (yParams,x)
       (z,yResults) = f (zParams,y)
       yParams = closeParameterCycles yResults
   in  (z,xResults)

($%) ::
   ((params, InputSignal ta ta' ya ya' yav) ->
       (output, Results ta' ya')) ->
   (Parameters ta' ya' ->
       OutputSignal ta ta' ya ya' yav) ->
   (params ->
       output)
(f $% g) zParams =
   let y            = g yParams
       (z,yResults) = f (zParams,y)
       yParams = closeParameterCycles yResults
   in  z

($%%) ::
   ((params, (InputSignal ta ta' ya ya' yav, InputSignal tb tb' yb yb' ybv)) ->
       (output, (Results ta' ya', Results tb' yb'))) ->
   (Parameters ta' ya' -> OutputSignal ta ta' ya ya' yav,
    Parameters tb' yb' -> OutputSignal tb tb' yb yb' ybv) ->
   (params ->
       output)
(f $%% (ga,gb)) zParams =
   let ya = ga yaParams
       yb = gb ybParams
       (z,(yaResults,ybResults)) =
            f (zParams,(ya,yb))
       yaParams = closeParameterCycles yaResults
       ybParams = closeParameterCycles ybResults
   in  z


(.%&) ::
   ((params, (InputSignal ta ta' ya ya' yav, InputSignal tb tb' yb yb' ybv)) ->
       (output, (Results ta' ya', Results tb' yb'))) ->
   (((Parameters ta' ya', Parameters tb' yb'), input) ->
       ((OutputSignal ta ta' ya ya' yav, OutputSignal tb tb' yb yb' ybv), result)) ->
   ((params, input) ->
       (output, result))
(f .%& g) (zParams, x) =
   let ((ya,yb), xResults)       = g ((yaParams,ybParams),x)
       (z,(yaResults,ybResults)) = f (zParams,(ya,yb))
       yaParams = closeParameterCycles yaResults
       ybParams = closeParameterCycles ybResults
   in  (z,xResults)

{-
($%&) ::
   ((params, (InputSignal ta ta' ya ya' yav, InputSignal tb tb' yb yb' ybv)) ->
       (output, (Results ta' ya', Results tb' yb'))) ->
   ((Parameters ta' ya', Parameters tb' yb') ->
    (OutputSignal ta ta' ya ya' yav, OutputSignal tb tb' yb yb' ybv)) ->
   (params ->
       output)
(f $%& g) zParams =
   let ya                        = ga yaParams
       yb                        = gb ybParams
       (z,(yaResults,ybResults)) = f (zParams,(ya,yb))
       yaParams = closeParameterCycles yaResults
       ybParams = closeParameterCycles ybResults
   in  z
-}

($$%&) ::
   ((paramsA, InputSignal ta ta' ya ya' yav) ->
       (outputA, Results ta' ya'),
    (paramsB, InputSignal tb tb' yb yb' ybv) ->
       (outputB, Results tb' yb')) ->
   ((Parameters ta' ya', Parameters tb' yb') ->
       (OutputSignal ta ta' ya ya' yav, OutputSignal tb tb' yb yb' ybv)) ->
   ((paramsA,paramsB) ->
       (outputA,outputB))
((fa,fb) $$%& x) (yaParams,ybParams) =
   let (xa,xb) = x (xaParams,xbParams)
       (ya,xaResults) = fa (yaParams,xa)
       (yb,xbResults) = fb (ybParams,xb)
       xaParams = closeParameterCycles xaResults
       xbParams = closeParameterCycles xbResults
   in  (ya,yb)


{-
   ((paramsA, InputSignal t t' y y' yv) ->
       (outputA, Results t' y')) ->
   ((paramsB, InputSignal t t' y y' yv) ->
       (outputB, Results t' y')) ->
   (Parameters t' y' ->
       OutputSignal t t' y y' yv) ->
   ((paramsA,paramsB) ->
       (outputA,outputB))
-}
{-
Is this function implemented correctly?
-}
share2 ::
   (Parameters t' y' ->
       OutputSignal t t' y y' yv) ->
   ((Parameters t' y', Parameters t' y') ->
       (OutputSignal t t' y y' yv, OutputSignal t t' y y' yv))
share2 x ((sr0,amp0),(sr1,amp1)) =
   let srResult  = Logic.merge sr0  sr1
       ampResult = Logic.merge amp0 amp1
       y = x (srResult, ampResult)
   in  (y, y)

share2' :: (Eq t', Eq y') =>
   (Parameters t' y' ->
       OutputSignal t t' y y' yv) ->
   ((Parameters t' y', Parameters t' y') ->
       (OutputSignal t t' y y' yv, OutputSignal t t' y y' yv))
share2' x ((sr0,amp0),(sr1,amp1)) =
   let (sr0Result,  sr1Result)  = Logic.equal sr0  sr1
       (amp0Result, amp1Result) = Logic.equal amp0 amp1
       y0 = x (sr0Result, amp0Result)
       y1 = x (sr1Result, amp1Result)
   in  (y0, SigP.replaceSamples (SigP.samples y0) y1)


fix ::
   ((Parameters t' y', InputSignal t t' y y' yv) ->
       (OutputSignal t t' y y' yv, Results t' y')) ->
   (Parameters t' y' ->
       OutputSignal t t' y y' yv)
fix x (ySR,yAmp) =
   let (y,(zSR,zAmp)) = x ((xSR,xAmp), y)
       xSR  = Logic.closeCycle $ Logic.merge ySR  zSR
       xAmp = Logic.closeCycle $ Logic.merge yAmp zAmp
{-
       xSR  = Logic.merge ySR  zSR
       xAmp = Logic.merge yAmp zAmp
-}
   in  y

{-
Probably this needs a different interface (signature)
in order to be used flawlessly in a signal processing algorithm.
-}
fixSampleRate ::
   t' ->
     OutputSignal t t' y y' yv ->
     OutputSignal t t' y y' yv
fixSampleRate sr = SigP.replaceSampleRate (Logic.constant sr)


run ::
   (Parameters t' y' ->
       OutputSignal t t' y y' yv) ->
   SigP.T t t' y y' yv
run x =
   let y = x (sr,amp)
       srResult  = SigP.sampleRate y
       ampResult = SigP.amplitude  y
       sr  = Logic.closeCycle srResult
       amp = Logic.closeCycle ampResult
   in  SigP.replaceParameters
          (Logic.variableValue srResult)
          (Logic.variableValue ampResult)
          y


{-
Shall 'replaceParameter' check
whether the replaced variables have the same value?
-}

closeParameterCycles ::
   Results t' y' -> Parameters t' y'
closeParameterCycles ~(sr,amp) =
   (Logic.closeCycle sr, Logic.closeCycle amp)


-- * arrow interface

newtype Processor inSignal results params outSignal =
   Processor ((params, inSignal) -> (outSignal, results))

infixr 1 <<<

{- |
The same as '(.%)'.
-}
(<<<) ::
   Processor
      (InputSignal t t' y y' yv) (Results t' y')
      params output ->
   Processor
      input result
      (Parameters t' y') (OutputSignal t t' y y' yv) ->
   Processor input result params output
Processor f <<< Processor g = Processor $ f .% g