{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# Language
        TypeFamilies,
        FlexibleContexts,
        FlexibleInstances,
        CPP #-}
module Csound.Typed.Types.Tuple(
    -- ** Tuple
    Tuple(..), TupleMethods, makeTupleMethods,
    fromTuple, toTuple, tupleArity, tupleRates, defTuple, mapTuple,

    -- ** Outs
    Sigs, outArity, Sig2s,

    -- *** Multiple outs
    multiOuts,
    ar1, ar2, ar4, ar6, ar8,

    -- ** Arguments
    Arg, arg, toNote, argArity, toArg,

    -- ** Logic functions
    ifTuple, guardedTuple, caseTuple,
    ifArg, guardedArg, caseArg,

    -- ** Constructors
    pureTuple, dirtyTuple
) where


import Control.Arrow
import Control.Applicative
import Control.Monad
import Control.Monad.Trans.Class
import Data.Default
import Data.Boolean

import Csound.Dynamic
import Csound.Typed.Types.Prim
import Csound.Typed.Types.SigSpace
import Csound.Typed.GlobalState.GE
import Csound.Typed.GlobalState.SE
import Csound.Typed.Types.TupleHelpers

-- | A tuple of Csound values.
class Tuple a where
    tupleMethods :: TupleMethods a

data TupleMethods a = TupleMethods
    { TupleMethods a -> a -> GE [E]
fromTuple_  :: a -> GE [E]
    , TupleMethods a -> GE [E] -> a
toTuple_    :: GE [E] -> a
    , TupleMethods a -> a -> Int
tupleArity_ :: a -> Int
    , TupleMethods a -> a -> [Rate]
tupleRates_ :: a -> [Rate]
    , TupleMethods a -> a
defTuple_   :: a }

fromTuple :: Tuple a => a -> GE [E]
fromTuple :: a -> GE [E]
fromTuple = TupleMethods a -> a -> GE [E]
forall a. TupleMethods a -> a -> GE [E]
fromTuple_ TupleMethods a
forall a. Tuple a => TupleMethods a
tupleMethods

toTuple :: Tuple a => GE [E] -> a
toTuple :: GE [E] -> a
toTuple = TupleMethods a -> GE [E] -> a
forall a. TupleMethods a -> GE [E] -> a
toTuple_ TupleMethods a
forall a. Tuple a => TupleMethods a
tupleMethods

tupleArity :: Tuple a => a -> Int
tupleArity :: a -> Int
tupleArity = TupleMethods a -> a -> Int
forall a. TupleMethods a -> a -> Int
tupleArity_ TupleMethods a
forall a. Tuple a => TupleMethods a
tupleMethods

tupleRates :: Tuple a => a -> [Rate]
tupleRates :: a -> [Rate]
tupleRates = TupleMethods a -> a -> [Rate]
forall a. TupleMethods a -> a -> [Rate]
tupleRates_ TupleMethods a
forall a. Tuple a => TupleMethods a
tupleMethods

defTuple :: Tuple a => a
defTuple :: a
defTuple = TupleMethods a -> a
forall a. TupleMethods a -> a
defTuple_ TupleMethods a
forall a. Tuple a => TupleMethods a
tupleMethods

mapTuple :: Tuple a => (E -> E) -> a -> a
mapTuple :: (E -> E) -> a -> a
mapTuple E -> E
f a
a = GE [E] -> a
forall a. Tuple a => GE [E] -> a
toTuple (([E] -> [E]) -> GE [E] -> GE [E]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((E -> E) -> [E] -> [E]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap E -> E
f) (GE [E] -> GE [E]) -> GE [E] -> GE [E]
forall a b. (a -> b) -> a -> b
$ a -> GE [E]
forall a. Tuple a => a -> GE [E]
fromTuple a
a)

-- | Defines instance of type class 'Tuple' for a new type in terms of an already defined one.
makeTupleMethods :: (Tuple a) => (a -> b) -> (b -> a) -> TupleMethods b
makeTupleMethods :: (a -> b) -> (b -> a) -> TupleMethods b
makeTupleMethods a -> b
to b -> a
from = TupleMethods :: forall a.
(a -> GE [E])
-> (GE [E] -> a)
-> (a -> Int)
-> (a -> [Rate])
-> a
-> TupleMethods a
TupleMethods
    { fromTuple_ :: b -> GE [E]
fromTuple_  = a -> GE [E]
forall a. Tuple a => a -> GE [E]
fromTuple (a -> GE [E]) -> (b -> a) -> b -> GE [E]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
from
    , toTuple_ :: GE [E] -> b
toTuple_    = a -> b
to (a -> b) -> (GE [E] -> a) -> GE [E] -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GE [E] -> a
forall a. Tuple a => GE [E] -> a
toTuple
    , tupleArity_ :: b -> Int
tupleArity_ = Int -> b -> Int
forall a b. a -> b -> a
const (Int -> b -> Int) -> Int -> b -> Int
forall a b. (a -> b) -> a -> b
$ a -> Int
forall a. Tuple a => a -> Int
tupleArity (a -> Int) -> a -> Int
forall a b. (a -> b) -> a -> b
$ (a -> b) -> a
forall a b. (a -> b) -> a
proxy a -> b
to
    , tupleRates_ :: b -> [Rate]
tupleRates_ = a -> [Rate]
forall a. Tuple a => a -> [Rate]
tupleRates (a -> [Rate]) -> (b -> a) -> b -> [Rate]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
from
    , defTuple_ :: b
defTuple_   = a -> b
to a
forall a. Tuple a => a
defTuple }
    where proxy :: (a -> b) -> a
          proxy :: (a -> b) -> a
proxy = (a -> b) -> a
forall a. HasCallStack => a
undefined

-- Tuple instances

primTupleMethods :: (Val a, Default a) => Rate -> TupleMethods a
primTupleMethods :: Rate -> TupleMethods a
primTupleMethods Rate
rate = TupleMethods :: forall a.
(a -> GE [E])
-> (GE [E] -> a)
-> (a -> Int)
-> (a -> [Rate])
-> a
-> TupleMethods a
TupleMethods
        { fromTuple_ :: a -> GE [E]
fromTuple_ = (E -> [E]) -> GE E -> GE [E]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap E -> [E]
forall (m :: * -> *) a. Monad m => a -> m a
return (GE E -> GE [E]) -> (a -> GE E) -> a -> GE [E]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> GE E
forall a. Val a => a -> GE E
toGE
        , toTuple_ :: GE [E] -> a
toTuple_ = GE E -> a
forall a. Val a => GE E -> a
fromGE (GE E -> a) -> (GE [E] -> GE E) -> GE [E] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([E] -> E) -> GE [E] -> GE E
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [E] -> E
forall a. [a] -> a
head
        , tupleArity_ :: a -> Int
tupleArity_ = Int -> a -> Int
forall a b. a -> b -> a
const Int
1
        , tupleRates_ :: a -> [Rate]
tupleRates_ = [Rate] -> a -> [Rate]
forall a b. a -> b -> a
const [Rate
rate]
        , defTuple_ :: a
defTuple_   = a
forall a. Default a => a
def }

instance Tuple Unit where
    tupleMethods :: TupleMethods Unit
tupleMethods = TupleMethods :: forall a.
(a -> GE [E])
-> (GE [E] -> a)
-> (a -> Int)
-> (a -> [Rate])
-> a
-> TupleMethods a
TupleMethods
        { fromTuple_ :: Unit -> GE [E]
fromTuple_  = \Unit
x -> Unit -> GE ()
unUnit Unit
x GE () -> GE [E] -> GE [E]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([E] -> GE [E]
forall (m :: * -> *) a. Monad m => a -> m a
return [])
        , toTuple_ :: GE [E] -> Unit
toTuple_    = \GE [E]
es -> GE () -> Unit
Unit (GE () -> Unit) -> GE () -> Unit
forall a b. (a -> b) -> a -> b
$ GE [E]
es GE [E] -> GE () -> GE ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> GE ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        , tupleArity_ :: Unit -> Int
tupleArity_ = Int -> Unit -> Int
forall a b. a -> b -> a
const Int
0
        , tupleRates_ :: Unit -> [Rate]
tupleRates_ = [Rate] -> Unit -> [Rate]
forall a b. a -> b -> a
const []
        , defTuple_ :: Unit
defTuple_   = GE () -> Unit
Unit (GE () -> Unit) -> GE () -> Unit
forall a b. (a -> b) -> a -> b
$ () -> GE ()
forall (m :: * -> *) a. Monad m => a -> m a
return () }

instance Tuple Sig   where tupleMethods :: TupleMethods Sig
tupleMethods = Rate -> TupleMethods Sig
forall a. (Val a, Default a) => Rate -> TupleMethods a
primTupleMethods Rate
Ar
instance Tuple D     where tupleMethods :: TupleMethods D
tupleMethods = Rate -> TupleMethods D
forall a. (Val a, Default a) => Rate -> TupleMethods a
primTupleMethods Rate
Kr
instance Tuple Tab   where tupleMethods :: TupleMethods Tab
tupleMethods = Rate -> TupleMethods Tab
forall a. (Val a, Default a) => Rate -> TupleMethods a
primTupleMethods Rate
Kr
instance Tuple Str   where tupleMethods :: TupleMethods Str
tupleMethods = Rate -> TupleMethods Str
forall a. (Val a, Default a) => Rate -> TupleMethods a
primTupleMethods Rate
Sr
instance Tuple Spec  where tupleMethods :: TupleMethods Spec
tupleMethods = Rate -> TupleMethods Spec
forall a. (Val a, Default a) => Rate -> TupleMethods a
primTupleMethods Rate
Fr

instance Tuple TabList where tupleMethods :: TupleMethods TabList
tupleMethods = Rate -> TupleMethods TabList
forall a. (Val a, Default a) => Rate -> TupleMethods a
primTupleMethods Rate
Kr

instance (Tuple a, Tuple b) => Tuple (a, b) where
    tupleMethods :: TupleMethods (a, b)
tupleMethods = ((a, b) -> GE [E])
-> (GE [E] -> (a, b))
-> ((a, b) -> Int)
-> ((a, b) -> [Rate])
-> (a, b)
-> TupleMethods (a, b)
forall a.
(a -> GE [E])
-> (GE [E] -> a)
-> (a -> Int)
-> (a -> [Rate])
-> a
-> TupleMethods a
TupleMethods (a, b) -> GE [E]
forall a a. (Tuple a, Tuple a) => (a, a) -> GE [E]
fromTuple' GE [E] -> (a, b)
forall a b. (Tuple a, Tuple b) => GE [E] -> (a, b)
toTuple' (a, b) -> Int
forall a a. (Tuple a, Tuple a) => (a, a) -> Int
tupleArity' (a, b) -> [Rate]
forall a a. (Tuple a, Tuple a) => (a, a) -> [Rate]
tupleRates' (a, b)
defTuple'
        where
            fromTuple' :: (a, a) -> GE [E]
fromTuple' (a
a, a
b) = ([E] -> [E] -> [E]) -> GE [E] -> GE [E] -> GE [E]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 [E] -> [E] -> [E]
forall a. [a] -> [a] -> [a]
(++) (a -> GE [E]
forall a. Tuple a => a -> GE [E]
fromTuple a
a) (a -> GE [E]
forall a. Tuple a => a -> GE [E]
fromTuple a
b)
            tupleArity' :: (a, a) -> Int
