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

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

  This module equips a list of values
  with a sampling rate and an amplitude.
  Since sampling rate and amplitude need not to be of the same type
  and need not to be of the type of the values
  one can choose physical quantities for sampling rate and amplitude
  but low level types like Double and Float for the values.
  The only thing we need is the conversion to scalar types
  provided by the 'Algebra.OccasionallyScalar.C' type class.
  This conversion may fail in which case we encountered a unit error.
  We can also use this module with plain number types.
  Then toScalar cannot fail.

  The conversion to scalars is very general
  and might support applications I can currently not imagine.
-}

module Synthesizer.Physical.Signal where

import qualified Synthesizer.SampleRateContext.Signal as SigC
import qualified Synthesizer.SampleRateContext.Rate   as Rate

import qualified Algebra.OccasionallyScalar as OccScalar
import qualified Algebra.VectorSpace as VectorSpace
import qualified Algebra.Module      as Module
import qualified Algebra.Field       as Field
import qualified Algebra.Ring        as Ring

import Algebra.OccasionallyScalar(toScalar)
import Algebra.Module((*>))

import Data.Tuple.HT (mapSnd, )
import Synthesizer.Utility (common, )

import PreludeBase
import NumericPrelude

{-| t and y are plain number types,
    t' and y' may be physical quantities.
    yv may be a vector type.
    It should hold:
      @(OccScalar.C t t',
        OccScalar.C y y',
        Module.C y yv)@
    There are no values of type t and type y in T
    but they are essential to computation of intermediate results.
-}
data T t t' y y' yv =
   Cons {
        fullSampleRate :: Rate.T t t'
           {-^ how many values per unit are stored -}
      , content :: SigC.T y y' yv
           {-^ the signal with a unit-equipped volume -}
     }
   deriving (Eq, Show)

{- | Construct a signal. -}
cons ::
      t'    {- ^ sampling rate, must be positive (unchecked) -}
   -> y'    {- ^ amplitude, must be positive (unchecked) -}
   -> [yv]  {- ^ samples, values should be between -1 and 1 (unchecked) -}
   -> T t t' y y' yv
cons sr amp ss =
   Cons (Rate.fromNumber sr) (SigC.Cons amp ss)

sampleRate :: T t t' y y' yv -> t'
sampleRate = Rate.toNumber . fullSampleRate

amplitude :: T t t' y y' yv -> y'
amplitude = SigC.amplitude . content

samples :: T t t' y y' yv -> [yv]
samples = SigC.samples . content

{- |
Replace sample rate and amplitude
with different representations of their values.
This is needed for internal purposes,
especially for preserving the phantom types.
Do not use it for arbitrary changes of sample rate or amplitude!
-}
replaceParameters :: t1' -> y1' -> T t t0' y y0' yv -> T t t1' y y1' yv
replaceParameters sr amp (Cons _ (SigC.Cons _ ss))  =  cons sr amp ss

replaceSampleRate :: t1' -> T t t0' y y' yv -> T t t1' y y' yv
replaceSampleRate sr (Cons _ sig)  =  Cons (Rate.fromNumber sr) sig

replaceAmplitude :: y1' -> T t t' y y0' yv -> T t t' y y1' yv
replaceAmplitude amp (Cons sr sig)  =
   Cons sr (SigC.replaceAmplitude amp sig)

replaceSamples :: [yv1] -> T t t' y y' yv0 -> T t t' y y' yv1
replaceSamples ss (Cons sr sig)  =
   Cons sr (SigC.replaceSamples ss sig)


{- |
Assert a condition before shipping the first sample.
-}
assert :: String -> Bool -> T t t' y y' yv -> T t t' y y' yv
assert msg cond x =
   replaceSamples (if cond then samples x else error msg) x

{- |
Assert that the amplitude of the signal matches the given one.
Otherwise give an error when the first sample is fetched.
-}
assertAmplitude :: Eq y' => y' -> T t t' y y' yv -> T t t' y y' yv
assertAmplitude amp x =
   replaceSamples
      (if amp == amplitude x
         then samples x
         else error "assertAmplitude: amplitudes differ") x

{- |
Assert that the sample rate of the signal matches the given one.
-}
assertSampleRate :: Eq t' => t' -> T t t' y y' yv -> T t t' y y' yv
assertSampleRate sr0 (Cons sr sig) =
   Cons sr $
   if sr0 == Rate.toNumber sr
     then sig
     else error "assertSampleRate: sample rates differ"

