{-# Language TypeFamilies, FlexibleInstances, FlexibleContexts #-}
module Csound.Control.Overload.SpecInstr(
    AmpInstr(..), CpsInstr(..)      
) where

import Control.Arrow(first, second)

import Csound.Typed

-- | Constructs a drum-like instrument.
-- Drum like instrument has a single argument that 
-- signifies an amplitude.
class AmpInstr a where
    type AmpInstrOut a :: *
    onAmp :: a -> D -> SE (AmpInstrOut a)

instance AmpInstr (D -> SE Sig) where
    type AmpInstrOut (D -> SE Sig) = Sig
    onAmp :: (D -> SE Sig) -> D -> SE (AmpInstrOut (D -> SE Sig))
onAmp = (D -> SE Sig) -> D -> SE (AmpInstrOut (D -> SE Sig))
forall a. a -> a
id

instance AmpInstr (D -> SE (Sig, Sig)) where
    type AmpInstrOut (D -> SE (Sig, Sig)) = (Sig, Sig)
    onAmp :: (D -> SE (Sig, Sig)) -> D -> SE (AmpInstrOut (D -> SE (Sig, Sig)))
onAmp = (D -> SE (Sig, Sig)) -> D -> SE (AmpInstrOut (D -> SE (Sig, Sig)))
forall a. a -> a
id

instance AmpInstr (D -> Sig) where
    type AmpInstrOut (D -> Sig) = Sig
    onAmp :: (D -> Sig) -> D -> SE (AmpInstrOut (D -> Sig))
onAmp D -> Sig
f = Sig -> SE Sig
forall (m :: * -> *) a. Monad m => a -> m a
return (Sig -> SE Sig) -> (D -> Sig) -> D -> SE Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D -> Sig
f

instance AmpInstr (D -> (Sig, Sig)) where
    type AmpInstrOut (D -> (Sig, Sig)) = (Sig, Sig)
    onAmp :: (D -> (Sig, Sig)) -> D -> SE (AmpInstrOut (D -> (Sig, Sig)))
onAmp D -> (Sig, Sig)
f = (Sig, Sig) -> SE (Sig, Sig)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Sig, Sig) -> SE (Sig, Sig))
-> (D -> (Sig, Sig)) -> D -> SE (Sig, Sig)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D -> (Sig, Sig)
f

instance AmpInstr (Sig -> SE Sig) where
    type AmpInstrOut (Sig -> SE Sig) = Sig
    onAmp :: (Sig -> SE Sig) -> D -> SE (AmpInstrOut (Sig -> SE Sig))
onAmp Sig -> SE Sig
f = Sig -> SE Sig
f (Sig -> SE Sig) -> (D -> Sig) -> D -> SE Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D -> Sig
sig

instance AmpInstr (Sig -> SE (Sig, Sig)) where
    type AmpInstrOut (Sig -> SE (Sig, Sig)) = (Sig, Sig)
    onAmp :: (Sig -> SE (Sig, Sig))
-> D -> SE (AmpInstrOut (Sig -> SE (Sig, Sig)))
onAmp Sig -> SE (Sig, Sig)
f = Sig -> SE (Sig, Sig)
f (Sig -> SE (Sig, Sig)) -> (D -> Sig) -> D -> SE (Sig, Sig)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D -> Sig
sig

instance AmpInstr (Sig -> Sig) where
    type AmpInstrOut (Sig -> Sig) = Sig
    onAmp :: (Sig -> Sig) -> D -> SE (AmpInstrOut (Sig -> Sig))
onAmp Sig -> Sig
f = Sig -> SE Sig
forall (m :: * -> *) a. Monad m => a -> m a
return (Sig -> SE Sig) -> (D -> Sig) -> D -> SE Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sig -> Sig
f (Sig -> Sig) -> (D -> Sig) -> D -> Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D -> Sig
sig

instance AmpInstr (Sig -> (Sig, Sig)) where
    type AmpInstrOut (Sig -> (Sig, Sig)) = (Sig, Sig)
    onAmp :: (Sig -> (Sig, Sig)) -> D -> SE (AmpInstrOut (Sig -> (Sig, Sig)))
onAmp Sig -> (Sig, Sig)
f = (Sig, Sig) -> SE (Sig, Sig)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Sig, Sig) -> SE (Sig, Sig))
-> (D -> (Sig, Sig)) -> D -> SE (Sig, Sig)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sig -> (Sig, Sig)
f (Sig -> (Sig, Sig)) -> (D -> Sig) -> D -> (Sig, Sig)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D -> Sig
sig