tupleArity' (a, a)
x = let (a
a, a
b) = (a, a) -> (a, a)
forall a b. (a, b) -> (a, b)
proxy (a, a)
x in a -> Int
forall a. Tuple a => a -> Int
tupleArity a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Tuple a => a -> Int
tupleArity a
b
                where proxy :: (a, b) -> (a, b)
                      proxy :: (a, b) -> (a, b)
proxy = (a, b) -> (a, b) -> (a, b)
forall a b. a -> b -> a
const (a
forall a. HasCallStack => a
undefined, b
forall a. HasCallStack => a
undefined)
            toTuple' :: GE [E] -> (a, b)
toTuple' GE [E]
xs = (a
a, b
b)
                where a :: a
a = GE [E] -> a
forall a. Tuple a => GE [E] -> a
toTuple (GE [E] -> a) -> GE [E] -> a
forall a b. (a -> b) -> a -> b
$ ([E] -> [E]) -> GE [E] -> GE [E]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> [E] -> [E]
forall a. Int -> [a] -> [a]
take (a -> Int
forall a. Tuple a => a -> Int
tupleArity a
a)) GE [E]
xs
                      xsb :: GE [E]
xsb = ([E] -> [E]) -> GE [E] -> GE [E]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> [E] -> [E]
forall a. Int -> [a] -> [a]
drop (a -> Int
forall a. Tuple a => a -> Int
tupleArity a
a)) GE [E]
xs
                      b :: b
