-- | 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 (Int -> Signal -> ShowS
[Signal] -> ShowS
Signal -> String
(Int -> Signal -> ShowS)
-> (Signal -> String) -> ([Signal] -> ShowS) -> Show Signal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Signal] -> ShowS
$cshowList :: [Signal] -> ShowS
show :: Signal -> String
$cshow :: Signal -> String
showsPrec :: Int -> Signal -> ShowS
$cshowsPrec :: Int -> Signal -> ShowS
Show, Signal -> Signal -> Bool
(Signal -> Signal -> Bool)
-> (Signal -> Signal -> Bool) -> Eq Signal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Signal -> Signal -> Bool
$c/= :: Signal -> Signal -> Bool
== :: Signal -> Signal -> Bool
$c== :: Signal -> Signal -> Bool
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 {
    SynthDef args -> SDName
_sdName :: SDName
   ,SynthDef args -> [(ByteString, Float)]
_sdParams :: [(ByteString, Float)]
   ,SynthDef args -> Map Int UGen
_sdUGens :: Map Int UGen
   -- ignoring variants
   }
 deriving (Int -> SynthDef args -> ShowS
[SynthDef args] -> ShowS
SynthDef args -> String
(Int -> SynthDef args -> ShowS)
-> (SynthDef args -> String)
-> ([SynthDef args] -> ShowS)
-> Show (SynthDef args)
forall (args :: [Symbol]). Int -> SynthDef args -> ShowS
forall (args :: [Symbol]). [SynthDef args] -> ShowS
forall (args :: [Symbol]). SynthDef args -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SynthDef args] -> ShowS
$cshowList :: forall (args :: [Symbol]). [SynthDef args] -> ShowS
show :: SynthDef args -> String
$cshow :: forall (args :: [Symbol]). SynthDef args -> String
showsPrec :: Int -> SynthDef args -> ShowS
$cshowsPrec :: forall (args :: [Symbol]). Int -> SynthDef args -> ShowS
Show)

data SDName
   = SDName_Named ByteString
   | SDName_Hash
 deriving (Int -> SDName -> ShowS
[SDName] -> ShowS
SDName -> String
(Int -> SDName -> ShowS)
-> (SDName -> String) -> ([SDName] -> ShowS) -> Show SDName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SDName] -> ShowS
$cshowList :: [SDName] -> ShowS
show :: SDName -> String
$cshow :: SDName -> String
showsPrec :: Int -> SDName -> ShowS
$cshowsPrec :: Int -> SDName -> ShowS
Show, SDName -> SDName -> Bool
(SDName -> SDName -> Bool)
-> (SDName -> SDName -> Bool) -> Eq SDName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SDName -> SDName -> Bool
$c/= :: SDName -> SDName -> Bool
== :: SDName -> SDName -> Bool
$c== :: SDName -> SDName -> Bool
Eq, ReadPrec [SDName]
ReadPrec SDName
Int -> ReadS SDName
ReadS [SDName]
(Int -> ReadS SDName)
-> ReadS [SDName]
-> ReadPrec SDName
-> ReadPrec [SDName]
-> Read SDName
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SDName]
$creadListPrec :: ReadPrec [SDName]
readPrec :: ReadPrec SDName
$creadPrec :: ReadPrec SDName
readList :: ReadS [SDName]
$creadList :: ReadS [SDName]
readsPrec :: Int -> ReadS SDName
$creadsPrec :: Int -> ReadS SDName
Read, Eq SDName
Eq SDName
-> (SDName -> SDName -> Ordering)
-> (SDName -> SDName -> Bool)
-> (SDName -> SDName -> Bool)
-> (SDName -> SDName -> Bool)
-> (SDName -> SDName -> Bool)
-> (SDName -> SDName -> SDName)
-> (SDName -> SDName -> SDName)
-> Ord SDName
SDName -> SDName -> Bool
SDName -> SDName -> Ordering
SDName -> SDName -> SDName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SDName -> SDName -> SDName
$cmin :: SDName -> SDName -> SDName
max :: SDName -> SDName -> SDName
$cmax :: SDName -> SDName -> SDName
>= :: SDName -> SDName -> Bool
$c>= :: SDName -> SDName -> Bool
> :: SDName -> SDName -> Bool
$c> :: SDName -> SDName -> Bool
<= :: SDName -> SDName -> Bool
$c<= :: SDName -> SDName -> Bool
< :: SDName -> SDName -> Bool
$c< :: SDName -> SDName -> Bool
compare :: SDName -> SDName -> Ordering
$ccompare :: SDName -> SDName -> Ordering
$cp1Ord :: Eq SDName
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 {
    UGen -> UGenName
_ugenName :: UGenName
   ,UGen -> CalculationRate
_ugenCalculationRate :: CalculationRate
   ,UGen -> [Signal]
_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:
   ,UGen -> Int
_ugenNumOuts :: Int
   }
  deriving (Int -> UGen -> ShowS
[UGen] -> ShowS
UGen -> String
(Int -> UGen -> ShowS)
-> (UGen -> String) -> ([UGen] -> ShowS) -> Show UGen
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UGen] -> ShowS
$cshowList :: [UGen] -> ShowS
show :: UGen -> String
$cshow :: UGen -> String
showsPrec :: Int -> UGen -> ShowS
$cshowsPrec :: Int -> UGen -> ShowS
Show, UGen -> UGen -> Bool
(UGen -> UGen -> Bool) -> (UGen -> UGen -> Bool) -> Eq UGen
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UGen -> UGen -> Bool
$c/= :: UGen -> UGen -> Bool
== :: UGen -> UGen -> Bool
$c== :: UGen -> UGen -> Bool
Eq)