instance AmpInstr (SE Sig) where
    type AmpInstrOut (SE Sig) = Sig
    onAmp :: SE Sig -> D -> SE (AmpInstrOut (SE Sig))
onAmp SE Sig
a D
amp = (Sig -> Sig) -> SE Sig -> SE Sig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (D -> Sig
sig D
amp Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* ) SE Sig
a

instance AmpInstr (SE (Sig, Sig)) where
    type AmpInstrOut (SE (Sig, Sig)) = (Sig, Sig)
    onAmp :: SE (Sig, Sig) -> D -> SE (AmpInstrOut (SE (Sig, Sig)))
onAmp SE (Sig, Sig)
a D
amp = ((Sig, Sig) -> (Sig, Sig)) -> SE (Sig, Sig) -> SE (Sig, Sig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Sig
a1, Sig
a2) -> (D -> Sig
sig D
amp Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
a1, D -> Sig
sig D
amp Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
a2)) SE (Sig, Sig)
a 

instance AmpInstr Sig where
    type AmpInstrOut Sig = Sig
    onAmp :: Sig -> D -> SE (AmpInstrOut Sig)
onAmp Sig
a D
amp = Sig -> SE Sig
forall (m :: * -> *) a. Monad m => a -> m a
return (Sig -> SE Sig) -> Sig -> SE Sig
forall a b. (a -> b) -> a -> b
$ Sig
a Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* D -> Sig
sig D
amp

instance AmpInstr (Sig, Sig) where
    type AmpInstrOut (Sig, Sig) = (Sig, Sig)
    onAmp :: (Sig, Sig) -> D -> SE (AmpInstrOut (Sig, Sig))
onAmp (Sig
a1, Sig
a2) D
amp = (Sig, Sig) -> SE (Sig, Sig)
forall (m :: * -> *) a. Monad m => a -> m a
return (Sig
a1 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* D -> Sig
sig D
amp, Sig
a2 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* D -> Sig
sig D
amp)

------------------------------------------------------------------------

-- | Constructs a simple instrument that takes in a tuple of two arguments.
-- They are amplitude and the frequency (in Hz or cycles per second).
class CpsInstr a where
    type CpsInstrOut a :: *
    onCps :: a -> (D, D) -> SE (CpsInstrOut a)

instance CpsInstr ((D, D) -> SE Sig) where
    type CpsInstrOut ((D, D) -> SE Sig) = Sig
    onCps :: ((D, D) -> SE Sig) -> (D, D) -> SE (CpsInstrOut ((D, D) -> SE Sig))
onCps = ((D, D) -> SE Sig) -> (D, D) -> SE (CpsInstrOut ((D, D) -> SE Sig))
forall a. a -> a
id

instance CpsInstr ((D, D) -> SE (Sig, Sig)) where
    type CpsInstrOut ((D, D) -> SE (Sig, Sig)) = (Sig, Sig)
    onCps :: ((D, D) -> SE (Sig, Sig))
-> (D, D) -> SE (CpsInstrOut ((D, D) -> SE (Sig, Sig)))
onCps = ((D, D) -> SE (Sig, Sig))
-> (D, D) -> SE (CpsInstrOut ((D, D) -> SE (Sig, Sig)))
forall a. a -> a
id

instance CpsInstr ((D, D) -> Sig) where
    type CpsInstrOut ((D, D) -> Sig) = Sig
    onCps :: ((D, D) -> Sig) -> (D, D) -> SE (CpsInstrOut ((D, D) -> Sig))
onCps (D, D) -> Sig
f = Sig -> SE Sig
forall (m :: * -> *) a. Monad m => a -> m a
return (Sig -> SE Sig) -> ((D, D) -> Sig) -> (D, D) -> SE Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (D, D) -> Sig
f

instance CpsInstr ((D, D) -> (Sig, Sig)) where
    type CpsInstrOut ((D, D) -> (Sig, Sig)) = (Sig, Sig)
    onCps :: ((D, D) -> (Sig, Sig))
-> (D, D) -> SE (CpsInstrOut ((D, D) -> (Sig, Sig)))
onCps (D, D) -> (Sig, Sig)
f = (Sig, Sig) -> SE (Sig, Sig)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Sig, Sig) -> SE (Sig, Sig))
-> ((D, D) -> (Sig, Sig)) -> (D, D) -> SE (Sig, Sig)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (D, D) -> (Sig, Sig)
f