b = GE [E] -> b
forall a. Tuple a => GE [E] -> a
toTuple (GE [E] -> b) -> GE [E] -> b
forall a b. (a -> b) -> a -> b
$ ([E] -> [E]) -> GE [E] -> GE [E]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> [E] -> [E]
forall a. Int -> [a] -> [a]
take (b -> Int
forall a. Tuple a => a -> Int
tupleArity b
b)) GE [E]
xsb

            tupleRates' :: (a, a) -> [Rate]
tupleRates' (a
a, a
b) = a -> [Rate]
forall a. Tuple a => a -> [Rate]
tupleRates a
a [Rate] -> [Rate] -> [Rate]
forall a. [a] -> [a] -> [a]
++ a -> [Rate]
forall a. Tuple a => a -> [Rate]
tupleRates a
b
            defTuple' :: (a, b)
defTuple' = (a
forall a. Tuple a => a
defTuple, b
forall a. Tuple a => a
defTuple)

instance (Tuple a, Tuple b, Tuple c) => Tuple (a, b, c) where tupleMethods :: TupleMethods (a, b, c)
tupleMethods = ((a, (b, c)) -> (a, b, c))
-> ((a, b, c) -> (a, (b, c))) -> TupleMethods (a, b, c)
forall a b. Tuple a => (a -> b) -> (b -> a) -> TupleMethods b
makeTupleMethods (a, (b, c)) -> (a, b, c)
forall a b c. (a, (b, c)) -> (a, b, c)
cons3 (a, b, c) -> (a, (b, c))
forall a b c. (a, b, c) -> (a, (b, c))
split3
instance (Tuple a, Tuple b, Tuple c, Tuple d) => Tuple (a, b, c, d) where tupleMethods :: TupleMethods (a, b, c, d)
tupleMethods = ((a, (b, c, d)) -> (a, b, c, d))
-> ((a, b, c, d) -> (a, (b, c, d))) -> TupleMethods (a, b, c, d)
forall a b. Tuple a => (a -> b) -> (b -> a) -> TupleMethods b
makeTupleMethods (a, (b, c, d)) -> (a, b, c, d)
forall a b c d. (a, (b, c, d)) -> (a, b, c, d)
cons4 (a, b, c, d) -> (a, (b, c, d))
forall a b c d. (a, b, c, d) -> (a, (b, c, d))
split4
instance (Tuple a, Tuple b, Tuple c, Tuple d, Tuple e) => Tuple (a, b, c, d, e) where tupleMethods :: TupleMethods (a, b, c, d, e)
tupleMethods = ((a, (b, c, d, e)) -> (a, b, c, d, e))
-> ((a, b, c, d, e) -> (a, (b, c, d, e)))
-> TupleMethods (a, b, c, d, e)
forall a b. Tuple a => (a -> b) -> (b -> a) -> TupleMethods b
makeTupleMethods (a, (b, c, d, e)) -> (a, b, c, d, e)
forall a b c d e. (a, (b, c, d, e)) -> (a, b, c, d, e)
cons5 (a, b, c, d, e) -> (a, (b, c, d, e))
forall a b c d e. (a, b, c, d, e) -> (a, (b, c, d, e))
split5
instance (Tuple a, Tuple b, Tuple c, Tuple d, Tuple e, Tuple f) => Tuple (a, b, c, d, e, f) where tupleMethods :: TupleMethods (a, b, c, d, e, f)
tupleMethods = ((a, (b, c, d, e, f)) -> (a, b, c, d, e, f))
-> ((a, b, c, d, e, f) -> (a, (b, c, d, e, f)))
-> TupleMethods (a, b, c, d, e, f)
forall a b. Tuple a => (a -> b) -> (b -> a) -> TupleMethods b
makeTupleMethods (a, (b, c, d, e, f)) -> (a, b, c, d, e, f)
forall a b c d e f. (a, (b, c, d, e, f)) -> (a, b, c, d, e, f)
cons6 (a, b, c, d, e, f) -> (a, (b, c, d, e, f))
forall a b c d e f. (a, b, c, d, e, f) -> (a, (b, c, d, e, f))
split6
instance (Tuple a, Tuple b, Tuple c, Tuple d, Tuple e, Tuple f, Tuple g) => Tuple (a, b, c, d, e, f, g) where tupleMethods :: TupleMethods (a, b, c, d, e, f, g)
tupleMethods = ((a, (b, c, d, e, f, g)) -> (a, b, c, d, e, f, g))
-> ((a, b, c, d, e, f, g) -> (a, (b, c, d, e, f, g)))
-> TupleMethods (a, b, c, d, e, f, g)
forall a b. Tuple a => (a -> b) -> (b -> a) -> TupleMethods b
makeTupleMethods (a, (b, c, d, e, f, g)) -> (a, b, c, d, e, f, g)
forall a b c d e f g.
(a, (b, c, d, e, f, g)) -> (a, b, c, d, e, f, g)
cons7 (a, b, c, d, e, f, g) -> (a, (b, c, d, e, f, g))
forall a b c d e f g.
(a, b, c, d, e, f, g) -> (a, (b, c, d, e, f, g))
split7
instance (Tuple a, Tuple b, Tuple c, Tuple d, Tuple e, Tuple f, Tuple g, Tuple h) => Tuple (a, b, c, d, e, f, g, h) where tupleMethods :: TupleMethods (a, b, c, d, e, f, g, h)
tupleMethods = ((a, (b, c, d, e, f, g, h)) -> (a, b, c, d, e, f, g, h))
-> ((a, b, c, d, e, f, g, h) -> (a, (b, c, d, e, f, g, h)))
-> TupleMethods (a, b, c, d, e, f, g, h)
forall a b. Tuple a => (a -> b) -> (b -> a) -> TupleMethods b
makeTupleMethods (a, (b, c, d, e, f, g, h)) -> (a, b, c, d, e, f, g, h)
forall a b c d e f g h.
(a, (b, c, d, e, f, g, h)) -> (a, b, c, d, e, f, g, h)
cons8 (a, b, c, d, e, f, g, h) -> (a, (b, c, d, e, f, g, h))
forall a b c d e f g h.
(a, b, c, d, e, f, g, h) -> (a, (b, c, d, e, f, g, h))
split8

