{- |
Copyright   :  (c) Henning Thielemann 2008
License     :  GPL

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

Signals equipped with a volume information that may carry a unit.
Is the approach with separated volume information still appropriate?
Actually it simplifies reusing code from "Synthesizer.State.Signal"
because we do not have to replace @(*)@ by @(&*&)@.
-}
module Synthesizer.Dimensional.Amplitude.Signal where

import qualified Synthesizer.Format as Format
import qualified Synthesizer.Dimensional.Abstraction.RateIndependent as Ind

import qualified Synthesizer.Dimensional.RatePhantom as RP
import qualified Synthesizer.Dimensional.Straight.Signal as SigS

import qualified Synthesizer.State.Filter.NonRecursive as Filt
import qualified Synthesizer.State.Signal as Sig

import qualified Synthesizer.Generic.Filter.NonRecursive as FiltG
import qualified Synthesizer.Generic.Signal as SigG
import qualified Synthesizer.Generic.SampledValue as Sample

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 Algebra.Ring           as Ring

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


import NumericPrelude
import PreludeBase as P
import Prelude ()


data T v y sig yv =
   Cons {
        privateAmplitude :: DN.T v y   {-^ scaling of the values -}
      , signal           :: sig yv     {-^ the embedded signal -}
     }
--   deriving (Eq, Show)

instance (Dim.C v, Show y, Format.C sig) => Format.C (T v y sig) where
   format p (Cons amp sig) =
      showParen (p >= 10)
         (showString "amplitudeSignal " . showsPrec 11 amp .
          showString " " . Format.format 11 sig)

instance (Dim.C v, Show y, Show yv, Format.C sig) => Show (T v y sig yv) where
   showsPrec = Format.format

type R s v y yv = RP.T s (S v y) yv
type S v y = T v y (SigS.T Sig.T)  -- kind * -> *

{-
We removed that instance because 'fmap' is too dangerous for application code.
You may write functions that depend on the particular amplitude scaling.

instance Dim.C v => Functor (T v y s) where
   fmap f (Cons amp ss) = Cons amp (map f ss)
-}