instance CpsInstr ((D, Sig) -> SE Sig) where
    type CpsInstrOut ((D, Sig) -> SE Sig) = Sig
    onCps :: ((D, Sig) -> SE Sig)
-> (D, D) -> SE (CpsInstrOut ((D, Sig) -> SE Sig))
onCps (D, Sig) -> SE Sig
f = (D, Sig) -> SE Sig
f ((D, Sig) -> SE Sig) -> ((D, D) -> (D, Sig)) -> (D, D) -> SE Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (D -> Sig) -> (D, D) -> (D, Sig)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second D -> Sig
sig

instance CpsInstr ((D, Sig) -> SE (Sig, Sig)) where
    type CpsInstrOut ((D, Sig) -> SE (Sig, Sig)) = (Sig, Sig)
    onCps :: ((D, Sig) -> SE (Sig, Sig))
-> (D, D) -> SE (CpsInstrOut ((D, Sig) -> SE (Sig, Sig)))
onCps (D, Sig) -> SE (Sig, Sig)
f = (D, Sig) -> SE (Sig, Sig)
f ((D, Sig) -> SE (Sig, Sig))
-> ((D, D) -> (D, Sig)) -> (D, D) -> SE (Sig, Sig)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (D -> Sig) -> (D, D) -> (D, Sig)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second D -> Sig
sig

instance CpsInstr ((D, Sig) -> Sig) where
    type CpsInstrOut ((D, Sig) -> Sig) = Sig
    onCps :: ((D, Sig) -> Sig) -> (D, D) -> SE (CpsInstrOut ((D, Sig) -> Sig))
onCps (D, Sig) -> Sig
f = Sig -> SE Sig
forall (m :: * -> *) a. Monad m => a -> m a
return (Sig -> SE Sig) -> ((D, D) -> Sig) -> (D, D) -> SE Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (D, Sig) -> Sig
f ((D, Sig) -> Sig) -> ((D, D) -> (D, Sig)) -> (D, D) -> Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (D -> Sig) -> (D, D) -> (D, Sig)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second D -> Sig
sig

instance CpsInstr ((D, Sig) -> (Sig, Sig)) where
    type CpsInstrOut ((D, Sig) -> (Sig, Sig)) = (Sig, Sig)
    onCps :: ((D, Sig) -> (Sig, Sig))
-> (D, D) -> SE (CpsInstrOut ((D, Sig) -> (Sig, Sig)))
onCps (D, Sig) -> (Sig, Sig)
f = (Sig, Sig) -> SE (Sig, Sig)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Sig, Sig) -> SE (Sig, Sig))
-> ((D, D) -> (Sig, Sig)) -> (D, D) -> SE (Sig, Sig)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (D, Sig) -> (Sig, Sig)
f ((D, Sig) -> (Sig, Sig))
-> ((D, D) -> (D, Sig)) -> (D, D) -> (Sig, Sig)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (D -> Sig) -> (D, D) -> (D, Sig)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second D -> Sig
sig

instance CpsInstr ((Sig, D) -> SE Sig) where
    type CpsInstrOut ((Sig, D) -> SE Sig) = Sig
    onCps :: ((Sig, D) -> SE Sig)
-> (D, D) -> SE (CpsInstrOut ((Sig, D) -> SE Sig))
onCps (Sig, D) -> SE Sig
f = (Sig, D) -> SE Sig
f ((Sig, D) -> SE Sig) -> ((D, D) -> (Sig, D)) -> (D, D) -> SE Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (D -> Sig) -> (D, D) -> (Sig, D)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first D -> Sig
sig

instance CpsInstr ((Sig, D) -> SE (Sig, Sig)) where
    type CpsInstrOut ((Sig, D) -> SE (Sig, Sig)) = (Sig, Sig)
    onCps :: ((Sig, D) -> SE (Sig, Sig))
-> (D, D) -> SE (CpsInstrOut ((Sig, D) -> SE (Sig, Sig)))
onCps (Sig, D) -> SE (Sig, Sig)
f = (Sig, D) -> SE (Sig, Sig)
f ((Sig, D) -> SE (Sig, Sig))
-> ((D, D) -> (Sig, D)) -> (D, D) -> SE (Sig, Sig)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (D -> Sig) -> (D, D) -> (Sig, D)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first D -> Sig
sig