-------------------------------------------------------------------------------
-- multiple outs

multiOuts :: Tuple a => E -> a
multiOuts :: E -> a
multiOuts E
expr = a
res
    where res :: a
res = GE [E] -> a
forall a. Tuple a => GE [E] -> a
toTuple (GE [E] -> a) -> GE [E] -> a
forall a b. (a -> b) -> a -> b
$ [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 -> E -> [E]
mo (a -> Int
forall a. Tuple a => a -> Int
tupleArity a
res) E
expr

ar1 :: Sig -> Sig
ar2 :: (Sig, Sig) -> (Sig, Sig)
ar4 :: (Sig, Sig, Sig, Sig) -> (Sig, Sig, Sig, Sig)
ar6 :: (Sig, Sig, Sig, Sig, Sig, Sig) -> (Sig, Sig, Sig, Sig, Sig, Sig)
ar8 :: (Sig, Sig, Sig, Sig, Sig, Sig, Sig, Sig) -> (Sig, Sig, Sig, Sig, Sig, Sig, Sig, Sig)

ar1 :: Sig -> Sig
ar1 = Sig -> Sig
forall a. a -> a
id;   ar2 :: (Sig, Sig) -> (Sig, Sig)
ar2 = (Sig, Sig) -> (Sig, Sig)
forall a. a -> a
id;   ar4 :: (Sig, Sig, Sig, Sig) -> (Sig, Sig, Sig, Sig)
ar4 = (Sig, Sig, Sig, Sig) -> (Sig, Sig, Sig, Sig)
forall a. a -> a
id;   ar6 :: (Sig, Sig, Sig, Sig, Sig, Sig) -> (Sig, Sig, Sig, Sig, Sig, Sig)
ar6 = (Sig, Sig, Sig, Sig, Sig, Sig) -> (Sig, Sig, Sig, Sig, Sig, Sig)
forall a. a -> a
id;   ar8 :: (Sig, Sig, Sig, Sig, Sig, Sig, Sig, Sig)
-> (Sig, Sig, Sig, Sig, Sig, Sig, Sig, Sig)
ar8 = (Sig, Sig, Sig, Sig, Sig, Sig, Sig, Sig)
-> (Sig, Sig, Sig, Sig, Sig, Sig, Sig, Sig)
forall a. a -> a
id

---------------------------------------------------------------------------------
-- out instances

-- | The tuples of signals.
class (Tuple a, Num a, Fractional a, SigSpace a, BindSig a) => Sigs a where
class (Sigs a, SigSpace2 a, BindSig2 a) => Sig2s a where

instance Sigs Sig

#if __GLASGOW_HASKELL__ >= 710
instance (Sigs a1, Sigs a2) => Sigs (a1, a2)
instance (Sigs a1, Sigs a2, Sigs a3) => Sigs (a1, a2, a3)
instance (Sigs a1, Sigs a2, Sigs a3, Sigs a4) => Sigs (a1, a2, a3, a4)
instance (Sigs a1, Sigs a2, Sigs a3, Sigs a4, Sigs a5) => Sigs (a1, a2, a3, a4, a5)
instance (Sigs a1, Sigs a2, Sigs a3, Sigs a4, Sigs a5, Sigs a6) => Sigs (a1, a2, a3, a4, a5, a6)
instance (Sigs a1, Sigs a2, Sigs a3, Sigs a4, Sigs a5, Sigs a6, Sigs a7) => Sigs (a1, a2, a3, a4, a5, a6, a7)
instance (Sigs a1, Sigs a2, Sigs a3, Sigs a4, Sigs a5, Sigs a6, Sigs a7, Sigs a8) => Sigs (a1, a2, a3, a4, a5, a6, a7, a8)
#else
instance Sigs (Sig, Sig)
instance Sigs (Sig, Sig, Sig)
instance Sigs (Sig, Sig, Sig, Sig)
instance Sigs (Sig, Sig, Sig, Sig, Sig)
instance Sigs (Sig, Sig, Sig, Sig, Sig, Sig)
instance Sigs (Sig, Sig, Sig, Sig, Sig, Sig, Sig)
instance Sigs (Sig, Sig, Sig, Sig, Sig, Sig, Sig, Sig)
#endif

instance Sig2s Sig
instance Sig2s Sig2
instance Sig2s Sig4
instance Sig2s Sig6
instance Sig2s Sig8

outArity :: Tuple a => SE a -> Int
outArity :: SE a -> Int
outArity = a -> Int
forall a. Tuple a => a -> Int
tupleArity (a -> Int) -> (SE a -> a) -> SE a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SE a -> a
forall a. SE a -> a
proxy
    where
        proxy :: SE a -> a
        proxy :: SE a -> a
proxy = a -> SE a -> a
forall a b. a -> b -> a
const a
forall a. HasCallStack => a
undefined

---------------------------------------------------------------------------
-- Arguments

class (Tuple a) => Arg a where

instance Arg Unit
instance Arg D
instance Arg Str
instance Arg Tab
instance Arg TabList

instance (Arg a, Arg b) => Arg (a, b)
instance (Arg a, Arg b, Arg c) => Arg (a, b, c)
instance (Arg a, Arg b, Arg c, Arg d) => Arg (a, b, c, d)
instance (Arg a, Arg b, Arg c, Arg d, Arg e) => Arg (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)
instance (Arg a, Arg b, Arg c, Arg d, Arg e, Arg f, Arg h) => Arg (a, b, c, d, e, f, h)
instance (Arg a, Arg b, Arg c, Arg d, Arg e, Arg f, Arg h, Arg g) => Arg (a, b, c, d, e, f, h, g)

arg :: Arg a => Int -> a
arg :: Int -> a
arg Int
n = GE [E] -> a
forall a. Tuple a => GE [E] -> a
toTuple (GE [E] -> a) -> GE [E] -> a
forall a b. (a -> b) -> a -> b
$ [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 -> E) -> [Int] -> [E]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> E
pn [Int
n ..]

toArg :: Arg a => a
toArg :: a
toArg = Int -> a
forall a. Arg a => Int -> a
arg Int
4

argArity :: Arg a => a -> Int
argArity :: a -> Int
argArity = a -> Int
forall a. Tuple a => a -> Int
tupleArity

toNote :: Arg a => a -> GE [E]
toNote :: a -> GE [E]
toNote a
a = (Rate -> E -> GE E) -> [Rate] -> [E] -> GE [E]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM Rate -> E -> GE E
phi (a -> [Rate]
forall a. Tuple a => a -> [Rate]
tupleRates a
a) ([E] -> GE [E]) -> GE [E] -> GE [E]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< a -> GE [E]
forall a. Tuple a => a -> GE [E]
fromTuple a
a
    where
        phi :: Rate -> E -> GE E
phi Rate
rate E
x = case Rate
rate of
            Rate
Sr -> String -> GE E
saveStr (String -> GE E) -> String -> GE E
forall a b. (a -> b) -> a -> b
$ E -> String
getStringUnsafe E
x
            Rate
_  -> E -> GE E
forall (m :: * -> *) a. Monad m => a -> m a
return E
x

        getStringUnsafe :: E -> String
getStringUnsafe E
x = case E -> Prim
getPrimUnsafe E
x of
            PrimString String
y    -> String
y
            Prim
_               -> String -> String
forall a. HasCallStack => String -> a
error String
"Arg(Str):getStringUnsafe value is not a string"

-------------------------------------------------------------------------
-- logic functions

-- tuples

newtype BoolTuple = BoolTuple { BoolTuple -> GE [E]
unBoolTuple :: GE [E] }

toBoolTuple :: Tuple a => a -> BoolTuple
toBoolTuple :: a -> BoolTuple
toBoolTuple   = GE [E] -> BoolTuple
BoolTuple (GE [E] -> BoolTuple) -> (a -> GE [E]) -> a -> BoolTuple
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> GE [E]
forall a. Tuple a => a -> GE [E]
fromTuple

fromBoolTuple :: Tuple a => BoolTuple -> a
fromBoolTuple :: BoolTuple -> a
fromBoolTuple = GE [E] -> a
forall a. Tuple a => GE [E] -> a
toTuple (GE [E] -> a) -> (BoolTuple -> GE [E]) -> BoolTuple -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoolTuple -> GE [E]
unBoolTuple

type instance BooleanOf BoolTuple = BoolSig

instance IfB BoolTuple where
    ifB :: bool -> BoolTuple -> BoolTuple -> BoolTuple
ifB bool
mp (BoolTuple GE [E]
mas) (BoolTuple GE [E]
mbs) = GE [E] -> BoolTuple
BoolTuple (GE [E] -> BoolTuple) -> GE [E] -> BoolTuple
forall a b. (a -> b) -> a -> b
$
        (E -> [E] -> [E] -> [E]) -> GE E -> GE [E] -> GE [E] -> GE [E]
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 (\E
p [E]
as [E]
bs -> (E -> E -> E) -> [E] -> [E] -> [E]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (E -> E -> E -> E
forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
ifB E
p) [E]
as [E]
bs) (bool -> GE E
forall a. Val a => a -> GE E
toGE bool
mp) GE [E]
mas GE [E]
mbs

-- | @ifB@ for tuples of csound values.
ifTuple :: (Tuple a) => BoolSig -> a -> a -> a
ifTuple :: BoolSig -> a -> a -> a
ifTuple BoolSig
p a
a a
b = BoolTuple -> a
forall a. Tuple a => BoolTuple -> a
fromBoolTuple (BoolTuple -> a) -> BoolTuple -> a
forall a b. (a -> b) -> a -> b
$ BoolSig -> BoolTuple -> BoolTuple -> BoolTuple
forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
ifB BoolSig
p (a -> BoolTuple
forall a. Tuple a => a -> BoolTuple
toBoolTuple a
a) (a -> BoolTuple
forall a. Tuple a => a -> BoolTuple
toBoolTuple a
b)

-- | @guardedB@ for tuples of csound values.
guardedTuple :: (Tuple b) => [(BoolSig, b)] -> b -> b
guardedTuple :: [(BoolSig, b)] -> b -> b
guardedTuple [(BoolSig, b)]
bs b
b = BoolTuple -> b
forall a. Tuple a => BoolTuple -> a
fromBoolTuple (BoolTuple -> b) -> BoolTuple -> b
forall a b. (a -> b) -> a -> b
$ BoolSig -> [(BoolSig, BoolTuple)] -> BoolTuple -> BoolTuple
forall b bool.
(IfB b, bool ~ BooleanOf b) =>
bool -> [(bool, b)] -> b -> b
guardedB BoolSig
forall a. HasCallStack => a
undefined (((BoolSig, b) -> (BoolSig, BoolTuple))
-> [(BoolSig, b)] -> [(BoolSig, BoolTuple)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b -> BoolTuple) -> (BoolSig, b) -> (BoolSig, BoolTuple)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second b -> BoolTuple
forall a. Tuple a => a -> BoolTuple
toBoolTuple) [(BoolSig, b)]
bs) (b -> BoolTuple
forall a. Tuple a => a -> BoolTuple
toBoolTuple b
b)