{- | Fix the type of a value to the scalar time type of a signal. -}
asTypeOfTime ::
      t     {- ^ time value, of with a type to be fixed -}
   -> T t t' y y' yv
            {- ^ signal, whose time type shall be matched -}
   -> t     {- ^ the time value, again -}
asTypeOfTime = const

{- | Fix the type of a value to the scalar amplitude type of a signal. -}
asTypeOfAmplitude :: y -> T t t' y y' yv -> y
asTypeOfAmplitude = const

{- | Express a time value as a multiple of the sampling period.
     The multiplicity is returned.
     It is a checked error,
     if the units of time value and sampling period mismatch. -}
toTimeScalar :: (Ring.C t', OccScalar.C t t') =>
   T t t' y y' yv -> t' -> t
toTimeScalar x t =
   toScalar (t * sampleRate x) `asTypeOfTime` x

{- | Express a frequency value as a multiple of the sampling frequency.
     The multiplicity is returned.
     In many applications the multiplicity is below 1.
     It is a checked error,
     if the units of frequency value and sampling frequency mismatch. -}
toFrequencyScalar :: (Field.C t', OccScalar.C t t') =>
   T t t' y y' yv -> t' -> t
toFrequencyScalar x f =
   toScalar (f / sampleRate x) `asTypeOfTime` x

{- | Express an amplitude value as a multiple of the signal amplitude.
     The multiplicity is returned.
     It is a checked error,
     if the units of amplitude value and signal amplitude mismatch. -}
toAmplitudeScalar :: (Field.C y', OccScalar.C y y') =>
   T t t' y y' yv -> y' -> y
toAmplitudeScalar x y =
   toScalar (y / amplitude x) `asTypeOfAmplitude` x

{-| If all signals share the same sampleRate, then return it,
    otherwise raise an error. -}
commonSampleRate :: (Eq t') =>
   T t t' y0 y'0 yv0 -> T t t' y1 y'1 yv1 -> t'
commonSampleRate x y =
   commonSampleRate' (sampleRate x) (sampleRate y)
   -- "The sample rates "++show sr0++" and "++show sr1++" differ."

commonSampleRate' :: (Eq a) => a -> a -> a
commonSampleRate' x y =
   common "The sample rates differ." x y

{- | Extract data for further processing that is not aware of physical units,
     such as playing and creating files. -}
pureData :: (Field.C t', OccScalar.C t t',
             Field.C y', OccScalar.C y y',
             VectorSpace.C y yv) =>
      t'  {- ^ The unit of the sampling frequency, say 'Number.SI.hertz' -}
   -> y'  {- ^ The maximum expected value.
               The data is normalized to this value,
               in order to preserve that all output samples
               are at most 1 in magnitude. -}
   -> T t t' y y' yv
          {- ^ The input signal. -}
   -> (t, [yv])
          {- ^ The sampling frequency without unit and
               the list of normalized samples.
               This information should suffice for playback
               or writing the signal to a file. -}
pureData freqUnit amp sig =
   (toTimeScalar sig (recip freqUnit),
    recip (toAmplitudeScalar sig amp) *> samples sig)


instance Functor (T t t' y y') where
   fmap f (Cons sr sig) = Cons sr (fmap f sig)



{- * Conversion from and to signals with sample rate context -}


runPlain ::
   t' -> (Rate.T t t' -> SigC.T y y' yv) -> T t t' y y' yv
runPlain sr f =
   addPlainSampleRate sr (f (Rate.fromNumber sr))

addPlainSampleRate ::
   t' -> SigC.T y y' yv -> T t t' y y' yv
addPlainSampleRate sr = Cons (Rate.fromNumber sr)

run ::
   Rate.T t t' -> (Rate.T t t' -> SigC.T y y' yv) -> T t t' y y' yv
run sr f =
   addSampleRate sr (f sr)

addSampleRate ::
   Rate.T t t' -> SigC.T y y' yv -> T t t' y y' yv
addSampleRate = Cons

splitSampleRate ::
   T t t' y y' yv -> (Rate.T t t', SigC.T y y' yv)
splitSampleRate (Cons sr sig) = (sr, sig)

