{- |
Maps that handle pairs of amplitudes and sampled values.
They are a special form of arrows.
-}
module Synthesizer.Dimensional.Map where

import qualified Synthesizer.Dimensional.Arrow as ArrowD

import qualified Synthesizer.Dimensional.Signal.Private as SigA
import qualified Synthesizer.Dimensional.Amplitude.Flat as Flat
import qualified Synthesizer.Dimensional.Amplitude as Amp

import qualified Control.Arrow as Arrow
import Control.Arrow (Arrow, )
import Control.Category (Category, )

import qualified Synthesizer.Generic.Signal2 as SigG2

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

import qualified Algebra.Module as Module
import qualified Algebra.Field  as Field

import qualified Data.Function as Func
import qualified Data.Tuple as Tuple
import Data.Tuple.HT as TupleHT (swap, )

import Prelude hiding (map, fst, snd, id, )



{- |
This type shall ensure, that you do not accidentally
bring amplitudes and the corresponding low-level signal values out of sync.
We also use it for generation of internal control parameters
in "Synthesizer.Dimensional.Causal.ControlledProcess".
In principle this could also be 'Causal.T',
but maps are not bound to a sampling rate,
and thus do not need the @s@ type parameter.
-}
type T amp0 amp1 yv0 yv1 =
   ArrowD.T amp0 amp1 (yv0 -> yv1)


{-# INLINE apply #-}
apply ::
   (SigG2.Transform sig yv0 yv1) =>
   T amp0 amp1 yv0 yv1 ->
   SigA.T rate amp0 (sig yv0) ->
   SigA.T rate amp1 (sig yv1)
apply = ArrowD.apply

{-# INLINE applyFlat #-}
applyFlat ::
   (Flat.C yv0 amp0, SigG2.Transform sig yv0 yv1) =>
   T (Amp.Flat yv0) amp1 yv0 yv1 ->
   SigA.T rate amp0 (sig yv0) ->
   SigA.T rate amp1 (sig yv1)
applyFlat = ArrowD.applyFlat


{-# INLINE forceDimensionalAmplitude #-}
forceDimensionalAmplitude ::
   (Dim.C v, Field.C y, Module.C y yv, Arrow arrow) =>
   DN.T v y ->
   ArrowD.T (Amp.Dimensional v y) (Amp.Dimensional v y) (arrow yv yv)
forceDimensionalAmplitude =
   ArrowD.forceDimensionalAmplitude

{-# INLINE forcePrimitiveAmplitude #-}
forcePrimitiveAmplitude ::
   (Amp.Primitive amp, Arrow arrow) =>
   ArrowD.T amp amp (arrow yv yv)
forcePrimitiveAmplitude =
   independent (const Amp.primitive) Func.id


{- |
We restrict the amplitude types to those of class 'Amplitude'.
Otherwise 'mapAmplitude' could be abused
for bringing amplitudes and respective sample values out of sync.
For mapping amplitudes that are nested in some pairs,
use it in combination with 'first' and 'second'.

FIXME:
Using this function is however still unsafe,
since normally it should not be observable
how the volume is balanced between amplitude and signal.
This function allows to replace an actual amplitude by 'Flat',
which is also unsafe.
This may only be used for proportional mappings.
See 'SigA.T'.
-}
{-# INLINE mapAmplitude #-}
mapAmplitude ::
   (Amp.C amp0, Amp.C amp1, Arrow arrow) =>
   (amp0 -> amp1) ->
   ArrowD.T amp0 amp1 (arrow yv yv)
mapAmplitude f =
   independent f Func.id

{- |
FIXME: This function is unsafe.
Only use it for proportional mappings.
See 'SigA.T'.
-}
{-# INLINE mapAmplitudeSameType #-}
mapAmplitudeSameType ::
   (Arrow arrow) =>
   (amp -> amp) ->
   ArrowD.T amp amp (arrow yv yv)
mapAmplitudeSameType f =
   independent f Func.id


{- |
This function can be abused to bring the amplitudes out of order.
So be careful!
-}
{-# INLINE independent #-}
independent ::
   (Arrow arrow) =>
   (amp0 -> amp1) -> (yv0 -> yv1) ->
   ArrowD.T amp0 amp1 (arrow yv0 yv1)
independent =
   ArrowD.independentMap

{-# INLINE id #-}
id ::
   (Category arrow) =>
   ArrowD.T amp amp
     (arrow y y)
id = ArrowD.id

{-# INLINE double #-}
double ::
   (Arrow arrow) =>
   ArrowD.T amp (amp, amp)
     (arrow y (y, y))
double =
   let aux = \x -> (x, x)
   in  independent aux aux

{-# INLINE fst #-}
fst ::
   (Arrow arrow) =>
   ArrowD.T (amp0,amp1) amp0
     (arrow (y0,y1) y0)
fst =
   let aux = Tuple.fst
   in  independent aux aux

{-# INLINE snd #-}
snd ::
   (Arrow arrow) =>
   ArrowD.T (amp0,amp1) amp1
     (arrow (y0,y1) y1)
snd =
   let aux = Tuple.snd
   in  independent aux aux

{-# INLINE swap #-}
swap ::
   (Arrow arrow) =>
   ArrowD.T (amp0,amp1) (amp1,amp0)
     (arrow (y0,y1) (y1,y0))
swap =
   let aux = TupleHT.swap
   in  independent aux aux

{-# INLINE balanceRight #-}
balanceRight ::
   (Arrow arrow) =>
   ArrowD.T ((amp0,amp1), amp2) (amp0, (amp1,amp2))
     (arrow ((y0,y1), y2) (y0, (y1,y2)))
balanceRight =
   let aux = \((a,b), c) -> (a, (b,c))
   in  independent aux aux

{-# INLINE balanceLeft #-}
balanceLeft ::
   (Arrow arrow) =>
   ArrowD.T (amp0, (amp1,amp2)) ((amp0,amp1), amp2)
     (arrow (y0, (y1,y2)) ((y0,y1), y2))
balanceLeft =
   let aux = \(a, (b,c)) -> ((a,b), c)
   in  independent aux aux

{-# INLINE packTriple #-}
packTriple ::
   (Arrow arrow) =>
   ArrowD.T (amp0,(amp1,amp2)) (amp0,amp1,amp2)
     (arrow (y0,(y1,y2)) (y0,y1,y2))
packTriple =
   let aux = \(a,(b,c)) -> (a,b,c)
   in  independent aux aux

{-# INLINE unpackTriple #-}
unpackTriple ::
   (Arrow arrow) =>
   ArrowD.T (amp0,amp1,amp2) (amp0,(amp1,amp2))
     (arrow (y0,y1,y2) (y0,(y1,y2)))
unpackTriple =
   let aux = \(a,b,c) -> (a,(b,c))
   in  independent aux aux