-- | @caseB@ for tuples of csound values.
caseTuple :: (Tuple b) => a -> [(a -> BoolSig, b)] -> b -> b
caseTuple :: a -> [(a -> BoolSig, b)] -> b -> b
caseTuple a
a [(a -> BoolSig, b)]
bs b
other = BoolTuple -> b
forall a. Tuple a => BoolTuple -> a
fromBoolTuple (BoolTuple -> b) -> BoolTuple -> b
forall a b. (a -> b) -> a -> b
$ a -> [(a -> BoolSig, BoolTuple)] -> BoolTuple -> BoolTuple
forall b bool a.
(IfB b, bool ~ BooleanOf b) =>
a -> [(a -> bool, b)] -> b -> b
caseB a
a (((a -> BoolSig, b) -> (a -> BoolSig, BoolTuple))
-> [(a -> BoolSig, b)] -> [(a -> BoolSig, BoolTuple)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b -> BoolTuple) -> (a -> BoolSig, b) -> (a -> BoolSig, BoolTuple)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second b -> BoolTuple
forall a. Tuple a => a -> BoolTuple
toBoolTuple) [(a -> BoolSig, b)]
bs) (b -> BoolTuple
forall a. Tuple a => a -> BoolTuple
toBoolTuple b
other)

-- arguments