{-# INLINE amplitude #-}
amplitude :: (Ind.C w, Dim.C v) =>
   w (T v y sig) yv -> DN.T v y
amplitude = privateAmplitude . Ind.toSignal

{-# INLINE samples #-}
samples :: (Ind.C w, Dim.C v) =>
   w (T v y (SigS.T sig)) yv -> sig yv
samples = privateSamples . Ind.toSignal

{-# INLINE privateSamples #-}
privateSamples :: (Dim.C v) =>
   T v y (SigS.T sig) yv -> sig yv
privateSamples = SigS.samples . signal

{-# INLINE phantomSignal #-}
phantomSignal ::
   RP.T s (T v y sig) yv -> RP.T s sig yv
phantomSignal =
   RP.fromSignal . signal . RP.toSignal


{-# INLINE toAmplitudeScalar #-}
toAmplitudeScalar :: (Ind.C w, Field.C y, Dim.C v) =>
   w (T v y sig) yv -> DN.T v y -> y
toAmplitudeScalar sig y =
   DN.divToScalar y (amplitude sig)

{-# INLINE scalarSamples #-}
scalarSamples :: (Ind.C w, Ring.C y, Dim.C v) =>
   (DN.T v y -> y) -> w (S v y) y -> Sig.T y
scalarSamples toAmpScalar =
   scalarSamplesPrivate toAmpScalar . Ind.toSignal

{-# INLINE scalarSamplesGeneric #-}
scalarSamplesGeneric ::
   (Ind.C w, Ring.C y, Dim.C v, Sample.C y, SigG.C sig) =>
   (DN.T v y -> y) -> w (T v y (SigS.T sig)) y -> sig y
scalarSamplesGeneric toAmpScalar =
   scalarSamplesPrivateGeneric toAmpScalar . Ind.toSignal

{-# INLINE vectorSamples #-}
vectorSamples :: (Ind.C w, Module.C y yv, Dim.C v) =>
   (DN.T v y -> y) -> w (S v y) yv -> Sig.T yv
vectorSamples toAmpScalar =
   vectorSamplesPrivate toAmpScalar . Ind.toSignal


{-# INLINE rewriteDimension #-}
rewriteDimension :: (Dim.C v0, Dim.C v1) =>
   (v0 -> v1) -> T v0 y sig yv -> T v1 y sig yv
rewriteDimension f (Cons amp ss) =
   Cons (DN.rewriteDimension f amp) ss


{-# INLINE fromSignal #-}
fromSignal :: DN.T v y -> SigS.R s yv -> R s v y yv
fromSignal amp  =  RP.fromSignal . Cons amp . RP.toSignal


{-# INLINE toScalarSignal #-}
toScalarSignal :: (Ind.C w, Field.C y, Dim.C v) =>
   DN.T v y -> w (S v y) y -> w (SigS.T Sig.T) y
toScalarSignal amp  =
   Ind.processSignal
      (SigS.Cons . scalarSamplesPrivate (flip DN.divToScalar amp))

{-# INLINE toVectorSignal #-}
toVectorSignal :: (Ind.C w, Field.C y, Module.C y yv, Dim.C v) =>
   DN.T v y -> w (S v y) yv -> w (SigS.T Sig.T) yv
toVectorSignal amp  =
   Ind.processSignal
      (SigS.Cons . vectorSamplesPrivate (flip DN.divToScalar amp))


{-# INLINE scalarSamplesPrivate #-}
scalarSamplesPrivate :: (Ring.C y, Dim.C v) =>
   (DN.T v y -> y) -> S v y y -> Sig.T y
scalarSamplesPrivate toAmpScalar sig =
   let y = toAmpScalar (privateAmplitude sig)
   in  Filt.amplify y (privateSamples sig)

{-# INLINE scalarSamplesPrivateGeneric #-}
scalarSamplesPrivateGeneric ::
   (Ring.C y, Dim.C v, Sample.C y, SigG.C sig) =>
   (DN.T v y -> y) -> T v y (SigS.T sig) y -> sig y
scalarSamplesPrivateGeneric toAmpScalar sig =
   let y = toAmpScalar (privateAmplitude sig)
   in  FiltG.amplify y (privateSamples sig)

{-# INLINE vectorSamplesPrivate #-}
vectorSamplesPrivate :: (Module.C y yv, Dim.C v) =>
   (DN.T v y -> y) -> S v y yv -> Sig.T yv
vectorSamplesPrivate toAmpScalar sig =
   let y = toAmpScalar (privateAmplitude sig)
   in  y *> privateSamples sig


{-# INLINE fromSamples #-}
fromSamples :: DN.T v y -> Sig.T yv -> R s v y yv
fromSamples amp  =  fromSignal amp . SigS.fromSamples

{-# INLINE fromScalarSamples #-}
fromScalarSamples :: DN.T v y -> Sig.T y -> R s v y y
fromScalarSamples  =  fromSamples

{-# INLINE fromVectorSamples #-}
fromVectorSamples :: DN.T v y -> Sig.T yv -> R s v y yv
fromVectorSamples  =  fromSamples

{-# INLINE replaceAmplitude #-}
replaceAmplitude :: (Ind.C w, Dim.C v0, Dim.C v1) =>
   DN.T v1 y -> w (T v0 y sig) yv -> w (T v1 y sig) yv
replaceAmplitude amp  =  Ind.processSignal (replaceAmplitudePrivate amp)

{-# INLINE replaceSamples #-}
replaceSamples :: (Ind.C w, Dim.C v) =>
   sig1 yv1 -> w (T v y sig0) yv0 -> w (T v y (SigS.T sig1)) yv1
replaceSamples ss  =  Ind.processSignal (replaceSamplesPrivate ss)

{-# INLINE replaceAmplitudePrivate #-}
replaceAmplitudePrivate :: (Dim.C v0, Dim.C v1) =>
   DN.T v1 y -> T v0 y sig yv -> T v1 y sig yv
replaceAmplitudePrivate amp  =  Cons amp . signal

{-# INLINE replaceSamplesPrivate #-}
replaceSamplesPrivate :: (Dim.C v) =>
   sig1 yv1 -> T v y sig0 yv0 -> T v y (SigS.T sig1) yv1
replaceSamplesPrivate ss x  =  Cons (privateAmplitude x) (SigS.Cons ss)


{-# INLINE processSamples #-}
processSamples :: (Ind.C w, Dim.C v) =>
   (sig0 yv0 -> sig1 yv1) ->
   w (T v y (SigS.T sig0)) yv0 -> w (T v y (SigS.T sig1)) yv1
processSamples f =
   Ind.processSignal (processSamplesPrivate f)

{-# INLINE processSamplesPrivate #-}
processSamplesPrivate :: (Dim.C v) =>
   (sig0 yv0 -> sig1 yv1) ->
   T v y (SigS.T sig0) yv0 -> T v y (SigS.T sig1) yv1
processSamplesPrivate f (Cons amp sig) =
   Cons amp (SigS.processSamplesPrivate f sig)


{-# INLINE asTypeOfAmplitude #-}
asTypeOfAmplitude :: y -> w (T v y sig) yv -> y
asTypeOfAmplitude = const