{- |
If the given sample rate matches the one of the signal,
then return the core signal, otherwise 'undefined'.
-}
checkSampleRate :: (Eq t') =>
   String ->
   Rate.T t t' ->
   T t t' y y' yv -> SigC.T y y' yv
checkSampleRate funcName sr0 (Cons sr sig) =
   if sr0 == sr
     then sig
     else error ("checkSampleRate for " ++ funcName ++ ": sample rates differ")

splitSampleRateList :: (Eq t') =>
   [T t t' y y' yv] -> (Rate.T t t', [SigC.T y y' yv])
splitSampleRateList [] = error "splitSampleRateList: empty list"
splitSampleRateList xt@(x:_) =
   let sr = fst (splitSampleRate x)
   in  (sr, map (checkSampleRate "splitSampleRateList" sr) xt)


apply ::
   (Rate.T t t' -> SigC.T y0 y'0 y0v -> SigC.T y1 y'1 y1v)
    -> T t t' y0 y'0 y0v
    -> T t t' y1 y'1 y1v
apply f (Cons sr sig) =
   run sr (flip f sig)


{-
commonSampleRate :: (Eq t') =>
   T t t' y0 y'0 yv0 -> T t t' y1 y'1 yv1 -> Rate.T t t'
commonSampleRate x0 x1 = Rate.fromNumber (SigP.commonSampleRate x0 x1)
-}


lift0 ::
      (Rate.T t t' -> SigC.T y y' yv)
   -> t' -> T t t' y y' yv
lift0 = flip runPlain

lift1 ::
      (Rate.T t t' -> SigC.T y0 y0' yv0 -> SigC.T y1 y1' yv1)
   -> (T t t' y0 y0' yv0 -> T t t' y1 y1' yv1)
lift1 = apply

lift2 :: (Eq t') =>
      (Rate.T t t' -> SigC.T y0 y'0 yv0 -> SigC.T y1 y'1 yv1 -> SigC.T y2 y'2 yv2)
   -> (T t t' y0 y'0 yv0 -> T t t' y1 y'1 yv1 -> T t t' y2 y'2 yv2)
lift2 f x0 x1 =
   let (_, y0) = splitSampleRate x0
       (_, y1) = splitSampleRate x1
   in  runPlain (commonSampleRate x0 x1) (\sr -> f sr y0 y1)
{-
   let (sr0, y0) = splitSampleRate x0
       (sr1, y1) = splitSampleRate x1
       sr = SigP.commonSampleRate' sr0 sr1
   in  addSampleRate sr (f sr y0 y1)
-}

lift3 :: (Eq t') =>
      (Rate.T t t' -> SigC.T y0 y'0 yv0 -> SigC.T y1 y'1 yv1 -> SigC.T y2 y'2 yv2 -> SigC.T y3 y'3 yv3)
   -> (T t t' y0 y'0 yv0 -> T t t' y1 y'1 yv1 -> T t t' y2 y'2 yv2 -> T t t' y3 y'3 yv3)
lift3 f x0 x1 x2 =
   let (sr0, y0) = splitSampleRate x0
       (sr1, y1) = splitSampleRate x1
       (sr2, y2) = splitSampleRate x2
   in  run
          (sr0 `commonSampleRate'` sr1 `commonSampleRate'` sr2)
          (\sr -> f sr y0 y1 y2)


liftList :: Eq t' =>
      (Rate.T t t' -> [SigC.T y1 y'1 yv1] -> SigC.T y y' yv)
   -> ([T t t' y1 y'1 yv1] -> T t t' y y' yv)
liftList f =
   uncurry run .
   mapSnd (flip f) .
   splitSampleRateList



liftR2 ::
      (Rate.T t t' -> SigC.T y y' yv -> (SigC.T y0 y'0 yv0, SigC.T y1 y'1 yv1))
   -> T t t' y y' yv
   -> (T t t' y0 y'0 yv0, T t t' y1 y'1 yv1)
liftR2 f x0 =
   let (sr,x1) = splitSampleRate x0
       (y0,y1) = f sr x1
   in  (addSampleRate sr y0, addSampleRate sr y1)

liftR3 ::
      (Rate.T t t' -> SigC.T y y' yv -> (SigC.T y0 y'0 yv0, SigC.T y1 y'1 yv1, SigC.T y2 y'2 yv2))
   -> T t t' y y' yv
   -> (T t t' y0 y'0 yv0, T t t' y1 y'1 yv1, T t t' y2 y'2 yv2)
liftR3 f x0 =
   let (sr,x1) = splitSampleRate x0
       (y0,y1,y2) = f sr x1
   in  (addSampleRate sr y0, addSampleRate sr y1, addSampleRate sr y2)