newtype BoolArg = BoolArg { BoolArg -> GE [E]
unBoolArg :: GE [E] }

toBoolArg :: (Arg a, Tuple a) => a -> BoolArg
toBoolArg :: a -> BoolArg
toBoolArg   = GE [E] -> BoolArg
BoolArg (GE [E] -> BoolArg) -> (a -> GE [E]) -> a -> BoolArg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> GE [E]
forall a. Tuple a => a -> GE [E]
fromTuple

fromBoolArg :: (Arg a, Tuple a) => BoolArg -> a
fromBoolArg :: BoolArg -> a
fromBoolArg = GE [E] -> a
forall a. Tuple a => GE [E] -> a
toTuple (GE [E] -> a) -> (BoolArg -> GE [E]) -> BoolArg -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoolArg -> GE [E]
unBoolArg

type instance BooleanOf BoolArg = BoolD

instance IfB BoolArg where
    ifB :: bool -> BoolArg -> BoolArg -> BoolArg
ifB bool
mp (BoolArg GE [E]
mas) (BoolArg GE [E]
mbs) = GE [E] -> BoolArg
BoolArg (GE [E] -> BoolArg) -> GE [E] -> BoolArg
forall a b. (a -> b) -> a -> b
$
        (E -> [E] -> [E] -> [E]) -> GE E -> GE [E] -> GE [E] -> GE [E]
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 (\E
p [E]
as [E]
bs -> (E -> E -> E) -> [E] -> [E] -> [E]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (E -> E -> E -> E
forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
ifB E
p) [E]
as [E]
bs) (bool -> GE E
forall a. Val a => a -> GE E
toGE bool
mp) GE [E]
mas GE [E]
mbs

