{- |

Copyright   :  (c) Henning Thielemann 2008
License     :  GPL

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



Light-weight sample parameter inference which will fit most needs.
We only do \"poor man's inference\", only for sample rates.
The sample rate will be provided as an argument of a special type 'T'.
This argument will almost never be passed explicitly
but should be handled by operators analogous to '($)' and '(.)'.

In contrast to the run-time inference approach,
we have the static guarantee that the sample rate is fixed
before passing a signal to the outside world.
However we still need to make it safe that signals
that are rendered for one sample rate
are not processed with another sample rate.
We should wrap @T s u t -> a@ in a @Reader@ monad, but that's not all.
We must investigate a little more here.
Maybe we need another type parameter for the sample rate and the signals
in order to show that they belong together,
like it is done in the ST monad.
-}
module Synthesizer.Dimensional.Rate where

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

import qualified Synthesizer.Utility as Util

{-
import NumericPrelude
import PreludeBase as P
-}


{- |
This wraps a function which computes a sample rate dependent result.
Sample rate tells how many values per unit are stored
for representation of a signal.
-}
newtype T s u t = Cons {decons :: DN.T (Dim.Recip u) t}
   deriving (Eq, Ord, Show)


{-# INLINE fromNumber #-}
fromNumber :: Dim.C u => Dim.Recip u -> t -> T s u t
fromNumber u = Cons . DN.fromNumberWithDimension u

{- |
This function is somehow dangerous
because it drops the 's' parameter.
-}
{-# INLINE toNumber #-}
toNumber :: Dim.C u => Dim.Recip u -> T s u t -> t
toNumber u = DN.toNumberWithDimension u . decons

{-# INLINE fromDimensionNumber #-}
fromDimensionNumber :: Dim.C u => DN.T (Dim.Recip u) t -> T s u t
fromDimensionNumber = Cons

{- |
This function is somehow dangerous
because it drops the 's' parameter.
-}
{-# INLINE toDimensionNumber #-}
toDimensionNumber :: Dim.C u => T s u t -> DN.T (Dim.Recip u) t
toDimensionNumber = decons

{-# INLINE common #-}
common :: Eq t => String -> T s u t -> T s u t -> T s u t
common funcName =
   Util.common ("Sample rates differ in " ++ funcName)