{- |
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.Sample as Sample

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 Control.Arrow (Arrow, )
import Control.Category (Category, )

import qualified Synthesizer.Generic.Signal as SigG

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 = ArrowD.T (->)

type Single amp0 amp1 yv0 yv1 =
        ArrowD.Single (->) amp0 amp1 yv0 yv1


consFlip ::
   (Sample.Amplitude sample0 ->
    (Sample.Amplitude sample1,
     Sample.Displacement sample0 ->
     Sample.Displacement sample1)) ->
   T sample0 sample1
consFlip :: forall sample0 sample1.
(Amplitude sample0
 -> (Amplitude sample1,
     Displacement sample0 -> Displacement sample1))
-> T sample0 sample1
consFlip Amplitude sample0
-> (Amplitude sample1,
    Displacement sample0 -> Displacement sample1)
f =
   forall (arrow :: * -> * -> *) sample0 sample1.
(Amplitude sample0
 -> (arrow (Displacement sample0) (Displacement sample1),
     Amplitude sample1))
-> T arrow sample0 sample1
ArrowD.Cons forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> (b, a)
TupleHT.swap forall b c a. (b -> c) -> (a -> b) -> a -> c
. Amplitude sample0
-> (Amplitude sample1,
    Displacement sample0 -> Displacement sample1)
f


{-# INLINE apply #-}
apply ::
   (SigG.Transform sig yv0, SigG.Transform sig yv1) =>
   Single amp0 amp1 yv0 yv1 ->
   SigA.T rate amp0 (sig yv0) ->
   SigA.T rate amp1 (sig yv1)
apply :: forall (sig :: * -> *) yv0 yv1 amp0 amp1 rate.
(Transform sig yv0, Transform sig yv1) =>
Single amp0 amp1 yv0 yv1
-> T rate amp0 (sig yv0) -> T rate amp1 (sig yv1)
apply = forall (sig :: * -> *) sample0 sample1 (arrow :: * -> * -> *) rate.
(Transform sig (Displacement sample0),
 Transform sig (Displacement sample1), Applicable arrow rate) =>
T arrow sample0 sample1
-> T rate (Amplitude sample0) (sig (Displacement sample0))
-> T rate (Amplitude sample1) (sig (Displacement sample1))
ArrowD.apply

{-# INLINE applyFlat #-}
applyFlat ::
   (Flat.C yv0 amp0,
    SigG.Transform sig yv0, SigG.Transform sig yv1) =>
   Single (Amp.Flat yv0) amp1 yv0 yv1 ->
   SigA.T rate amp0 (sig yv0) ->
   SigA.T rate amp1 (sig yv1)
applyFlat :: forall yv0 amp0 (sig :: * -> *) yv1 amp1 rate.
(C yv0 amp0, Transform sig yv0, Transform sig yv1) =>
Single (Flat yv0) amp1 yv0 yv1
-> T rate amp0 (sig yv0) -> T rate amp1 (sig yv1)
applyFlat = forall yv0 amp0 (sig :: * -> *) yv1 (arrow :: * -> * -> *) rate
       amp1.
(C yv0 amp0, Transform sig yv0, Transform sig yv1,
 Applicable arrow rate) =>
Single arrow (Flat yv0) amp1 yv0 yv1
-> T rate amp0 (sig yv0) -> T rate amp1 (sig yv1)
ArrowD.applyFlat


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

{-# INLINE forcePrimitiveAmplitude #-}
forcePrimitiveAmplitude ::
   (Amp.Primitive amp, Arrow arrow) =>
   ArrowD.Single arrow amp amp yv yv
forcePrimitiveAmplitude :: forall amp (arrow :: * -> * -> *) yv.
(Primitive amp, Arrow arrow) =>
Single arrow amp amp yv yv
forcePrimitiveAmplitude =
   forall (arrow :: * -> * -> *) sample0 sample1.
Arrow arrow =>
(Amplitude sample0 -> Amplitude sample1)
-> (Displacement sample0 -> Displacement sample1)
-> T arrow sample0 sample1
independent (forall a b. a -> b -> a
const forall amp. Primitive amp => amp
Amp.primitive) forall a. a -> a
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:
This function however still breaks the abstraction,
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 also breaks the abstraction.
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.Single arrow amp0 amp1 yv yv
mapAmplitude :: forall amp0 amp1 (arrow :: * -> * -> *) yv.
(C amp0, C amp1, Arrow arrow) =>
(amp0 -> amp1) -> Single arrow amp0 amp1 yv yv
mapAmplitude amp0 -> amp1
f =
   forall (arrow :: * -> * -> *) sample0 sample1.
Arrow arrow =>
(Amplitude sample0 -> Amplitude sample1)
-> (Displacement sample0 -> Displacement sample1)
-> T arrow sample0 sample1
independent amp0 -> amp1
f forall a. a -> a
Func.id

{- |
FIXME: This function is unsafe.
Only use it for proportional mappings.
See 'SigA.T'.
-}
{-# INLINE mapAmplitudeSameType #-}
mapAmplitudeSameType ::
   (Arrow arrow) =>
   (Sample.Amplitude sample -> Sample.Amplitude sample) ->
   ArrowD.T arrow sample sample
mapAmplitudeSameType :: forall (arrow :: * -> * -> *) sample.
Arrow arrow =>
(Amplitude sample -> Amplitude sample) -> T arrow sample sample
mapAmplitudeSameType Amplitude sample -> Amplitude sample
f =
   forall (arrow :: * -> * -> *) sample0 sample1.
Arrow arrow =>
(Amplitude sample0 -> Amplitude sample1)
-> (Displacement sample0 -> Displacement sample1)
-> T arrow sample0 sample1
independent Amplitude sample -> Amplitude sample
f forall a. a -> a
Func.id


{- |
This function can be abused to bring the amplitudes out of order.
So be careful!
-}
{-# INLINE independent #-}
independent ::
   (Arrow arrow) =>
   (Sample.Amplitude sample0 -> Sample.Amplitude sample1) ->
   (Sample.Displacement sample0 -> Sample.Displacement sample1) ->
   ArrowD.T arrow sample0 sample1
independent :: forall (arrow :: * -> * -> *) sample0 sample1.
Arrow arrow =>
(Amplitude sample0 -> Amplitude sample1)
-> (Displacement sample0 -> Displacement sample1)
-> T arrow sample0 sample1
independent =
   forall (arrow :: * -> * -> *) sample0 sample1.
Arrow arrow =>
(Amplitude sample0 -> Amplitude sample1)
-> (Displacement sample0 -> Displacement sample1)
-> T arrow sample0 sample1
ArrowD.independentMap

{-# INLINE id #-}
id ::
   (Category arrow) =>
   ArrowD.T arrow sample sample
id :: forall (arrow :: * -> * -> *) sample.
Category arrow =>
T arrow sample sample
id = forall (arrow :: * -> * -> *) sample.
Category arrow =>
T arrow sample sample
ArrowD.id

{-# INLINE double #-}
double ::
   (Arrow arrow) =>
   ArrowD.T arrow sample (sample, sample)
double :: forall (arrow :: * -> * -> *) sample.
Arrow arrow =>
T arrow sample (sample, sample)
double =
   forall (arrow :: * -> * -> *) sample.
Arrow arrow =>
T arrow sample (sample, sample)
ArrowD.double

{-# INLINE fst #-}
fst ::
   (Arrow arrow) =>
   ArrowD.T arrow (sample0,sample1) sample0
fst :: forall (arrow :: * -> * -> *) sample0 sample1.
Arrow arrow =>
T arrow (sample0, sample1) sample0
fst =
   let aux :: (a, b) -> a
aux = forall a b. (a, b) -> a
Tuple.fst
   in  forall (arrow :: * -> * -> *) sample0 sample1.
Arrow arrow =>
(Amplitude sample0 -> Amplitude sample1)
-> (Displacement sample0 -> Displacement sample1)
-> T arrow sample0 sample1
independent forall a b. (a, b) -> a
aux forall a b. (a, b) -> a
aux

{-# INLINE snd #-}
snd ::
   (Arrow arrow) =>
   ArrowD.T arrow (sample0,sample1) sample1
snd :: forall (arrow :: * -> * -> *) sample0 sample1.
Arrow arrow =>
T arrow (sample0, sample1) sample1
snd =
   let aux :: (a, b) -> b
aux = forall a b. (a, b) -> b
Tuple.snd
   in  forall (arrow :: * -> * -> *) sample0 sample1.
Arrow arrow =>
(Amplitude sample0 -> Amplitude sample1)
-> (Displacement sample0 -> Displacement sample1)
-> T arrow sample0 sample1
independent forall a b. (a, b) -> b
aux forall a b. (a, b) -> b
aux

{-# INLINE swap #-}
swap ::
   (Arrow arrow) =>
   ArrowD.T arrow (sample0,sample1) (sample1,sample0)
swap :: forall (arrow :: * -> * -> *) sample0 sample1.
Arrow arrow =>
T arrow (sample0, sample1) (sample1, sample0)
swap =
   let aux :: (a, b) -> (b, a)
aux = forall a b. (a, b) -> (b, a)
TupleHT.swap
   in  forall (arrow :: * -> * -> *) sample0 sample1.
Arrow arrow =>
(Amplitude sample0 -> Amplitude sample1)
-> (Displacement sample0 -> Displacement sample1)
-> T arrow sample0 sample1
independent forall a b. (a, b) -> (b, a)
aux forall a b. (a, b) -> (b, a)
aux

{-# INLINE balanceRight #-}
balanceRight ::
   (Arrow arrow) =>
   ArrowD.T arrow
      ((sample0,sample1), sample2) (sample0, (sample1,sample2))
balanceRight :: forall (arrow :: * -> * -> *) sample0 sample1 sample2.
Arrow arrow =>
T arrow ((sample0, sample1), sample2) (sample0, (sample1, sample2))
balanceRight =
   let aux :: ((a, a), b) -> (a, (a, b))
aux = \((a
a,a
b), b
c) -> (a
a, (a
b,b
c))
   in  forall (arrow :: * -> * -> *) sample0 sample1.
Arrow arrow =>
(Amplitude sample0 -> Amplitude sample1)
-> (Displacement sample0 -> Displacement sample1)
-> T arrow sample0 sample1
independent forall {a} {a} {b}. ((a, a), b) -> (a, (a, b))
aux forall {a} {a} {b}. ((a, a), b) -> (a, (a, b))
aux

{-# INLINE balanceLeft #-}
balanceLeft ::
   (Arrow arrow) =>
   ArrowD.T arrow
      (sample0, (sample1,sample2)) ((sample0,sample1), sample2)
balanceLeft :: forall (arrow :: * -> * -> *) sample0 sample1 sample2.
Arrow arrow =>
T arrow (sample0, (sample1, sample2)) ((sample0, sample1), sample2)
balanceLeft =
   let aux :: (a, (b, b)) -> ((a, b), b)
aux = \(a
a, (b
b,b
c)) -> ((a
a,b
b), b
c)
   in  forall (arrow :: * -> * -> *) sample0 sample1.
Arrow arrow =>
(Amplitude sample0 -> Amplitude sample1)
-> (Displacement sample0 -> Displacement sample1)
-> T arrow sample0 sample1
independent forall {a} {b} {b}. (a, (b, b)) -> ((a, b), b)
aux forall {a} {b} {b}. (a, (b, b)) -> ((a, b), b)
aux

{-# INLINE packTriple #-}
packTriple ::
   (Arrow arrow) =>
   ArrowD.T arrow
      (sample0,(sample1,sample2)) (sample0,sample1,sample2)
packTriple :: forall (arrow :: * -> * -> *) sample0 sample1 sample2.
Arrow arrow =>
T arrow (sample0, (sample1, sample2)) (sample0, sample1, sample2)
packTriple =
   let aux :: (a, (b, c)) -> (a, b, c)
aux = \(a
a,(b
b,c
c)) -> (a
a,b
b,c
c)
   in  forall (arrow :: * -> * -> *) sample0 sample1.
Arrow arrow =>
(Amplitude sample0 -> Amplitude sample1)
-> (Displacement sample0 -> Displacement sample1)
-> T arrow sample0 sample1
independent forall {a} {b} {c}. (a, (b, c)) -> (a, b, c)
aux forall {a} {b} {c}. (a, (b, c)) -> (a, b, c)
aux

{-# INLINE unpackTriple #-}
unpackTriple ::
   (Arrow arrow) =>
   ArrowD.T arrow
      (sample0,sample1,sample2) (sample0,(sample1,sample2))
unpackTriple :: forall (arrow :: * -> * -> *) sample0 sample1 sample2.
Arrow arrow =>
T arrow (sample0, sample1, sample2) (sample0, (sample1, sample2))
unpackTriple =
   let aux :: (a, a, b) -> (a, (a, b))
aux = \(a
a,a
b,b
c) -> (a
a,(a
b,b
c))
   in  forall (arrow :: * -> * -> *) sample0 sample1.
Arrow arrow =>
(Amplitude sample0 -> Amplitude sample1)
-> (Displacement sample0 -> Displacement sample1)
-> T arrow sample0 sample1
independent forall {a} {a} {b}. (a, a, b) -> (a, (a, b))
aux forall {a} {a} {b}. (a, a, b) -> (a, (a, b))
aux