Phase.hs

module Synthesizer.Basic.Phase
   (T,
    fromRepresentative,
    toRepresentative,
    increment,
    multiply,
   ) where

import qualified Algebra.RealField             as RealField
import qualified Algebra.Ring                  as Ring
import qualified Algebra.Additive              as Additive

import qualified Algebra.ToInteger             as ToInteger

import System.Random (Random(..))
import Test.QuickCheck (Arbitrary(..), choose)

import qualified Synthesizer.Generic.SampledValue as Sample
import Foreign.Storable (Storable(..), )
import Foreign.Ptr (castPtr, )

import Synthesizer.Utility (mapFst)
import qualified NumericPrelude as NP


newtype T a = Cons {decons :: a}


instance Show a => Show (T a) where
   showsPrec p x =
      showParen (p >= 10)
         (showString "Phase.fromRepresentative " . showsPrec 11 (toRepresentative x))

instance Storable a => Storable (T a) where
   {-# INLINE sizeOf #-}
   sizeOf = sizeOf . toRepresentative
   {-# INLINE alignment #-}
   alignment = alignment . toRepresentative
   {-# INLINE peek #-}
   peek ptr = fmap Cons $ peek (castPtr ptr)
   {-# INLINE poke #-}
   poke ptr = poke (castPtr ptr) . toRepresentative

instance Sample.C a => Sample.C (T a) -- where


instance (Ring.C a, Random a) => Random (T a) where
   randomR = error "Phase.randomR makes no sense"
   random = mapFst Cons . randomR (NP.zero, NP.one)

instance (Ring.C a, Random a) => Arbitrary (T a) where
   arbitrary = fmap Cons $ choose (NP.zero, NP.one)
   coarbitrary = error "Phase.coarbitrary not implemented"



{-# INLINE fromRepresentative #-}
fromRepresentative :: RealField.C a => a -> T a
fromRepresentative = Cons . RealField.fraction

{-# INLINE toRepresentative #-}
toRepresentative :: T a -> a
toRepresentative = decons

{-# INLINE increment #-}
increment :: RealField.C a => a -> T a -> T a
increment d x = fromRepresentative (toRepresentative x Additive.+ d)

{-# INLINE multiply #-}
multiply :: (RealField.C a, ToInteger.C b) => b -> T a -> T a
multiply n x = fromRepresentative (toRepresentative x Ring.* NP.fromIntegral n)


instance RealField.C a => Additive.C (T a) where
   {-# INLINE zero #-}
   {-# INLINE (+) #-}
   {-# INLINE (-) #-}
   {-# INLINE negate #-}
   zero = Cons Additive.zero
   x + y = fromRepresentative (toRepresentative x Additive.+ toRepresentative y)
   x - y = fromRepresentative (toRepresentative x Additive.- toRepresentative y)
   negate = fromRepresentative . Additive.negate . toRepresentative