Types.hs

-- | Internal. Just use "Vivid.SynthDef"

{-# OPTIONS_HADDOCK show-extensions #-}
-- {-# LANGUAGE DeriveGeneric #-}

{-# LANGUAGE
     DataKinds
   , KindSignatures
   , OverloadedStrings
   , TypeFamilies, NoMonoLocalBinds
   #-}
-- {-# LANGUAGE GADTs, NoMonoLocalBinds #-}

{-# LANGUAGE NoIncoherentInstances #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE NoUndecidableInstances #-}

-- TODO: rename so 
module Vivid.SynthDef.Types (
     Signal(..)
   , SynthDef(..)
   , SDName(..)
   , SDBody'
   , zoomSDBody
   , zoomSynthDef
   , UGen(..)
   , UGenName(..)
   , module Vivid.SynthDef.TypesafeArgs
   ) where

import Vivid.SC.SynthDef.Types (CalculationRate(..), UnaryOp(..), BinaryOp(..))
import Vivid.SynthDef.TypesafeArgs -- (VarSet(..), Subset, Parameter)

import Control.Monad.State (State, get, runState, put)
import Data.ByteString (ByteString)
-- import Data.Hashable
import Data.Int (Int32)
-- import qualified Data.Map as Map
import Data.Map (Map)
-- import Data.Monoid
import GHC.TypeLits
import Prelude

data Signal
   = Constant Float
   | Param ByteString
   | UGOut Int Int32  -- the name of the ugen, and its output #
  deriving (Show, Eq)

-- instance Hashable Signal

-- | Internal representation of Synth Definitions. Usually, use 'Vivid.SynthDef.sd' instead of
--   making these by hand.
-- 
--   This representation (especially '_sdUGens') might change in the future.
data SynthDef (args :: [Symbol]) = SynthDef {
    _sdName :: SDName
   ,_sdParams :: [(ByteString, Float)]
   ,_sdUGens :: Map Int UGen
   -- ignoring variants
   }
 deriving (Show, Eq)

data SDName
   = SDName_Named ByteString
   | SDName_Hash
 deriving (Show, Eq, Read, Ord)

-- instance Hashable SDName

-- | Representation of Unit Generators. You usually won't be creating these
--   by hand, but instead using things from the library in 'Vivid.UGens'
data UGen
   = UGen {
    _ugenName :: UGenName
   ,_ugenCalculationRate :: CalculationRate
   ,_ugenIns :: [Signal]
   -- The calculation rates of each of the outputs are always the same as the
   -- ugen's calculation rate, so we don't need to represent them:
   ,_ugenNumOuts :: Int
   }
  deriving (Show, Eq)

-- instance Hashable UGen

data UGenName
   = UGName_S ByteString
   | UGName_U UnaryOp
   | UGName_B BinaryOp
 deriving (Show, Eq)

-- instance Hashable UGenName

-- | State monad to construct SynthDefs
-- 
--   The SynthDef is an under-construction synth definition
--   The [Int] is the id supply. Its type definitely could change in the future
type SDBody' (args :: [Symbol])
   = State ([Int], SynthDef args, VarSet args)

zoomSynthDef :: (Subset a b) => SynthDef a -> SynthDef b
zoomSynthDef (SynthDef a b c) = SynthDef a b c

-- | Given
-- 
--   > good0 :: SDBody '["2"] ()
--   > good0 = return ()
-- 
--   > good1 :: SDBody '["3","1","3","1"] ()
--   > good1 = return ()
-- 
--   > bad0 :: SDBody '["bwahaha"] ()
--   > bad0 = return ()
-- 
--   > outer :: SDBody '[ "1", "2", "3"]()
--   > outer = do
--   >    zoomSDBody good0 -- works
--   >    zoomSDBody good1 -- works
--   >    -- zoomSDBody bad0 -- doesn't work - great!
zoomSDBody :: (Subset inner outer) => SDBody' inner a -> SDBody' outer a
zoomSDBody x = do
   (initA,initB,_) <- get
   -- We call this "cheat" cause it actually goes from outer
   -- to inner -- it's only safe cause we already restricted
   -- the input to this outer function ('zoomSDBody'):
   let cheatSD :: SynthDef a -> SynthDef b
       cheatSD (SynthDef a b c) = SynthDef a b c
   let (val,(a,b,_)) = runState x (initA, cheatSD initB,VarSet)
   put (a, zoomSynthDef b, VarSet)
   return val