-- | The core types/ They are not imported by default.
{-# 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

-- | The main type. A stereo sample.
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

-- | The Beats Per Minute measure (BPM). Almost all values are measured in BPMs.
type Bpm = Sig

-- | The generic type for samples.
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)

-- Lifters

-- | Hides the effects inside sample.
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

-- | Transforms the sample with BPM.
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

-- | Transforms the sample with BPM.
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

-- | Lifts bind on stereo signals to samples.
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

-- | Lifts bind on stereo signals to samples with BPM.
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

-- | Lifts bind on stereo signals to samples with BPM.
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