{-# LANGUAGE 
        TypeFamilies,
        MultiParamTypeClasses, 
        TypeSynonymInstances, 
        FlexibleContexts #-}

-- | Functions to add your own opcodes or operations
--
-- Constructor takes in 'String' and list of CsTree's. 'String' represnts 
-- name of opcode\/operation for rendering to csd file. 'CsTree' is an inner 
-- type of csound expression. Any type @a@ that belongs to 'IM' 'CsTree' @a@ 
-- can be converted to 'CsTree' with 'to' method. 

module CsoundExpr.Base.UserDefined
    (IM(..), Opr2(..),  
     opcode, outOpcode, 
     infixOperation, prefixOperation)
where

import CsoundExpr.Translator.Cs.IM
import CsoundExpr.Translator.Cs.CsTree
import CsoundExpr.Translator.ExprTree.ExprTree
import CsoundExpr.Translator.Types


-- | Opcode constructor
--
-- Example :
-- 
-- > ares oscil xamp, xcps, ift, [iphs]
-- > kres oscil kamp, kcps, ift, [iphs]
--
-- > oscilA :: (X a0, X a1) => [Irate] -> a0 -> a1 -> Irate -> Arate
-- > oscilA inits xamp xcps ift = opcode "oscil" args 
-- >     where args = [to xamp, to xcps, to ift] ++ map to inits
--
-- > oscilK :: (K a0, K a1) => [Irate] -> a0 -> a1 -> Irate -> Krate
-- > oscilK inits kamp kcps ift = opcode "oscil" args 
-- >     where args = [to kamp, to kcps, to ift] ++ map to inits
--
--
-- > ares noise xamp, kbeta
--
-- > noise :: (X a, K b) => a -> b -> SideEffect Ares
-- > noise xamp kbeta = opcode "noise" args
-- >    where args = [to xamp, to kbeta]
--
opcode :: IM CsTree a => String -> [CsTree] -> a			
opcode name = from . pure (opc name)

-- | Constructor for opcode that doesn't produce any value 
--
-- Example :
--
-- > outs asig1, asig2
-- 
-- > outs :: Arate -> Arate -> SignalOut
-- > outs asig1 asig2 = outOpcode "outs" args
-- >     where args = [to asig1, to asig2]
--
outOpcode :: String -> [CsTree] -> SignalOut
outOpcode name = SignalOut . return . opcode name

-- | Infix operation constructor
--
-- Example : 
--
-- > xres = xsig1 + xsig2
-- 
-- > add :: (X a, X b, X (Opr2 a b)) => a -> b -> Opr2 a b
-- > add a b = infixOperation "+" [to a, to b]
--
infixOperation :: IM CsTree a => String -> [CsTree] -> a
infixOperation name = from . pure (oprInfix name)
                      
-- | Prefix operation constructor
--
-- Example :
--
-- > xres = sin(xsig)
--
-- > csSin :: X a => a -> a
-- > csSin a = prefixOperation "sin" [to a]
--
prefixOperation :: IM CsTree a => String -> [CsTree] -> a
prefixOperation name = from . pure (oprPrefix name)


-- | 'Opr2' @a@ @b@  - defines output type of binary arithmetic operator
--
-- > type instance Opr2 Irate Irate = Irate
-- > type instance Opr2 Irate Krate = Krate
-- > type instance Opr2 Irate Arate = Arate
--
-- > type instance Opr2 Krate Irate = Krate
-- > type instance Opr2 Krate Krate = Krate
-- > type instance Opr2 Krate Arate = Arate
--
-- > type instance Opr2 Arate Irate = Arate
-- > type instance Opr2 Arate Krate = Arate
-- > type instance Opr2 Arate Arate = Arate

type family   Opr2     a     b 
-- Is
type instance Opr2 Irate Irate = Irate
type instance Opr2 Irate Krate = Krate
type instance Opr2 Irate Arate = Arate
 
-- Ks
type instance Opr2 Krate Irate = Krate
type instance Opr2 Krate Krate = Krate
type instance Opr2 Krate Arate = Arate
 
-- As
type instance Opr2 Arate Irate = Arate
type instance Opr2 Arate Krate = Arate
type instance Opr2 Arate Arate = Arate