-- | @ifB@ for constants.
ifArg :: (Arg a, Tuple a) => BoolD -> a -> a -> a
ifArg :: BoolD -> a -> a -> a
ifArg BoolD
p a
a a
b = BoolArg -> a
forall a. (Arg a, Tuple a) => BoolArg -> a
fromBoolArg (BoolArg -> a) -> BoolArg -> a
forall a b. (a -> b) -> a -> b
$ BoolD -> BoolArg -> BoolArg -> BoolArg
forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
ifB BoolD
p (a -> BoolArg
forall a. (Arg a, Tuple a) => a -> BoolArg
toBoolArg a
a) (a -> BoolArg
forall a. (Arg a, Tuple a) => a -> BoolArg
toBoolArg a
b)

-- | @guardedB@ for constants.
guardedArg :: (Tuple b, Arg b) => [(BoolD, b)] -> b -> b
guardedArg :: [(BoolD, b)] -> b -> b
guardedArg [(BoolD, b)]
bs b
b = BoolArg -> b
forall a. (Arg a, Tuple a) => BoolArg -> a
fromBoolArg (BoolArg -> b) -> BoolArg -> b
forall a b. (a -> b) -> a -> b
$ BoolD -> [(BoolD, BoolArg)] -> BoolArg -> BoolArg
forall b bool.
(IfB b, bool ~ BooleanOf b) =>
bool -> [(bool, b)] -> b -> b
guardedB BoolD
forall a. HasCallStack => a
undefined (((BoolD, b) -> (BoolD, BoolArg))
-> [(BoolD, b)] -> [(BoolD, BoolArg)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b -> BoolArg) -> (BoolD, b) -> (BoolD, BoolArg)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second b -> BoolArg
forall a. (Arg a, Tuple a) => a -> BoolArg
toBoolArg) [(BoolD, b)]
bs) (b -> BoolArg
forall a. (Arg a, Tuple a) => a -> BoolArg
toBoolArg b
b)