instance CpsInstr ((Sig, D) -> Sig) where
    type CpsInstrOut ((Sig, D) -> Sig) = Sig
    onCps :: ((Sig, D) -> Sig) -> (D, D) -> SE (CpsInstrOut ((Sig, D) -> Sig))
onCps (Sig, D) -> Sig
f = Sig -> SE Sig
forall (m :: * -> *) a. Monad m => a -> m a
return (Sig -> SE Sig) -> ((D, D) -> Sig) -> (D, D) -> SE Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sig, D) -> Sig
f ((Sig, D) -> Sig) -> ((D, D) -> (Sig, D)) -> (D, D) -> Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (D -> Sig) -> (D, D) -> (Sig, D)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first D -> Sig
sig

instance CpsInstr ((Sig, D) -> (Sig, Sig)) where
    type CpsInstrOut ((Sig, D) -> (Sig, Sig)) = (Sig, Sig)
    onCps :: ((Sig, D) -> (Sig, Sig))
-> (D, D) -> SE (CpsInstrOut ((Sig, D) -> (Sig, Sig)))
onCps (Sig, D) -> (Sig, Sig)
f = (Sig, Sig) -> SE (Sig, Sig)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Sig, Sig) -> SE (Sig, Sig))
-> ((D, D) -> (Sig, Sig)) -> (D, D) -> SE (Sig, Sig)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sig, D) -> (Sig, Sig)
f ((Sig, D) -> (Sig, Sig))
-> ((D, D) -> (Sig, D)) -> (D, D) -> (Sig, Sig)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (D -> Sig) -> (D, D) -> (Sig, D)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first D -> Sig
sig

instance CpsInstr ((Sig, Sig) -> SE Sig) where
    type CpsInstrOut ((Sig, Sig) -> SE Sig) = Sig
    onCps :: ((Sig, Sig) -> SE Sig)
-> (D, D) -> SE (CpsInstrOut ((Sig, Sig) -> SE Sig))
onCps (Sig, Sig) -> SE Sig
f = (Sig, Sig) -> SE Sig
f ((Sig, Sig) -> SE Sig)
-> ((D, D) -> (Sig, Sig)) -> (D, D) -> SE Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (D -> Sig) -> (D, Sig) -> (Sig, Sig)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first D -> Sig
sig ((D, Sig) -> (Sig, Sig))
-> ((D, D) -> (D, Sig)) -> (D, D) -> (Sig, Sig)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (D -> Sig) -> (D, D) -> (D, Sig)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second D -> Sig
sig

instance CpsInstr ((Sig, Sig) -> SE (Sig, Sig)) where
    type CpsInstrOut ((Sig, Sig) -> SE (Sig, Sig)) = (Sig, Sig)
    onCps :: ((Sig, Sig) -> SE (Sig, Sig))
-> (D, D) -> SE (CpsInstrOut ((Sig, Sig) -> SE (Sig, Sig)))
onCps (Sig, Sig) -> SE (Sig, Sig)
f = (Sig, Sig) -> SE (Sig, Sig)
f ((Sig, Sig) -> SE (Sig, Sig))
-> ((D, D) -> (Sig, Sig)) -> (D, D) -> SE (Sig, Sig)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (D -> Sig) -> (D, Sig) -> (Sig, Sig)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first D -> Sig
sig ((D, Sig) -> (Sig, Sig))
-> ((D, D) -> (D, Sig)) -> (D, D) -> (Sig, Sig)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (D -> Sig) -> (D, D) -> (D, Sig)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second D -> Sig
sig

instance CpsInstr ((Sig, Sig) -> Sig) where
    type CpsInstrOut ((Sig, Sig) -> Sig) = Sig
    onCps :: ((Sig, Sig) -> Sig)
-> (D, D) -> SE (CpsInstrOut ((Sig, Sig) -> Sig))
onCps (Sig, Sig) -> Sig
f = Sig -> SE Sig
forall (m :: * -> *) a. Monad m => a -> m a
return (Sig -> SE Sig) -> ((D, D) -> Sig) -> (D, D) -> SE Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sig, Sig) -> Sig
f ((Sig, Sig) -> Sig) -> ((D, D) -> (Sig, Sig)) -> (D, D) -> Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (D -> Sig) -> (D, Sig) -> (Sig, Sig)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first D -> Sig
sig ((D, Sig) -> (Sig, Sig))
-> ((D, D) -> (D, Sig)) -> (D, D) -> (Sig, Sig)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (D -> Sig) -> (D, D) -> (D, Sig)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second D -> Sig
sig

