{-# LANGUAGE
     DataKinds
   , KindSignatures
   #-}

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

module Vivid.SCServer.Types (

   -- Types
     Synth(..)

   -- Functions
   , shrinkSynthArgs

   -- Classes
   , IsNode(..)
   , SynthOrNodeId
   , IsGroup
   ) where

import GHC.TypeLits
import Vivid.SC.Server.Types
import Vivid.SynthDef.TypesafeArgs


-- | This enforces type safety of the arguments -- e.g. if you have a synthdef
-- 
--   >> let x = sd (3 ::I "foo") bar
--   >> s <- synth x ()
-- 
--   Then this won't typecheck (because "bar" isn't an argument to x):
-- 
--   >> set s (4 ::I "bar")
-- 
--   Note that if you don't want this type safety, you can e.g.
-- 
--   >> Synth n <- synth foo ()
--   >> setG n (0.1 ::I "vol")
-- 
--   Or:
-- 
--   >> ns <- mapM (flip synth ()) [foo, bar, baz]
--   >> map (setG (0::I "asdf") . unSynth) ns
-- 
--   Or:
-- 
--   >> n <- synthG foo ()
-- 
--   (You also may want to look at 'shrinkSynthArgs' if you want to construct a list
--   which has synthdefs or nodes of different types)
newtype Synth (args :: [Symbol]) = Synth { Synth args -> NodeId
_unSynth :: NodeId }
 deriving (Int -> Synth args -> ShowS
[Synth args] -> ShowS
Synth args -> String
(Int -> Synth args -> ShowS)
-> (Synth args -> String)
-> ([Synth args] -> ShowS)
-> Show (Synth args)
forall (args :: [Symbol]). Int -> Synth args -> ShowS
forall (args :: [Symbol]). [Synth args] -> ShowS
forall (args :: [Symbol]). Synth args -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Synth args] -> ShowS
$cshowList :: forall (args :: [Symbol]). [Synth args] -> ShowS
show :: Synth args -> String
$cshow :: forall (args :: [Symbol]). Synth args -> String
showsPrec :: Int -> Synth args -> ShowS
$cshowsPrec :: forall (args :: [Symbol]). Int -> Synth args -> ShowS
Show, ReadPrec [Synth args]
ReadPrec (Synth args)
Int -> ReadS (Synth args)
ReadS [Synth args]
(Int -> ReadS (Synth args))
-> ReadS [Synth args]
-> ReadPrec (Synth args)
-> ReadPrec [Synth args]
-> Read (Synth args)
forall (args :: [Symbol]). ReadPrec [Synth args]
forall (args :: [Symbol]). ReadPrec (Synth args)
forall (args :: [Symbol]). Int -> ReadS (Synth args)
forall (args :: [Symbol]). ReadS [Synth args]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Synth args]
$creadListPrec :: forall (args :: [Symbol]). ReadPrec [Synth args]
readPrec :: ReadPrec (Synth args)
$creadPrec :: forall (args :: [Symbol]). ReadPrec (Synth args)
readList :: ReadS [Synth args]
$creadList :: forall (args :: [Symbol]). ReadS [Synth args]
readsPrec :: Int -> ReadS (Synth args)
$creadsPrec :: forall (args :: [Symbol]). Int -> ReadS (Synth args)
Read, Synth args -> Synth args -> Bool
(Synth args -> Synth args -> Bool)
-> (Synth args -> Synth args -> Bool) -> Eq (Synth args)
forall (args :: [Symbol]). Synth args -> Synth args -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Synth args -> Synth args -> Bool
$c/= :: forall (args :: [Symbol]). Synth args -> Synth args -> Bool
== :: Synth args -> Synth args -> Bool
$c== :: forall (args :: [Symbol]). Synth args -> Synth args -> Bool
Eq, Eq (Synth args)
Eq (Synth args)
-> (Synth args -> Synth args -> Ordering)
-> (Synth args -> Synth args -> Bool)
-> (Synth args -> Synth args -> Bool)
-> (Synth args -> Synth args -> Bool)
-> (Synth args -> Synth args -> Bool)
-> (Synth args -> Synth args -> Synth args)
-> (Synth args -> Synth args -> Synth args)
-> Ord (Synth args)
Synth args -> Synth args -> Bool
Synth args -> Synth args -> Ordering
Synth args -> Synth args -> Synth args
forall (args :: [Symbol]). Eq (Synth args)
forall (args :: [Symbol]). Synth args -> Synth args -> Bool
forall (args :: [Symbol]). Synth args -> Synth args -> Ordering
forall (args :: [Symbol]). Synth args -> Synth args -> Synth args
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 :: Synth args -> Synth args -> Synth args
$cmin :: forall (args :: [Symbol]). Synth args -> Synth args -> Synth args
max :: Synth args -> Synth args -> Synth args
$cmax :: forall (args :: [Symbol]). Synth args -> Synth args -> Synth args
>= :: Synth args -> Synth args -> Bool
$c>= :: forall (args :: [Symbol]). Synth args -> Synth args -> Bool
> :: Synth args -> Synth args -> Bool
$c> :: forall (args :: [Symbol]). Synth args -> Synth args -> Bool
<= :: Synth args -> Synth args -> Bool
$c<= :: forall (args :: [Symbol]). Synth args -> Synth args -> Bool
< :: Synth args -> Synth args -> Bool
$c< :: forall (args :: [Symbol]). Synth args -> Synth args -> Bool
compare :: Synth args -> Synth args -> Ordering
$ccompare :: forall (args :: [Symbol]). Synth args -> Synth args -> Ordering
$cp1Ord :: forall (args :: [Symbol]). Eq (Synth args)
Ord)

-- | So let's say you have a node:
-- 
--   > foo :: Synth '["amp", "freq", "phase"]
-- 
--   and you want to add it to a list of nodes:
-- 
--   > ns :: [Synth '["freq", "phase"]]
-- 
--   If you don't plan on setting the \"amp\" argument, you can \"shrink\" to
--   the compatible arguments:
-- 
--   > ns' = shrinkSynthArgs foo : ns
-- 
--   (The same thing exists for SynthDefs -- 'Vivid.SynthDef.shrinkSDArgs')
shrinkSynthArgs :: (Subset new old) => Synth old -> Synth new
shrinkSynthArgs :: Synth old -> Synth new
shrinkSynthArgs (Synth NodeId
nId) = NodeId -> Synth new
forall (args :: [Symbol]). NodeId -> Synth args
Synth NodeId
nId

class IsNode a where getNodeId :: a -> NodeId

instance IsNode NodeId where getNodeId :: NodeId -> NodeId
getNodeId NodeId
n = NodeId
n
instance IsNode (Synth a) where getNodeId :: Synth a -> NodeId
getNodeId (Synth NodeId
n) = NodeId
n
instance IsNode Group where getNodeId :: Group -> NodeId
getNodeId (Group NodeId
n) = NodeId
n
instance IsNode ParGroup where getNodeId :: ParGroup -> NodeId
getNodeId (ParGroup NodeId
n) = NodeId
n

-- | For gradually-typed 'free'
class IsNode a => SynthOrNodeId a
instance SynthOrNodeId (Synth x)
instance SynthOrNodeId NodeId

-- | 'Group' and 'ParGroup'
class IsNode g => IsGroup g
instance IsGroup Group
instance IsGroup ParGroup