{-# OPTIONS_HADDOCK show-extensions #-}
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}

{-# LANGUAGE

     CPP

   , FlexibleInstances

   , DataKinds
   , InstanceSigs
   , KindSignatures
   , MultiParamTypeClasses
   , TypeFamilies, NoMonoLocalBinds
   , TypeSynonymInstances
   , UndecidableInstances

   , NoMonomorphismRestriction
   #-}

module Vivid.SynthDef.ToSig (
     ToSig(..)
   ) where

import Vivid.SC.Server.Types (BufferId(..))
import Vivid.SynthDef.Types

import qualified Data.ByteString.UTF8 as UTF8
import Data.Int (Int8, Int16, Int32, Int64)
import Data.Word (Word8, Word16, Word32, Word64)
-- import Data.Proxy
import GHC.TypeLits
import Numeric.Natural (Natural)

class ToSig s (args :: [Symbol]) where
   toSig :: s -> SDBody' args Signal

instance ToSig Signal args where
   toSig :: Signal -> SDBody' args Signal
   toSig :: Signal -> SDBody' args Signal
toSig = Signal -> SDBody' args Signal
forall (f :: * -> *) a. Applicative f => a -> f a
pure

instance (KnownSymbol a, Subset '[a] args) => ToSig (Variable a) args where
   toSig :: Variable a -> SDBody' args Signal
toSig Variable a
a = (Signal -> SDBody' args Signal
forall (m :: * -> *) a. Monad m => a -> m a
return (Signal -> SDBody' args Signal)
-> (Variable a -> Signal) -> Variable a -> SDBody' args Signal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Signal
Param (ByteString -> Signal)
-> (Variable a -> ByteString) -> Variable a -> Signal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
UTF8.fromString (String -> ByteString)
-> (Variable a -> String) -> Variable a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Variable a -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal) Variable a
a

#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 801

realSig :: (Real n, Applicative f) => n -> f Signal
realSig :: n -> f Signal
realSig = Signal -> f Signal
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Signal -> f Signal) -> (n -> Signal) -> n -> f Signal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Signal
Constant (Float -> Signal) -> (n -> Float) -> n -> Signal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac

instance ToSig Double       args where toSig :: Double -> SDBody' args Signal
toSig = Double -> SDBody' args Signal
forall n (f :: * -> *). (Real n, Applicative f) => n -> f Signal
realSig
instance ToSig Float        args where toSig :: Float -> SDBody' args Signal
toSig = Float -> SDBody' args Signal
forall n (f :: * -> *). (Real n, Applicative f) => n -> f Signal
realSig

instance ToSig Rational     args where toSig :: Rational -> SDBody' args Signal
toSig = Rational -> SDBody' args Signal
forall n (f :: * -> *). (Real n, Applicative f) => n -> f Signal
realSig

instance ToSig Integer      args where toSig :: Integer -> SDBody' args Signal
toSig = Integer -> SDBody' args Signal
forall n (f :: * -> *). (Real n, Applicative f) => n -> f Signal
realSig
instance ToSig Natural      args where toSig :: Natural -> SDBody' args Signal
toSig = Natural -> SDBody' args Signal
forall n (f :: * -> *). (Real n, Applicative f) => n -> f Signal
realSig

instance ToSig Int          args where toSig :: Int -> SDBody' args Signal
toSig = Int -> SDBody' args Signal
forall n (f :: * -> *). (Real n, Applicative f) => n -> f Signal
realSig
instance ToSig Int8         args where toSig :: Int8 -> SDBody' args Signal
toSig = Int8 -> SDBody' args Signal
forall n (f :: * -> *). (Real n, Applicative f) => n -> f Signal
realSig
instance ToSig Int16        args where toSig :: Int16 -> SDBody' args Signal
toSig = Int16 -> SDBody' args Signal
forall n (f :: * -> *). (Real n, Applicative f) => n -> f Signal
realSig
instance ToSig Int32        args where toSig :: Int32 -> SDBody' args Signal
toSig = Int32 -> SDBody' args Signal
forall n (f :: * -> *). (Real n, Applicative f) => n -> f Signal
realSig
instance ToSig Int64        args where toSig :: Int64 -> SDBody' args Signal
toSig = Int64 -> SDBody' args Signal
forall n (f :: * -> *). (Real n, Applicative f) => n -> f Signal
realSig

instance ToSig Word         args where toSig :: Word -> SDBody' args Signal
toSig = Word -> SDBody' args Signal
forall n (f :: * -> *). (Real n, Applicative f) => n -> f Signal
realSig
instance ToSig Word8        args where toSig :: Word8 -> SDBody' args Signal
toSig = Word8 -> SDBody' args Signal
forall n (f :: * -> *). (Real n, Applicative f) => n -> f Signal
realSig
instance ToSig Word16       args where toSig :: Word16 -> SDBody' args Signal
toSig = Word16 -> SDBody' args Signal
forall n (f :: * -> *). (Real n, Applicative f) => n -> f Signal
realSig
instance ToSig Word32       args where toSig :: Word32 -> SDBody' args Signal
toSig = Word32 -> SDBody' args Signal
forall n (f :: * -> *). (Real n, Applicative f) => n -> f Signal
realSig
instance ToSig Word64       args where toSig :: Word64 -> SDBody' args Signal
toSig = Word64 -> SDBody' args Signal
forall n (f :: * -> *). (Real n, Applicative f) => n -> f Signal
realSig

#else


-- Incoherent is to get numbers defaulting to Floats in a useful way in
-- SynthDefs. The type resolution algorithm should rarely (discovery: not
-- never!) give weird behavior as long as other instances aren't defined:

-- | For 'Constant' (Float) values
instance {-# INCOHERENT #-} (Num n, Real n) => ToSig n args where
   toSig :: n -> SDBody' args Signal
   toSig = return . Constant . realToFrac

#endif

-- This way instead of e.g.
-- > BufferId b <- makeBuffer 1
-- > playBuf (buf_ $ toEnum $ fromEnum b
--
-- we can say:
-- > b <- makeBuffer 1
-- > playBuf (buf_ b
-- instance ToSomeSig BufferId where
instance ToSig BufferId args where
   toSig :: BufferId -> SDBody' args Signal
   toSig :: BufferId -> SDBody' args Signal
toSig (BufferId Int32
n) = (Signal -> SDBody' args Signal
forall (m :: * -> *) a. Monad m => a -> m a
return (Signal -> SDBody' args Signal)
-> (Int32 -> Signal) -> Int32 -> SDBody' args Signal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Signal
Constant (Float -> Signal) -> (Int32 -> Float) -> Int32 -> Signal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac) Int32
n

instance (a ~ args) => ToSig (SDBody' a Signal) args where
   toSig :: SDBody' args Signal -> SDBody' args Signal
   toSig :: SDBody' args Signal -> SDBody' args Signal
toSig SDBody' args Signal
x = SDBody' args Signal
x