-- | @caseB@ for constants.
caseArg :: (Tuple b, Arg b) => a -> [(a -> BoolD, b)] -> b -> b
caseArg :: a -> [(a -> BoolD, b)] -> b -> b
caseArg a
a [(a -> BoolD, b)]
bs b
other = BoolArg -> b
forall a. (Arg a, Tuple a) => BoolArg -> a
fromBoolArg (BoolArg -> b) -> BoolArg -> b
forall a b. (a -> b) -> a -> b
$ a -> [(a -> BoolD, BoolArg)] -> BoolArg -> BoolArg
forall b bool a.
(IfB b, bool ~ BooleanOf b) =>
a -> [(a -> bool, b)] -> b -> b
caseB a
a (((a -> BoolD, b) -> (a -> BoolD, BoolArg))
-> [(a -> BoolD, b)] -> [(a -> BoolD, BoolArg)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b -> BoolArg) -> (a -> BoolD, b) -> (a -> BoolD, BoolArg)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second b -> BoolArg
forall a. (Arg a, Tuple a) => a -> BoolArg
toBoolArg) [(a -> BoolD, b)]
bs) (b -> BoolArg
forall a. (Arg a, Tuple a) => a -> BoolArg
toBoolArg b
other)

-----------------------------------------------------------
-- tuple constructors

pureTuple :: Tuple a => GE (MultiOut [E]) -> a
pureTuple :: GE (MultiOut [E]) -> a
pureTuple GE (MultiOut [E])
a = a
res
    where res :: a
res = GE [E] -> a
forall a. Tuple a => GE [E] -> a
toTuple (GE [E] -> a) -> GE [E] -> a
forall a b. (a -> b) -> a -> b
$ (MultiOut [E] -> [E]) -> GE (MultiOut [E]) -> GE [E]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (MultiOut [E] -> MultiOut [E]
forall a b. (a -> b) -> a -> b
$ a -> Int
forall a. Tuple a => a -> Int
tupleArity a
res) GE (MultiOut [E])
a

dirtyTuple :: Tuple a => GE (MultiOut [E]) -> SE a
dirtyTuple :: GE (MultiOut [E]) -> SE a
dirtyTuple GE (MultiOut [E])
a = SE a
res
    where
        res :: SE a
res = ([E] -> a) -> SE [E] -> SE a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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) (SE [E] -> SE a) -> SE [E] -> SE a
forall a b. (a -> b) -> a -> b
$ Dep [E] -> SE [E]
forall a. Dep a -> SE a
SE
                (Dep [E] -> SE [E]) -> Dep [E] -> SE [E]
forall a b. (a -> b) -> a -> b
$ (E -> DepT GE E) -> [E] -> Dep [E]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM E -> DepT GE E
forall (m :: * -> *). Monad m => E -> DepT m E
depT ([E] -> Dep [E]) -> Dep [E] -> Dep [E]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (GE [E] -> Dep [E]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GE [E] -> Dep [E]) -> GE [E] -> Dep [E]
forall a b. (a -> b) -> a -> b
$ (MultiOut [E] -> [E]) -> GE (MultiOut [E]) -> GE [E]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (MultiOut [E] -> MultiOut [E]
forall a b. (a -> b) -> a -> b
$ (a -> Int
forall a. Tuple a => a -> Int
tupleArity (a -> Int) -> a -> Int
forall a b. (a -> b) -> a -> b
$ SE a -> a
forall a. SE a -> a
proxy SE a
res)) GE (MultiOut [E])
a)

        proxy :: SE a -> a
        proxy :: SE a -> a
proxy = a -> SE a -> a
forall a b. a -> b -> a
const a
forall a. HasCallStack => a
undefined