module Csound.Exp.Arg(
Arg(..), arg, toNote, arity,
ArgMethods, toArg, makeArgMethods,
) where
import Control.Applicative
import Csound.Exp
import Csound.Exp.Wrapper(Val, toExp, D, Str, p)
getPrimUnsafe :: Val a => a -> Prim
getPrimUnsafe x = case toExp x of
ExpPrim a -> a
_ -> error "Arg.hs:getPrimUnsafe - value is not prim"
data ArgMethods a = ArgMethods
{ arg_ :: Int -> a
, toNote_ :: a -> [Prim]
, arity_ :: a -> Int }
arg :: Arg a => Int -> a
arg = arg_ argMethods
toNote :: Arg a => a -> [Prim]
toNote = toNote_ argMethods
arity :: Arg a => a -> Int
arity = arity_ argMethods
toArg :: Arg a => a
toArg = arg 4
makeArgMethods :: (Arg a) => (a -> b) -> (b -> a) -> ArgMethods b
makeArgMethods to from = ArgMethods {
arg_ = to . arg,
toNote_ = toNote . from,
arity_ = const $ arity $ proxy to }
where proxy :: (a -> b) -> a
proxy = undefined
class Arg a where
argMethods :: ArgMethods a
instance Arg () where
argMethods = ArgMethods
{ arg_ = const ()
, toNote_ = const []
, arity_ = const 0 }
instance Arg InstrId where
argMethods = ArgMethods
{ arg_ = error "method arg is undefined for InstrId"
, toNote_ = pure . PrimInstrId
, arity_ = const 0 }
instance Arg D where
argMethods = ArgMethods {
arg_ = p,
toNote_ = pure . getPrimUnsafe,
arity_ = const 1 }
instance Arg Str where
argMethods = ArgMethods {
arg_ = p,
toNote_ = pure . getPrimUnsafe,
arity_ = const 1 }
instance Arg Tab where
argMethods = ArgMethods {
arg_ = p,
toNote_ = pure . getPrimUnsafe,
arity_ = const 1 }
instance (Arg a, Arg b) => Arg (a, b) where
argMethods = ArgMethods arg' toNote' arity'
where arg' n = (a, b)
where a = arg n
b = arg (n + arity a)
toNote' (a, b) = toNote a ++ toNote b
arity' x = let (a, b) = proxy x in arity a + arity b
where proxy :: (a, b) -> (a, b)
proxy = const (undefined, undefined)
instance (Arg a, Arg b, Arg c) => Arg (a, b, c) where
argMethods = makeArgMethods to from
where to (a, (b, c)) = (a, b, c)
from (a, b, c) = (a, (b, c))
instance (Arg a, Arg b, Arg c, Arg d) => Arg (a, b, c, d) where
argMethods = makeArgMethods to from
where to (a, (b, c, d)) = (a, b, c, d)
from (a, b, c, d) = (a, (b, c, d))
instance (Arg a, Arg b, Arg c, Arg d, Arg e) => Arg (a, b, c, d, e) where
argMethods = makeArgMethods to from
where to (a, (b, c, d, e)) = (a, b, c, d, e)
from (a, b, c, d, e) = (a, (b, c, d, e))
instance (Arg a, Arg b, Arg c, Arg d, Arg e, Arg f) => Arg (a, b, c, d, e, f) where
argMethods = makeArgMethods to from
where to (a, (b, c, d, e, f)) = (a, b, c, d, e, f)
from (a, b, c, d, e, f) = (a, (b, c, d, e, f))
instance (Arg a, Arg b, Arg c, Arg d, Arg e, Arg f, Arg g) => Arg (a, b, c, d, e, f, g) where
argMethods = makeArgMethods to from
where to (a, (b, c, d, e, f, g)) = (a, b, c, d, e, f, g)
from (a, b, c, d, e, f, g) = (a, (b, c, d, e, f, g))
instance (Arg a, Arg b, Arg c, Arg d, Arg e, Arg f, Arg g, Arg h) => Arg (a, b, c, d, e, f, g, h) where
argMethods = makeArgMethods to from
where to (a, (b, c, d, e, f, g, h)) = (a, b, c, d, e, f, g, h)
from (a, b, c, d, e, f, g, h) = (a, (b, c, d, e, f, g, h))