-- instance Hashable UGen

data UGenName
   = UGName_S ByteString
   | UGName_U UnaryOp
   | UGName_B BinaryOp
 deriving (Int -> UGenName -> ShowS
[UGenName] -> ShowS
UGenName -> String
(Int -> UGenName -> ShowS)
-> (UGenName -> String) -> ([UGenName] -> ShowS) -> Show UGenName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UGenName] -> ShowS
$cshowList :: [UGenName] -> ShowS
show :: UGenName -> String
$cshow :: UGenName -> String
showsPrec :: Int -> UGenName -> ShowS
$cshowsPrec :: Int -> UGenName -> ShowS
Show, UGenName -> UGenName -> Bool
(UGenName -> UGenName -> Bool)
-> (UGenName -> UGenName -> Bool) -> Eq UGenName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UGenName -> UGenName -> Bool
$c/= :: UGenName -> UGenName -> Bool
== :: UGenName -> UGenName -> Bool
$c== :: UGenName -> UGenName -> Bool
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 -> SynthDef b
zoomSynthDef (SynthDef SDName
a [(ByteString, Float)]
b Map Int UGen
c) = SDName -> [(ByteString, Float)] -> Map Int UGen -> SynthDef b
forall (args :: [Symbol]).
SDName -> [(ByteString, Float)] -> Map Int UGen -> SynthDef args
SynthDef SDName
a [(ByteString, Float)]
b Map Int UGen
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 :: SDBody' inner a -> SDBody' outer a
zoomSDBody SDBody' inner a
x = do
   ([Int]
initA,SynthDef outer
initB,VarSet outer
_) <- StateT
  ([Int], SynthDef outer, VarSet outer)
  Identity
  ([Int], SynthDef outer, VarSet outer)
forall s (m :: * -> *). MonadState s m => m s
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 -> SynthDef b
cheatSD (SynthDef SDName
a [(ByteString, Float)]
b Map Int UGen
c) = SDName -> [(ByteString, Float)] -> Map Int UGen -> SynthDef b
forall (args :: [Symbol]).
SDName -> [(ByteString, Float)] -> Map Int UGen -> SynthDef args
SynthDef SDName
a [(ByteString, Float)]
b Map Int UGen
c
   let (a
val,([Int]
a,SynthDef inner
b,VarSet inner
_)) = SDBody' inner a
-> ([Int], SynthDef inner, VarSet inner)
-> (a, ([Int], SynthDef inner, VarSet inner))
forall s a. State s a -> s -> (a, s)
runState SDBody' inner a
x ([Int]
initA, SynthDef outer -> SynthDef inner
forall (a :: [Symbol]) (b :: [Symbol]). SynthDef a -> SynthDef b
cheatSD SynthDef outer
initB,VarSet inner
forall (s :: [Symbol]). VarSet s
VarSet)
   ([Int], SynthDef outer, VarSet outer)
-> StateT ([Int], SynthDef outer, VarSet outer) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put ([Int]
a, SynthDef inner -> SynthDef outer
forall (a :: [Symbol]) (b :: [Symbol]).
Subset a b =>
SynthDef a -> SynthDef b
zoomSynthDef SynthDef inner
b, VarSet outer
forall (s :: [Symbol]). VarSet s
VarSet)
   a -> SDBody' outer a
forall (m :: * -> *) a. Monad m => a -> m a
return a
val