instance CpsInstr ((Sig, Sig) -> (Sig, Sig)) where
    type CpsInstrOut ((Sig, Sig) -> (Sig, Sig)) = (Sig, Sig)
    onCps :: ((Sig, Sig) -> (Sig, Sig))
-> (D, D) -> SE (CpsInstrOut ((Sig, Sig) -> (Sig, Sig)))
onCps (Sig, Sig) -> (Sig, Sig)
f = (Sig, Sig) -> SE (Sig, Sig)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Sig, Sig) -> SE (Sig, Sig))
-> ((D, D) -> (Sig, Sig)) -> (D, D) -> SE (Sig, Sig)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sig, Sig) -> (Sig, Sig)
f ((Sig, Sig) -> (Sig, Sig))
-> ((D, D) -> (Sig, Sig)) -> (D, D) -> (Sig, Sig)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (D -> Sig) -> (D, Sig) -> (Sig, Sig)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first D -> Sig
sig ((D, Sig) -> (Sig, Sig))
-> ((D, D) -> (D, Sig)) -> (D, D) -> (Sig, Sig)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (D -> Sig) -> (D, D) -> (D, Sig)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second D -> Sig
sig

instance CpsInstr (D -> SE Sig) where
    type CpsInstrOut (D -> SE Sig) = Sig
    onCps :: (D -> SE Sig) -> (D, D) -> SE (CpsInstrOut (D -> SE Sig))
onCps D -> SE Sig
f (D
amp, D
cps) = (Sig -> Sig) -> SE Sig -> SE Sig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* D -> Sig
sig D
amp) (SE Sig -> SE Sig) -> SE Sig -> SE Sig
forall a b. (a -> b) -> a -> b
$ D -> SE Sig
f D
cps

instance CpsInstr (D -> SE (Sig, Sig)) where
    type CpsInstrOut (D -> SE (Sig, Sig)) = (Sig, Sig)
    onCps :: (D -> SE (Sig, Sig))
-> (D, D) -> SE (CpsInstrOut (D -> SE (Sig, Sig)))
onCps D -> SE (Sig, Sig)
f (D
amp, D
cps) = ((Sig, Sig) -> (Sig, Sig)) -> SE (Sig, Sig) -> SE (Sig, Sig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Sig -> Sig) -> (Sig, Sig) -> (Sig, Sig)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* D -> Sig
sig D
amp) ((Sig, Sig) -> (Sig, Sig))
-> ((Sig, Sig) -> (Sig, Sig)) -> (Sig, Sig) -> (Sig, Sig)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sig -> Sig) -> (Sig, Sig) -> (Sig, Sig)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* D -> Sig
sig D
amp)) (SE (Sig, Sig) -> SE (Sig, Sig)) -> SE (Sig, Sig) -> SE (Sig, Sig)
forall a b. (a -> b) -> a -> b
$ D -> SE (Sig, Sig)
f D
cps

instance CpsInstr (D -> Sig) where
    type CpsInstrOut (D -> Sig) = Sig
    onCps :: (D -> Sig) -> (D, D) -> SE (CpsInstrOut (D -> Sig))
onCps D -> Sig
f (D
amp, D
cps) = Sig -> SE Sig
forall (m :: * -> *) a. Monad m => a -> m a
return (Sig -> SE Sig) -> Sig -> SE Sig
forall a b. (a -> b) -> a -> b
$ D -> Sig
sig D
amp Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* D -> Sig
f D
cps

instance CpsInstr (D -> (Sig, Sig)) where
    type CpsInstrOut (D -> (Sig, Sig)) = (Sig, Sig)
    onCps :: (D -> (Sig, Sig)) -> (D, D) -> SE (CpsInstrOut (D -> (Sig, Sig)))
onCps D -> (Sig, Sig)
f (D
amp, D
cps) = (Sig, Sig) -> SE (Sig, Sig)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Sig, Sig) -> SE (Sig, Sig)) -> (Sig, Sig) -> SE (Sig, Sig)
forall a b. (a -> b) -> a -> b
$ (Sig -> Sig) -> (Sig, Sig) -> (Sig, Sig)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* D -> Sig
sig D
amp) ((Sig, Sig) -> (Sig, Sig)) -> (Sig, Sig) -> (Sig, Sig)
forall a b. (a -> b) -> a -> b
$ (Sig -> Sig) -> (Sig, Sig) -> (Sig, Sig)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* D -> Sig
sig D
amp) ((Sig, Sig) -> (Sig, Sig)) -> (Sig, Sig) -> (Sig, Sig)
forall a b. (a -> b) -> a -> b
$ D -> (Sig, Sig)
f D
cps

