{- |

Copyright   :  (c) Henning Thielemann 2008
License     :  GPL

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


-}
module Synthesizer.Dimensional.RatePhantom where

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

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

{-
import NumericPrelude
import PreludeBase as P
-}


{- |
Wraps a signal and adds a phantom type
that identifies signals of the same sample rate.
We provide the phantom type this way
in order to flexibly replace it by a material sample rate.
-}
newtype T s sig y = Cons {signal :: sig y}
--   deriving (Eq, Ord, Show)

instance Functor sig => Functor (T s sig) where
   fmap f = fromSignal . fmap f . toSignal

instance (Format.C sig) => Format.C (T s sig) where
   format p (Cons sig) =
      showParen (p >= 10)
         (showString "ratePhantom " . Format.format 11 sig)

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


{-# INLINE fromSignal #-}
fromSignal :: sig y -> T s sig y
fromSignal = Cons

{-# INLINE toSignal #-}
toSignal :: T s sig y -> sig y
toSignal = signal

{-# INLINE processSignal #-}
processSignal :: (sig0 y0 -> sig1 y1) -> (T s sig0 y0 -> T s sig1 y1)
processSignal f = fromSignal . f . toSignal


instance Ind.C (T s) where
   toSignal = signal
   processSignal = processSignal