{-# Language DeriveFunctor, TypeSynonymInstances, FlexibleInstances #-}
module Csound.Sam.Core (
Sam, runSam, Sample(..), S(..), Dur(..), Bpm,
liftSam, mapBpm, mapBpm2, bindSam, bindBpm, bindBpm2, withBpm
) where
import Control.Applicative
import Control.Monad.Trans.Reader
import Control.Monad.Trans.Class
import Csound.Base
type Sam = Sample Sig2
instance RenderCsd Sam where
renderCsdBy :: Options -> Sam -> IO String
renderCsdBy Options
opt Sam
sample = Options -> SE Sig2 -> IO String
forall a. RenderCsd a => Options -> a -> IO String
renderCsdBy Options
opt (Bpm -> Sam -> SE Sig2
runSam (Bpm
getBpm Bpm -> Bpm -> Bpm
forall a. Num a => a -> a -> a
* Bpm
4) Sam
sample)
csdArity :: Sam -> CsdArity
csdArity Sam
_ = Int -> Int -> CsdArity
CsdArity Int
0 Int
2
instance RenderCsd (Source Sam) where
renderCsdBy :: Options -> Source Sam -> IO String
renderCsdBy Options
opt Source Sam
sample = Options -> Source (SE Sig2) -> IO String
forall a. RenderCsd a => Options -> a -> IO String
renderCsdBy Options
opt ((Sam -> SE Sig2) -> Source Sam -> Source (SE Sig2)
forall a b. (a -> b) -> Source a -> Source b
lift1 (Bpm -> Sam -> SE Sig2
runSam (Bpm
getBpm Bpm -> Bpm -> Bpm
forall a. Num a => a -> a -> a
* Bpm
4)) Source Sam
sample)
csdArity :: Source Sam -> CsdArity
csdArity Source Sam
_ = Int -> Int -> CsdArity
CsdArity Int
0 Int
2
instance RenderCsd (SE Sam) where
renderCsdBy :: Options -> SE Sam -> IO String
renderCsdBy Options
opt SE Sam
sample = Options -> SE Sig2 -> IO String
forall a. RenderCsd a => Options -> a -> IO String
renderCsdBy Options
opt (Bpm -> Sam -> SE Sig2
runSam (Bpm
getBpm Bpm -> Bpm -> Bpm
forall a. Num a => a -> a -> a
* Bpm
4) (Sam -> SE Sig2) -> SE Sam -> SE Sig2
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SE Sam
sample)
csdArity :: SE Sam -> CsdArity
csdArity SE Sam
_ = Int -> Int -> CsdArity
CsdArity Int
0 Int
2
instance RenderCsd (SE (Source Sam)) where
renderCsdBy :: Options -> SE (Source Sam) -> IO String
renderCsdBy Options
opt SE (Source Sam)
sample = Options -> Source (SE Sig2) -> IO String
forall a. RenderCsd a => Options -> a -> IO String
renderCsdBy Options
opt (Source (SE Sig2) -> IO String) -> Source (SE Sig2) -> IO String
forall a b. (a -> b) -> a -> b
$ do
Source Sam
sample' <- SE (Source Sam)
sample
(Sam -> SE Sig2) -> Source Sam -> Source (SE Sig2)
forall a b. (a -> b) -> Source a -> Source b
lift1 (Bpm -> Sam -> SE Sig2
runSam (Bpm
getBpm Bpm -> Bpm -> Bpm
forall a. Num a => a -> a -> a
* Bpm
4)) Source Sam
sample'
csdArity :: SE (Source Sam) -> CsdArity
csdArity SE (Source Sam)
_ = Int -> Int -> CsdArity
CsdArity Int
0 Int
2
runSam :: Bpm -> Sam -> SE Sig2
runSam :: Bpm -> Sam -> SE Sig2
runSam Bpm
bpm Sam
x = (S Sig2 -> Sig2) -> SE (S Sig2) -> SE Sig2
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap S Sig2 -> Sig2
forall a. S a -> a
samSig (SE (S Sig2) -> SE Sig2) -> SE (S Sig2) -> SE Sig2
forall a b. (a -> b) -> a -> b
$ ReaderT Bpm SE (S Sig2) -> Bpm -> SE (S Sig2)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Sam -> ReaderT Bpm SE (S Sig2)
forall a. Sample a -> ReaderT Bpm SE (S a)
unSam Sam
x) Bpm
bpm
data Dur = Dur Sig | InfDur
type Bpm = Sig
newtype Sample a = Sam { Sample a -> ReaderT Bpm SE (S a)
unSam :: ReaderT Bpm SE (S a)
} deriving (a -> Sample b -> Sample a
(a -> b) -> Sample a -> Sample b
(forall a b. (a -> b) -> Sample a -> Sample b)
-> (forall a b. a -> Sample b -> Sample a) -> Functor Sample
forall a b. a -> Sample b -> Sample a
forall a b. (a -> b) -> Sample a -> Sample b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Sample b -> Sample a
$c<$ :: forall a b. a -> Sample b -> Sample a
fmap :: (a -> b) -> Sample a -> Sample b
$cfmap :: forall a b. (a -> b) -> Sample a -> Sample b
Functor)
instance Applicative Sample where
pure :: a -> Sample a
pure = ReaderT Bpm SE (S a) -> Sample a
forall a. ReaderT Bpm SE (S a) -> Sample a
Sam (ReaderT Bpm SE (S a) -> Sample a)
-> (a -> ReaderT Bpm SE (S a)) -> a -> Sample a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. S a -> ReaderT Bpm SE (S a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (S a -> ReaderT Bpm SE (S a))
-> (a -> S a) -> a -> ReaderT Bpm SE (S a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> S a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(Sam ReaderT Bpm SE (S (a -> b))
rf) <*> :: Sample (a -> b) -> Sample a -> Sample b
<*> (Sam ReaderT Bpm SE (S a)
ra) = ReaderT Bpm SE (S b) -> Sample b
forall a. ReaderT Bpm SE (S a) -> Sample a
Sam (ReaderT Bpm SE (S b) -> Sample b)
-> ReaderT Bpm SE (S b) -> Sample b
forall a b. (a -> b) -> a -> b
$ (S (a -> b) -> S a -> S b)
-> ReaderT Bpm SE (S (a -> b))
-> ReaderT Bpm SE (S a)
-> ReaderT Bpm SE (S b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 S (a -> b) -> S a -> S b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) ReaderT Bpm SE (S (a -> b))
rf ReaderT Bpm SE (S a)
ra
data S a = S
{ S a -> a
samSig :: a
, S a -> Dur
samDur :: Dur
} deriving (a -> S b -> S a
(a -> b) -> S a -> S b
(forall a b. (a -> b) -> S a -> S b)
-> (forall a b. a -> S b -> S a) -> Functor S
forall a b. a -> S b -> S a
forall a b. (a -> b) -> S a -> S b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> S b -> S a
$c<$ :: forall a b. a -> S b -> S a
fmap :: (a -> b) -> S a -> S b
$cfmap :: forall a b. (a -> b) -> S a -> S b
Functor)
instance Applicative S where
pure :: a -> S a
pure a
a = a -> Dur -> S a
forall a. a -> Dur -> S a
S a
a Dur
InfDur
(S a -> b
f Dur
df) <*> :: S (a -> b) -> S a -> S b
<*> (S a
a Dur
da) = b -> Dur -> S b
forall a. a -> Dur -> S a
S (a -> b
f a
a) (Dur -> S b) -> Dur -> S b
forall a b. (a -> b) -> a -> b
$ case (Dur
df, Dur
da) of
(Dur Bpm
durF, Dur Bpm
durA) -> Bpm -> Dur
Dur (Bpm -> Dur) -> Bpm -> Dur
forall a b. (a -> b) -> a -> b
$ Bpm -> Bpm -> Bpm
forall a. (IfB a, OrdB a) => a -> a -> a
maxB Bpm
durF Bpm
durA
(Dur, Dur)
_ -> Dur
InfDur
instance Num a => Num (Sample a) where
+ :: Sample a -> Sample a -> Sample a
(+) = (a -> a -> a) -> Sample a -> Sample a -> Sample a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Num a => a -> a -> a
(+)
* :: Sample a -> Sample a -> Sample a
(*) = (a -> a -> a) -> Sample a -> Sample a -> Sample a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Num a => a -> a -> a
(*)
(-) = (a -> a -> a) -> Sample a -> Sample a -> Sample a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (-)
negate :: Sample a -> Sample a
negate = (a -> a) -> Sample a -> Sample a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
negate
abs :: Sample a -> Sample a
abs = (a -> a) -> Sample a -> Sample a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
abs
signum :: Sample a -> Sample a
signum = (a -> a) -> Sample a -> Sample a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
signum
fromInteger :: Integer -> Sample a
fromInteger = a -> Sample a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Sample a) -> (Integer -> a) -> Integer -> Sample a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> a
forall a. Num a => Integer -> a
fromInteger
instance Fractional a => Fractional (Sample a) where
recip :: Sample a -> Sample a
recip = (a -> a) -> Sample a -> Sample a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Fractional a => a -> a
recip
fromRational :: Rational -> Sample a
fromRational = a -> Sample a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Sample a) -> (Rational -> a) -> Rational -> Sample a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> a
forall a. Fractional a => Rational -> a
fromRational
instance SigSpace a => SigSpace (Sample a) where
mapSig :: (Bpm -> Bpm) -> Sample a -> Sample a
mapSig Bpm -> Bpm
f = (a -> a) -> Sample a -> Sample a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Bpm -> Bpm) -> a -> a
forall a. SigSpace a => (Bpm -> Bpm) -> a -> a
mapSig Bpm -> Bpm
f)
instance SigSpace2 a => SigSpace2 (Sample a) where
mapSig2 :: (Sig2 -> Sig2) -> Sample a -> Sample a
mapSig2 Sig2 -> Sig2
f = (a -> a) -> Sample a -> Sample a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Sig2 -> Sig2) -> a -> a
forall a. SigSpace2 a => (Sig2 -> Sig2) -> a -> a
mapSig2 Sig2 -> Sig2
f)
instance BindSig2 a => BindSig2 (Sample a) where
bindSig2 :: (Sig2 -> SE Sig2) -> Sample a -> SE (Sample a)
bindSig2 Sig2 -> SE Sig2
f = Sample a -> SE (Sample a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Sample a -> SE (Sample a))
-> (Sample a -> Sample a) -> Sample a -> SE (Sample a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> SE a) -> Sample a -> Sample a
forall a b. (a -> SE b) -> Sample a -> Sample b
bindSam ((Sig2 -> SE Sig2) -> a -> SE a
forall a. BindSig2 a => (Sig2 -> SE Sig2) -> a -> SE a
bindSig2 Sig2 -> SE Sig2
f)
liftSam :: Sample (SE a) -> Sample a
liftSam :: Sample (SE a) -> Sample a
liftSam (Sam ReaderT Bpm SE (S (SE a))
ra) = ReaderT Bpm SE (S a) -> Sample a
forall a. ReaderT Bpm SE (S a) -> Sample a
Sam (ReaderT Bpm SE (S a) -> Sample a)
-> ReaderT Bpm SE (S a) -> Sample a
forall a b. (a -> b) -> a -> b
$ do
S (SE a)
a <- ReaderT Bpm SE (S (SE a))
ra
SE (S a) -> ReaderT Bpm SE (S a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SE (S a) -> ReaderT Bpm SE (S a))
-> SE (S a) -> ReaderT Bpm SE (S a)
forall a b. (a -> b) -> a -> b
$ (a -> S a) -> SE a -> SE (S a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> S (SE a)
a{ samSig :: a
samSig = a
x}) (SE a -> SE (S a)) -> SE a -> SE (S a)
forall a b. (a -> b) -> a -> b
$ S (SE a) -> SE a
forall a. S a -> a
samSig S (SE a)
a
mapBpm :: (Bpm -> a -> b) -> Sample a -> Sample b
mapBpm :: (Bpm -> a -> b) -> Sample a -> Sample b
mapBpm Bpm -> a -> b
f Sample a
a = ReaderT Bpm SE (S b) -> Sample b
forall a. ReaderT Bpm SE (S a) -> Sample a
Sam (ReaderT Bpm SE (S b) -> Sample b)
-> ReaderT Bpm SE (S b) -> Sample b
forall a b. (a -> b) -> a -> b
$ do
Bpm
bpm <- ReaderT Bpm SE Bpm
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
Sample b -> ReaderT Bpm SE (S b)
forall a. Sample a -> ReaderT Bpm SE (S a)
unSam (Sample b -> ReaderT Bpm SE (S b))
-> Sample b -> ReaderT Bpm SE (S b)
forall a b. (a -> b) -> a -> b
$ (a -> b) -> Sample a -> Sample b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bpm -> a -> b
f Bpm
bpm) Sample a
a
mapBpm2 :: (Bpm -> a -> b -> c) -> Sample a -> Sample b -> Sample c
mapBpm2 :: (Bpm -> a -> b -> c) -> Sample a -> Sample b -> Sample c
mapBpm2 Bpm -> a -> b -> c
f Sample a
a Sample b
b = ReaderT Bpm SE (S c) -> Sample c
forall a. ReaderT Bpm SE (S a) -> Sample a
Sam (ReaderT Bpm SE (S c) -> Sample c)
-> ReaderT Bpm SE (S c) -> Sample c
forall a b. (a -> b) -> a -> b
$ do
Bpm
bpm <- ReaderT Bpm SE Bpm
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
Sample c -> ReaderT Bpm SE (S c)
forall a. Sample a -> ReaderT Bpm SE (S a)
unSam (Sample c -> ReaderT Bpm SE (S c))
-> Sample c -> ReaderT Bpm SE (S c)
forall a b. (a -> b) -> a -> b
$ (a -> b -> c) -> Sample a -> Sample b -> Sample c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (Bpm -> a -> b -> c
f Bpm
bpm) Sample a
a Sample b
b
bindSam :: (a -> SE b) -> Sample a -> Sample b
bindSam :: (a -> SE b) -> Sample a -> Sample b
bindSam a -> SE b
f = Sample (SE b) -> Sample b
forall a. Sample (SE a) -> Sample a
liftSam (Sample (SE b) -> Sample b)
-> (Sample a -> Sample (SE b)) -> Sample a -> Sample b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> SE b) -> Sample a -> Sample (SE b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> SE b
f
bindBpm :: (Bpm -> a -> SE b) -> Sample a -> Sample b
bindBpm :: (Bpm -> a -> SE b) -> Sample a -> Sample b
bindBpm Bpm -> a -> SE b
f Sample a
a = Sample (SE b) -> Sample b
forall a. Sample (SE a) -> Sample a
liftSam (Sample (SE b) -> Sample b) -> Sample (SE b) -> Sample b
forall a b. (a -> b) -> a -> b
$ (Bpm -> a -> SE b) -> Sample a -> Sample (SE b)
forall a b. (Bpm -> a -> b) -> Sample a -> Sample b
mapBpm Bpm -> a -> SE b
f Sample a
a
bindBpm2 :: (Bpm -> a -> b -> SE c) -> Sample a -> Sample b -> Sample c
bindBpm2 :: (Bpm -> a -> b -> SE c) -> Sample a -> Sample b -> Sample c
bindBpm2 Bpm -> a -> b -> SE c
f Sample a
a Sample b
b = Sample (SE c) -> Sample c
forall a. Sample (SE a) -> Sample a
liftSam (Sample (SE c) -> Sample c) -> Sample (SE c) -> Sample c
forall a b. (a -> b) -> a -> b
$ (Bpm -> a -> b -> SE c) -> Sample a -> Sample b -> Sample (SE c)
forall a b c.
(Bpm -> a -> b -> c) -> Sample a -> Sample b -> Sample c
mapBpm2 Bpm -> a -> b -> SE c
f Sample a
a Sample b
b
withBpm :: (Bpm -> Sample a) -> Sample a
withBpm :: (Bpm -> Sample a) -> Sample a
withBpm Bpm -> Sample a
x = ReaderT Bpm SE (S a) -> Sample a
forall a. ReaderT Bpm SE (S a) -> Sample a
Sam (ReaderT Bpm SE (S a) -> Sample a)
-> ReaderT Bpm SE (S a) -> Sample a
forall a b. (a -> b) -> a -> b
$ do
Bpm
bpm <- ReaderT Bpm SE Bpm
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
Sample a -> ReaderT Bpm SE (S a)
forall a. Sample a -> ReaderT Bpm SE (S a)
unSam (Sample a -> ReaderT Bpm SE (S a))
-> Sample a -> ReaderT Bpm SE (S a)
forall a b. (a -> b) -> a -> b
$ Bpm -> Sample a
x Bpm
bpm