instance CpsInstr (Sig -> SE Sig) where
    type CpsInstrOut (Sig -> SE Sig) = Sig
    onCps :: (Sig -> SE Sig) -> (D, D) -> SE (CpsInstrOut (Sig -> SE Sig))
onCps Sig -> SE Sig
f (D
amp, D
cps) = (Sig -> Sig) -> SE Sig -> SE Sig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* D -> Sig
sig D
amp) (SE Sig -> SE Sig) -> SE Sig -> SE Sig
forall a b. (a -> b) -> a -> b
$ Sig -> SE Sig
f (Sig -> SE Sig) -> Sig -> SE Sig
forall a b. (a -> b) -> a -> b
$ D -> Sig
sig D
cps

instance CpsInstr (Sig -> SE (Sig, Sig)) where
    type CpsInstrOut (Sig -> SE (Sig, Sig)) = (Sig, Sig)
    onCps :: (Sig -> SE (Sig, Sig))
-> (D, D) -> SE (CpsInstrOut (Sig -> SE (Sig, Sig)))
onCps Sig -> SE (Sig, Sig)
f (D
amp, D
cps) = ((Sig, Sig) -> (Sig, Sig)) -> SE (Sig, Sig) -> SE (Sig, Sig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Sig -> Sig) -> (Sig, Sig) -> (Sig, Sig)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* D -> Sig
sig D
amp) ((Sig, Sig) -> (Sig, Sig))
-> ((Sig, Sig) -> (Sig, Sig)) -> (Sig, Sig) -> (Sig, Sig)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sig -> Sig) -> (Sig, Sig) -> (Sig, Sig)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* D -> Sig
sig D
amp)) (SE (Sig, Sig) -> SE (Sig, Sig)) -> SE (Sig, Sig) -> SE (Sig, Sig)
forall a b. (a -> b) -> a -> b
$ Sig -> SE (Sig, Sig)
f (Sig -> SE (Sig, Sig)) -> Sig -> SE (Sig, Sig)
forall a b. (a -> b) -> a -> b
$ D -> Sig
sig D
cps

instance CpsInstr (Sig -> Sig) where
    type CpsInstrOut (Sig -> Sig) = Sig
    onCps :: (Sig -> Sig) -> (D, D) -> SE (CpsInstrOut (Sig -> Sig))
onCps Sig -> Sig
f (D
amp, D
cps) = Sig -> SE Sig
forall (m :: * -> *) a. Monad m => a -> m a
return (Sig -> SE Sig) -> Sig -> SE Sig
forall a b. (a -> b) -> a -> b
$ D -> Sig
sig D
amp Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig -> Sig
f (D -> Sig
sig D
cps)

instance CpsInstr (Sig -> (Sig, Sig)) where
    type CpsInstrOut (Sig -> (Sig, Sig)) = (Sig, Sig)
    onCps :: (Sig -> (Sig, Sig))
-> (D, D) -> SE (CpsInstrOut (Sig -> (Sig, Sig)))
onCps Sig -> (Sig, Sig)
f (D
amp, D
cps) = (Sig, Sig) -> SE (Sig, Sig)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Sig, Sig) -> SE (Sig, Sig)) -> (Sig, Sig) -> SE (Sig, Sig)
forall a b. (a -> b) -> a -> b
$ (Sig -> Sig) -> (Sig, Sig) -> (Sig, Sig)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* D -> Sig
sig D
amp) ((Sig, Sig) -> (Sig, Sig)) -> (Sig, Sig) -> (Sig, Sig)
forall a b. (a -> b) -> a -> b
$ (Sig -> Sig) -> (Sig, Sig) -> (Sig, Sig)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* D -> Sig
sig D
amp) ((Sig, Sig) -> (Sig, Sig)) -> (Sig, Sig) -> (Sig, Sig)
forall a b. (a -> b) -> a -> b
$ Sig -> (Sig, Sig)
f (Sig -> (Sig, Sig)) -> Sig -> (Sig, Sig)
forall a b. (a -> b) -> a -> b
$ D -> Sig
sig D
cps