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

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

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

funProxy :: (a -> f b) -> (a, b)
funProxy :: (a -> f b) -> (a, b)
funProxy = (a, b) -> (a -> f b) -> (a, b)
forall a b. a -> b -> a
const (a
forall a. a
msg, b
forall a. a
msg)
    where msg :: a
msg = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"I'm a Csound.Typed.Control.Instr.funProxy"

funArity :: (Tuple a, Tuple b) => (a -> SE b) -> Arity
funArity :: (a -> SE b) -> Arity
funArity a -> SE b
instr = Int -> Int -> Arity
Arity (a -> Int
forall a. Tuple a => a -> Int
tupleArity a
a) (b -> Int
forall a. Tuple a => a -> Int
tupleArity b
b)
    where (a
a, b
b) = (a -> SE b) -> (a, b)
forall a (f :: * -> *) b. (a -> f b) -> (a, b)
funProxy a -> SE b
instr

constArity :: (Tuple a) => SE a -> Arity
constArity :: 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 :: (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 (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 :: (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 (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 (m :: * -> *) a. Monad m => a -> m a
return

masterExp :: (Tuple a) => SE a -> InsExp
masterExp :: 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 (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 :: (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 (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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Unit -> GE ()
unUnit

apInstr :: (Arg a, Sigs b) => GE InstrId -> a -> b
apInstr :: GE InstrId -> a -> b
apInstr GE InstrId
instrIdGE a
args = b
res
    where
        res :: b
res = 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 (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 (b -> Int
forall a. Tuple a => a -> Int
tupleArity b
res) InstrId
instrId [E]
argList

apInstr0 :: (Sigs b) => GE InstrId -> b
apInstr0 :: 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