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

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

Signals equipped with a sample rate information that carry a physical dimension.
-}
module Synthesizer.Dimensional.RateWrapper 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.Dimensional.Amplitude.Signal as SigA
import qualified Synthesizer.Dimensional.Process as Proc
import qualified Synthesizer.Dimensional.Rate as Rate
-- import qualified Synthesizer.State.Signal as Sig

import Synthesizer.Dimensional.Process (($:), ($#), )

-- import qualified Synthesizer.State.Filter.NonRecursive as Filt

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

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

{-
import qualified Algebra.Module         as Module
import qualified Algebra.Field          as Field
import qualified Algebra.Ring           as Ring
-}

-- import NumericPrelude
import PreludeBase
import Prelude ()


data T u t sig y =
   Cons {
        sampleRate :: DN.T (Dim.Recip u) t
                                 {-^ number of samples per unit -}
      , signal     :: sig y      {-^ the embedded signal -}
     }
--   deriving (Eq, Show)

instance Functor sig => Functor (T u t sig) where
   fmap f = processSignal (fmap f)

instance (Dim.C u, Show t, Format.C sig) => Format.C (T u t sig) where
   format p (Cons rate sig) =
      showParen (p >= 10)
         (showString "rateWrapper " . showsPrec 11 rate .
          showString " " . Format.format 11 sig)

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


{-# INLINE fromProcess #-}
fromProcess :: (Dim.C u) =>
   Proc.T s u t (RP.T s sig yv -> T u t sig yv)
fromProcess =
   fmap
      (\rate -> Cons rate . RP.toSignal)
      Proc.getSampleRate


{- |
Render a signal generated by a signal processor
at the given sample rate,
and leave the sample rate context.
If you want to render multiple signals,
then convert them with 'fromProcess'
and move them out of the sample rate context
all at once using 'Proc.run'.
-}
{-# INLINE runProcess #-}
runProcess :: (Dim.C u) =>
   DN.T (Dim.Recip u) t ->
   (forall s. Proc.T s u t (RP.T s sig yv)) ->
   T u t sig yv
runProcess rate p =
   Proc.run rate (fromProcess $: p)


{-# INLINE runProcessOn #-}
runProcessOn :: (Dim.C u) =>
   (forall s. Proc.T s u t (RP.T s sig0 yv0 -> RP.T s sig1 yv1)) ->
   T u t sig0 yv0 -> T u t sig1 yv1
runProcessOn p x =
   runProcess
      (sampleRate x)
      (p $# RP.fromSignal (signal x))


{-# INLINE toProcess #-}
toProcess :: (Dim.C u) =>
   (T u t sig yv -> a) ->
   Proc.T s u t (RP.T s sig yv -> a)
toProcess f =
   fmap (f.) fromProcess

{-
infixl 0 $%

Apply a process that depends on (at least) two physical signals.
It is checked dynamically whether the sample rates of both signals are equal.
If the sample rates differ, this is an runtime error.
For more than one physical signal as input you can apply this operator repeatedly.
Try to avoid it due to the dynamic check.

($%) ::
   Proc.T s u t (SigA.R s v0 y0 yv0 -> SigA.R s v1 y1 yv1 -> a) ->
   T u t v0 y0 yv0 ->
   Proc.T s u t (SigA.R s v1 y1 yv1 -> a)
($%)
-}


{- |
internal function
-}

{-# INLINE fromSignal #-}
fromSignal :: (Dim.C u) =>
   Rate.T s u t -> RP.T s sig yv -> T u t sig yv
fromSignal rate x =
   Cons (Rate.toDimensionNumber rate) (RP.toSignal x)

{-# INLINE toSignal #-}
toSignal :: (Dim.C u) =>
   T u t sig yv -> (Rate.T s u t, RP.T s sig yv)
toSignal x =
   (Rate.fromDimensionNumber (sampleRate x),
    RP.fromSignal (signal x))


{-
rewriteDimension :: (Dim.C v0, Dim.C v1) =>
   (v0 -> v1) -> T u t v0 y yv -> T u t v1 y yv
rewriteDimension f (Cons amp ss) =
   Cons (DN.rewriteDimension f amp) ss


toScalarSignal :: (Field.C y, Dim.C v) =>
   DN.T v y -> T u t y y -> RP.T s sig y
toScalarSignal amp  =  SigS.cons . scalarSamples (flip DN.divToScalar amp)

toVectorSignal :: (Field.C y, Module.C y yv, Dim.C v) =>
   DN.T v y -> T u t y yv -> RP.T s sig yv
toVectorSignal amp  =  SigS.cons . vectorSamples (flip DN.divToScalar amp)


cons :: DN.T v y -> Sig.T yv -> T u t y yv
cons  =  Cons

consScalar :: DN.T v y -> Sig.T y -> T u t y y
consScalar  =  cons

consVector :: DN.T v y -> Sig.T yv -> T u t y yv
consVector  =  cons

replaceAmplitude :: DN.T v1 y -> T u t v0 y yv -> T u t v1 y yv
replaceAmplitude amp (Cons _ ss)  =  Cons amp ss

replaceSamples :: Sig.T yv1 -> T u t y yv0 -> T u t y yv1
replaceSamples ss (Cons amp _)  =  Cons amp ss


processSamples :: (Dim.C v) =>
   (Sig.T yv0 -> Sig.T yv1) -> T u t y yv0 -> T u t y yv1
processSamples f x =
   replaceSamples (f $ samples x) x


asTypeOfAmplitude :: y -> T u t y yv -> y
asTypeOfAmplitude = const
-}

{-# INLINE processSignal #-}
processSignal ::
   (sig0 yv0 -> sig1 yv1) -> T u t sig0 yv0 -> T u t sig1 yv1
processSignal f x =
   Cons (sampleRate x) (f $ signal x)


instance (Dim.C u) => Ind.C (T u t) where
   toSignal = signal
   processSignal = processSignal