module Csound.Typed.Types(
    -- * Primitives
    module Csound.Typed.Types.Prim,
    module Csound.Typed.Types.Lift,
    -- * Init values
    -- | In Csound we can supply an opcodes with initialization arguments.
    -- They are optional. To imitate this functionality in haskell we
    -- can use these functions.
    withInits, withDs, withSigs, withTabs, withD, withSig, withTab, withSeed,
    -- * Tuples
    module Csound.Typed.Types.Tuple,        
    -- * Events
    module Csound.Typed.Types.Evt,

    -- * Arrays
    module Csound.Typed.Types.Array, 

    -- * Arguments for monophonic synths
    module Csound.Typed.Types.MonoArg,  

    -- * Signal space (generic signal transformers)
    module Csound.Typed.Types.SigSpace,

    -- * Tab helpers
    getNextGlobalGenId
) where

import qualified Csound.Dynamic as D

import Csound.Typed.Types.Prim
import Csound.Typed.Types.Tuple
import Csound.Typed.Types.Evt
import Csound.Typed.Types.Lift
import Csound.Typed.Types.Array
import Csound.Typed.Types.MonoArg
import Csound.Typed.Types.SigSpace

import Csound.Typed.GlobalState(evalSE, SE, geToSe)

import qualified Csound.Typed.GlobalState as G(getNextGlobalGenId)

getNextGlobalGenId :: SE Int
getNextGlobalGenId :: SE Int
getNextGlobalGenId = GE Int -> SE Int
forall a. GE a -> SE a
geToSe GE Int
G.getNextGlobalGenId

-- appends inits

-- | Appends initialisation arguments. It's up to user to supply arguments with the right types. For example:
--
-- > oscil 0.5 440 sinWave `withInits` (0.5 :: D)
withInits :: (Tuple a, Tuple b) => a -> b -> a
withInits :: a -> b -> a
withInits a
a b
b = a -> GE [E] -> a
forall a. Tuple a => a -> GE [E] -> a
genWithInits a
a (b -> GE [E]
forall a. Tuple a => a -> GE [E]
fromTuple b
b)

-- | A special case of @withInits@. Here all inits are numbers. 
withDs :: Tuple a => a -> [D] -> a
withDs :: a -> [D] -> a
withDs a
a [D]
ds = a -> GE [E] -> a
forall a. Tuple a => a -> GE [E] -> a
genWithInits a
a ((D -> GE E) -> [D] -> GE [E]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM D -> GE E
forall a. Val a => a -> GE E
toGE [D]
ds)

-- | Appends an init value which is a number.
withD :: Tuple a => a -> D -> a
withD :: a -> D -> a
withD = a -> D -> a
forall a b. (Tuple a, Tuple b) => a -> b -> a
withInits

-- | A special case of @withInits@. Here all inits are signals. 
withSigs :: Tuple a => a -> [Sig] -> a
withSigs :: a -> [Sig] -> a
withSigs a
a [Sig]
sigs = a -> GE [E] -> a
forall a. Tuple a => a -> GE [E] -> a
genWithInits a
a ((Sig -> GE E) -> [Sig] -> GE [E]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Sig -> GE E
forall a. Val a => a -> GE E
toGE [Sig]
sigs)

-- | Appends an init value which is a signal.
withSig :: Tuple a => a -> Sig -> a
withSig :: a -> Sig -> a
withSig = a -> Sig -> a
forall a b. (Tuple a, Tuple b) => a -> b -> a
withInits

-- | A special case of @withInits@. Here all inits are arrays. 
withTabs :: Tuple a => a -> [Tab] -> a
withTabs :: a -> [Tab] -> a
withTabs a
a [Tab]
tabs = a -> GE [E] -> a
forall a. Tuple a => a -> GE [E] -> a
genWithInits a
a ((Tab -> GE E) -> [Tab] -> GE [E]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Tab -> GE E
forall a. Val a => a -> GE E
toGE [Tab]
tabs)

-- | Appends an init value which is a table.
withTab :: Tuple a => a -> Tab -> a
withTab :: a -> Tab -> a
withTab = a -> Tab -> a
forall a b. (Tuple a, Tuple b) => a -> b -> a
withInits

-- | Applies a seed to the random value. 
-- It's equivalent to the @withD@ but it has a special 
-- meaning of canceling the side effect. When random
-- opcode is provided with seed value it's no longer
-- contains a side effect so we don't need to restrict it.
withSeed :: SE Sig -> D -> Sig
withSeed :: SE Sig -> D -> Sig
withSeed SE Sig
a D
d = GE Sig -> Sig
forall a. Val a => GE a -> a
hideGE (GE Sig -> Sig) -> GE Sig -> Sig
forall a b. (a -> b) -> a -> b
$ SE Sig -> GE Sig
forall a. SE a -> GE a
evalSE (SE Sig -> GE Sig) -> SE Sig -> GE Sig
forall a b. (a -> b) -> a -> b
$ (Sig -> Sig) -> SE Sig -> SE Sig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Sig -> D -> Sig) -> D -> Sig -> Sig
forall a b c. (a -> b -> c) -> b -> a -> c
flip Sig -> D -> Sig
forall a. Tuple a => a -> D -> a
withD D
d) SE Sig
a

genWithInits :: (Tuple a) => a -> GE [E] -> a
genWithInits :: a -> GE [E] -> a
genWithInits a
a GE [E]
vals = GE [E] -> a
forall a. Tuple a => GE [E] -> a
toTuple (GE [E] -> a) -> GE [E] -> a
forall a b. (a -> b) -> a -> b
$ do
    [E]
as <- a -> GE [E]
forall a. Tuple a => a -> GE [E]
fromTuple a
a
    [E]
vs <- GE [E]
vals
    [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
$ (E -> E) -> [E] -> [E]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\E
x -> E -> [E] -> E
D.withInits E
x [E]
vs) [E]
as