{-# LANGUAGE TypeFamilies #-}
module Synthesizer.LLVM.Server.Parameter (
   Tuple(..),
   Frequency(..), Time(..), VectorTime(..), Number(..), Control(..), Signal(..),
   withTuple2,
   ) where

import Synthesizer.LLVM.Server.CommonPacked (vectorSize)
import Synthesizer.LLVM.Server.Common (Param, Real, SampleRate(SampleRate))

import qualified Synthesizer.PiecewiseConstant.Signal as PC
import qualified Synthesizer.LLVM.Parameter as Param

import qualified Synthesizer.Storable.Signal as SigSt

import qualified Control.Category as Cat
import Control.Applicative ((<$>), )

import qualified Data.Tuple.HT as TupleHT

import Prelude hiding (Real, )


class Tuple tuple where
   type Composed tuple :: *
   type Source tuple :: *
   decompose ::
      Param (Source tuple) (SampleRate Real) ->
      Param (Source tuple) (Composed tuple) -> tuple


newtype Number p = Number (Param p Real)

instance Tuple (Number p) where
   type Composed (Number p) = Real
   type Source (Number p) = p
   decompose _sr t = Number t


deconsSampleRate :: Param p (SampleRate a) -> Param p a
deconsSampleRate = fmap (\(SampleRate sr) -> sr)

newtype Time p = Time (Param p Real)

instance Tuple (Time p) where
   type Composed (Time p) = Real
   type Source (Time p) = p
   decompose sr t = Time (t * deconsSampleRate sr)

newtype VectorTime p = VectorTime (Param p Real)

instance Tuple (VectorTime p) where
   type Composed (VectorTime p) = Real
   type Source (VectorTime p) = p
   decompose sr t =
      VectorTime (t * deconsSampleRate sr / fromIntegral vectorSize)

newtype Frequency p = Frequency (Param p Real)

instance Tuple (Frequency p) where
   type Composed (Frequency p) = Real
   type Source (Frequency p) = p
   decompose sr freq = Frequency (freq / deconsSampleRate sr)


newtype Control p = Control (Param p (PC.T Real))

instance Tuple (Control p) where
   type Composed (Control p) = PC.T Real
   type Source (Control p) = p
   decompose _sr x = Control x


newtype Signal p a = Signal (Param p (SigSt.T a))

instance Tuple (Signal p a) where
   type Composed (Signal p a) = SigSt.T a
   type Source (Signal p a) = p
   decompose _sr x = Signal x


instance (Tuple a, Tuple b, Source a ~ Source b) => Tuple (a,b) where
   type Composed (a,b) = (Composed a, Composed b)
   type Source (a,b) = Source a
   decompose sr p = (decompose sr $ fst <$> p, decompose sr $ snd <$> p)

instance
   (Tuple a, Tuple b, Tuple c, Source a ~ Source b, Source b ~ Source c) =>
      Tuple (a,b,c) where
   type Composed (a,b,c) = (Composed a, Composed b, Composed c)
   type Source (a,b,c) = Source a
   decompose sr p =
      (decompose sr $ TupleHT.fst3 <$> p,
       decompose sr $ TupleHT.snd3 <$> p,
       decompose sr $ TupleHT.thd3 <$> p)


withTuple2 ::
   (Tuple tuple, Source tuple ~ p, Composed tuple ~ p) =>
   (tuple -> f (SampleRate Real, p) a b) -> f (SampleRate Real, p) a b
withTuple2 f =
   idFromFunctor2 $ \param -> f $ decompose (fst<$>param) (snd<$>param)

-- cf. Param.idFromFunctor2
idFromFunctor2 :: (Param.T p p -> f p a b) -> f p a b
idFromFunctor2 f = f Cat.id