{-# Language ScopedTypeVariables #-}
-- | Converts to low-level instruments
module Csound.Typed.Control.Instr(
    Arity(..), InsExp, EffExp,
    funArity, constArity,
    insExp, effExp, masterExp, midiExp, unitExp,
    apInstr, apInstr0
) where

import Data.Proxy
import Csound.Dynamic(InstrId(..))
import qualified Csound.Typed.GlobalState.Elements as C

import Csound.Typed.Types
import Csound.Typed.GlobalState

funArity :: forall a b. (Tuple a, Tuple b) => (a -> SE b) -> Arity
funArity :: forall a b. (Tuple a, Tuple b) => (a -> SE b) -> Arity
funArity a -> SE b
_instr = Int -> Int -> Arity
Arity (Proxy a -> Int
forall a. Tuple a => Proxy a -> Int
tupleArity (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)) (Proxy b -> Int
forall a. Tuple a => Proxy a -> Int
tupleArity (Proxy b
forall {k} (t :: k). Proxy t
Proxy :: Proxy b))

constArity :: (Tuple a) => SE a -> Arity
constArity :: forall a. Tuple a => SE a -> Arity
constArity SE a
a = Int -> Int -> Arity
Arity Int
0 (SE a -> Int
forall a. Tuple a => SE a -> Int
outArity SE a
a)

insExp :: (Arg a, Tuple b) => (a -> SE b) -> InsExp
insExp :: forall a b. (Arg a, Tuple b) => (a -> SE b) -> InsExp
insExp a -> SE b
instr = SE (GE [E]) -> InsExp
forall a. SE (GE a) -> SE a
execGEinSE (SE (GE [E]) -> InsExp) -> SE (GE [E]) -> InsExp
forall a b. (a -> b) -> a -> b
$ (b -> GE [E]) -> SE b -> SE (GE [E])
forall a b. (a -> b) -> SE a -> SE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> GE [E]
forall a. Tuple a => a -> GE [E]
fromTuple (SE b -> SE (GE [E])) -> SE b -> SE (GE [E])
forall a b. (a -> b) -> a -> b
$ a -> SE b
instr a
forall a. Arg a => a
toArg

effExp :: (Tuple a, Tuple b) => (a -> SE b) -> EffExp
effExp :: forall a b. (Tuple a, Tuple b) => (a -> SE b) -> EffExp
effExp a -> SE b
instr = SE (GE [E]) -> InsExp
forall a. SE (GE a) -> SE a
execGEinSE (SE (GE [E]) -> InsExp) -> ([E] -> SE (GE [E])) -> EffExp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> GE [E]) -> SE b -> SE (GE [E])
forall a b. (a -> b) -> SE a -> SE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> GE [E]
forall a. Tuple a => a -> GE [E]
fromTuple (SE b -> SE (GE [E])) -> ([E] -> SE b) -> [E] -> SE (GE [E])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> SE b
instr (a -> SE b) -> ([E] -> a) -> [E] -> SE b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GE [E] -> a
forall a. Tuple a => GE [E] -> a
toTuple (GE [E] -> a) -> ([E] -> GE [E]) -> [E] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [E] -> GE [E]
forall a. a -> GE a
forall (m :: * -> *) a. Monad m => a -> m a
return

masterExp :: (Tuple a) => SE a -> InsExp
masterExp :: forall a. Tuple a => SE a -> InsExp
masterExp = SE (GE [E]) -> InsExp
forall a. SE (GE a) -> SE a
execGEinSE (SE (GE [E]) -> InsExp) -> (SE a -> SE (GE [E])) -> SE a -> InsExp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> GE [E]) -> SE a -> SE (GE [E])
forall a b. (a -> b) -> SE a -> SE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> GE [E]
forall a. Tuple a => a -> GE [E]
fromTuple

midiExp :: (Tuple a) => (Msg -> SE a) -> InsExp
midiExp :: forall a. Tuple a => (Msg -> SE a) -> InsExp
midiExp Msg -> SE a
instr = SE (GE [E]) -> InsExp
forall a. SE (GE a) -> SE a
execGEinSE (SE (GE [E]) -> InsExp) -> SE (GE [E]) -> InsExp
forall a b. (a -> b) -> a -> b
$ (a -> GE [E]) -> SE a -> SE (GE [E])
forall a b. (a -> b) -> SE a -> SE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> GE [E]
forall a. Tuple a => a -> GE [E]
fromTuple (SE a -> SE (GE [E])) -> SE a -> SE (GE [E])
forall a b. (a -> b) -> a -> b
$ Msg -> SE a
instr Msg
Msg

unitExp :: SE Unit -> UnitExp
unitExp :: SE Unit -> UnitExp
unitExp = SE (GE ()) -> UnitExp
forall a. SE (GE a) -> SE a
execGEinSE (SE (GE ()) -> UnitExp)
-> (SE Unit -> SE (GE ())) -> SE Unit -> UnitExp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Unit -> GE ()) -> SE Unit -> SE (GE ())
forall a b. (a -> b) -> SE a -> SE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Unit -> GE ()
unUnit

apInstr :: forall a b. (Arg a, Sigs b) => GE InstrId -> a -> b
apInstr :: forall a b. (Arg a, Sigs b) => GE InstrId -> a -> b
apInstr GE InstrId
instrIdGE a
args =
  GE [E] -> b
forall a. Tuple a => GE [E] -> a
toTuple (GE [E] -> b) -> GE [E] -> b
forall a b. (a -> b) -> a -> b
$ do
    InstrId
instrId <- GE InstrId
instrIdGE
    [E]
argList <- a -> GE [E]
forall a. Tuple a => a -> GE [E]
fromTuple a
args
    [E] -> GE [E]
forall a. a -> GE a
forall (m :: * -> *) a. Monad m => a -> m a
return ([E] -> GE [E]) -> [E] -> GE [E]
forall a b. (a -> b) -> a -> b
$ Int -> InstrId -> [E] -> [E]
C.subinstr (Proxy b -> Int
forall a. Tuple a => Proxy a -> Int
tupleArity (Proxy b
forall {k} (t :: k). Proxy t
Proxy :: Proxy b)) InstrId
instrId [E]
argList

apInstr0 :: (Sigs b) => GE InstrId -> b
apInstr0 :: forall b. Sigs b => GE InstrId -> b
apInstr0 GE InstrId
instrId = GE InstrId -> Unit -> b
forall a b. (Arg a, Sigs b) => GE InstrId -> a -> b
apInstr GE InstrId
instrId Unit
unit