{-# LANGUAGE MultiWayIf #-}
module FRP.Dunai.Stream where

import Data.MonadicStreamFunction
import Data.MonadicStreamFunction.InternalCore (unMSF)
import Control.Monad.Trans.MSF.Reader

-- * Types
type SignalSampleStream a = SampleStream (DTime, a)
type SampleStream a = [a]
type DTime    = Double


-- ** Creation

-- | Group a series of samples with a series of time deltas.
--
--   The first sample will have no delta. Unused samples and deltas will be
--   dropped.
groupDeltas :: [a] -> [DTime] -> SignalSampleStream a
groupDeltas :: [a] -> [DTime] -> SignalSampleStream a
groupDeltas [a]
xs [DTime]
ds = [DTime] -> [a] -> SignalSampleStream a
forall a b. [a] -> [b] -> [(a, b)]
zip (DTime
0DTime -> [DTime] -> [DTime]
forall a. a -> [a] -> [a]
:[DTime]
ds) [a]
xs

-- * Obtain samples

-- | Turn a stream with sampling times into a list of values.
samples :: SignalSampleStream a -> [a]
samples :: SignalSampleStream a -> [a]
samples = ((DTime, a) -> a) -> SignalSampleStream a -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (DTime, a) -> a
forall a b. (a, b) -> b
snd

firstSample :: SignalSampleStream a -> a
firstSample :: SignalSampleStream a -> a
firstSample = [a] -> a
forall a. [a] -> a
head ([a] -> a)
-> (SignalSampleStream a -> [a]) -> SignalSampleStream a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignalSampleStream a -> [a]
forall a. SignalSampleStream a -> [a]
samples

lastSample :: SignalSampleStream a -> a
lastSample :: SignalSampleStream a -> a
lastSample = [a] -> a
forall a. [a] -> a
last ([a] -> a)
-> (SignalSampleStream a -> [a]) -> SignalSampleStream a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignalSampleStream a -> [a]
forall a. SignalSampleStream a -> [a]
samples

-- * Stream manipulation

-- ** Merging

sMerge :: (a -> a -> a) -> SignalSampleStream a -> SignalSampleStream a -> SignalSampleStream a
sMerge :: (a -> a -> a)
-> SignalSampleStream a
-> SignalSampleStream a
-> SignalSampleStream a
sMerge a -> a -> a
f []              SignalSampleStream a
xs2             = SignalSampleStream a
xs2
sMerge a -> a -> a
f SignalSampleStream a
xs1             []              = SignalSampleStream a
xs1
sMerge a -> a -> a
f ((DTime
dt1, a
x1):SignalSampleStream a
xs1) ((DTime
dt2, a
x2):SignalSampleStream a
xs2)
  | DTime
dt1 DTime -> DTime -> Bool
forall a. Eq a => a -> a -> Bool
== DTime
dt2 = (DTime
dt1, a -> a -> a
f a
x1 a
x2) (DTime, a) -> SignalSampleStream a -> SignalSampleStream a
forall a. a -> [a] -> [a]
: (a -> a -> a)
-> SignalSampleStream a
-> SignalSampleStream a
-> SignalSampleStream a
forall a.
(a -> a -> a)
-> SignalSampleStream a
-> SignalSampleStream a
-> SignalSampleStream a
sMerge a -> a -> a
f SignalSampleStream a
xs1 SignalSampleStream a
xs2
  | DTime
dt1 DTime -> DTime -> Bool
forall a. Ord a => a -> a -> Bool
<  DTime
dt2 = (DTime
dt1, a
x1) (DTime, a) -> SignalSampleStream a -> SignalSampleStream a
forall a. a -> [a] -> [a]
: (a -> a -> a)
-> SignalSampleStream a
-> SignalSampleStream a
-> SignalSampleStream a
forall a.
(a -> a -> a)
-> SignalSampleStream a
-> SignalSampleStream a
-> SignalSampleStream a
sMerge a -> a -> a
f SignalSampleStream a
xs1 ((DTime
dt2DTime -> DTime -> DTime
forall a. Num a => a -> a -> a
-DTime
dt1, a
x2)(DTime, a) -> SignalSampleStream a -> SignalSampleStream a
forall a. a -> [a] -> [a]
:SignalSampleStream a
xs2)
  | Bool
otherwise  = (DTime
dt2, a
x2) (DTime, a) -> SignalSampleStream a -> SignalSampleStream a
forall a. a -> [a] -> [a]
: (a -> a -> a)
-> SignalSampleStream a
-> SignalSampleStream a
-> SignalSampleStream a
forall a.
(a -> a -> a)
-> SignalSampleStream a
-> SignalSampleStream a
-> SignalSampleStream a
sMerge a -> a -> a
f ((DTime
dt1DTime -> DTime -> DTime
forall a. Num a => a -> a -> a
-DTime
dt2, a
x1)(DTime, a) -> SignalSampleStream a -> SignalSampleStream a
forall a. a -> [a] -> [a]
:SignalSampleStream a
xs1) SignalSampleStream a
xs2

-- ** Concatenating

sConcat :: SignalSampleStream a -> SignalSampleStream a -> SignalSampleStream a
sConcat :: SignalSampleStream a
-> SignalSampleStream a -> SignalSampleStream a
sConcat SignalSampleStream a
xs1 SignalSampleStream a
xs2 = SignalSampleStream a
xs1 SignalSampleStream a
-> SignalSampleStream a -> SignalSampleStream a
forall a. [a] -> [a] -> [a]
++ SignalSampleStream a
xs2

-- ** Refining
sRefine :: DTime -> a -> SignalSampleStream a -> SignalSampleStream a
sRefine :: DTime -> a -> SignalSampleStream a -> SignalSampleStream a
sRefine DTime
maxDT a
_ [] = []
sRefine DTime
maxDT a
a0 ((DTime
dt, a
a):SignalSampleStream a
as)
  | DTime
dt DTime -> DTime -> Bool
forall a. Ord a => a -> a -> Bool
> DTime
maxDT = (DTime
maxDT, a
a0) (DTime, a) -> SignalSampleStream a -> SignalSampleStream a
forall a. a -> [a] -> [a]
: DTime -> a -> SignalSampleStream a -> SignalSampleStream a
forall a.
DTime -> a -> SignalSampleStream a -> SignalSampleStream a
sRefine DTime
maxDT a
a0 ((DTime
dt DTime -> DTime -> DTime
forall a. Num a => a -> a -> a
- DTime
maxDT, a
a)(DTime, a) -> SignalSampleStream a -> SignalSampleStream a
forall a. a -> [a] -> [a]
:SignalSampleStream a
as)
  | Bool
otherwise  = (DTime
dt, a
a) (DTime, a) -> SignalSampleStream a -> SignalSampleStream a
forall a. a -> [a] -> [a]
: DTime -> a -> SignalSampleStream a -> SignalSampleStream a
forall a.
DTime -> a -> SignalSampleStream a -> SignalSampleStream a
sRefine DTime
maxDT a
a SignalSampleStream a
as

refineWith :: (a -> a -> a) -> DTime -> a -> SignalSampleStream a -> SignalSampleStream a
refineWith :: (a -> a -> a)
-> DTime -> a -> SignalSampleStream a -> SignalSampleStream a
refineWith a -> a -> a
interpolate DTime
maxDT a
_  [] = []
refineWith a -> a -> a
interpolate DTime
maxDT a
a0 ((DTime
dt, a
a):SignalSampleStream a
as)
  | DTime
dt DTime -> DTime -> Bool
forall a. Ord a => a -> a -> Bool
> DTime
maxDT = let a' :: a
a' = a -> a -> a
interpolate a
a0 a
a
                 in (DTime
maxDT, a -> a -> a
interpolate a
a0 a
a) (DTime, a) -> SignalSampleStream a -> SignalSampleStream a
forall a. a -> [a] -> [a]
: (a -> a -> a)
-> DTime -> a -> SignalSampleStream a -> SignalSampleStream a
forall a.
(a -> a -> a)
-> DTime -> a -> SignalSampleStream a -> SignalSampleStream a
refineWith a -> a -> a
interpolate DTime
maxDT a
a' ((DTime
dt DTime -> DTime -> DTime
forall a. Num a => a -> a -> a
- DTime
maxDT, a
a)(DTime, a) -> SignalSampleStream a -> SignalSampleStream a
forall a. a -> [a] -> [a]
:SignalSampleStream a
as)
  | Bool
otherwise  = (DTime
dt, a
a) (DTime, a) -> SignalSampleStream a -> SignalSampleStream a
forall a. a -> [a] -> [a]
: (a -> a -> a)
-> DTime -> a -> SignalSampleStream a -> SignalSampleStream a
forall a.
(a -> a -> a)
-> DTime -> a -> SignalSampleStream a -> SignalSampleStream a
refineWith a -> a -> a
interpolate DTime
maxDT a
a SignalSampleStream a
as

-- ** Clipping (dropping samples)

sClipAfterFrame :: Int -> SignalSampleStream a -> SignalSampleStream a
sClipAfterFrame :: Int -> SignalSampleStream a -> SignalSampleStream a
sClipAfterFrame = Int -> SignalSampleStream a -> SignalSampleStream a
forall a. Int -> [a] -> [a]
take

sClipAfterTime :: t -> [(t, b)] -> [(t, b)]
sClipAfterTime t
dt [] = []
sClipAfterTime t
dt ((t
dt',b
x):[(t, b)]
xs)
  | t
dt t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
dt'  = []
  | Bool
otherwise = (t
dt', b
x) (t, b) -> [(t, b)] -> [(t, b)]
forall a. a -> [a] -> [a]
: t -> [(t, b)] -> [(t, b)]
sClipAfterTime (t
dt t -> t -> t
forall a. Num a => a -> a -> a
- t
dt') [(t, b)]
xs

sClipBeforeFrame :: Int -> SignalSampleStream a -> SignalSampleStream a
sClipBeforeFrame :: Int -> SignalSampleStream a -> SignalSampleStream a
sClipBeforeFrame Int
0 xs :: SignalSampleStream a
xs@((DTime, a)
_:SignalSampleStream a
_) = SignalSampleStream a
xs
sClipBeforeFrame Int
n xs :: SignalSampleStream a
xs@[(DTime, a)
x]   = SignalSampleStream a
xs
sClipBeforeFrame Int
n SignalSampleStream a
xs       = Int -> SignalSampleStream a -> SignalSampleStream a
forall a. Int -> SignalSampleStream a -> SignalSampleStream a
sClipBeforeFrame (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) SignalSampleStream a
xs

sClipBeforeTime  :: DTime -> SignalSampleStream a -> SignalSampleStream a
sClipBeforeTime :: DTime -> SignalSampleStream a -> SignalSampleStream a
sClipBeforeTime DTime
dt SignalSampleStream a
xs
  | DTime
dt DTime -> DTime -> Bool
forall a. Ord a => a -> a -> Bool
<= DTime
0   = SignalSampleStream a
xs
  | Bool
otherwise = case SignalSampleStream a
xs of
                  [(DTime, a)
x]              -> SignalSampleStream a
xs
                  ((DTime, a)
_:(DTime
dt',a
x'):SignalSampleStream a
xs') -> if | DTime
dt DTime -> DTime -> Bool
forall a. Ord a => a -> a -> Bool
< DTime
dt'  -> ((DTime
dt'DTime -> DTime -> DTime
forall a. Num a => a -> a -> a
- DTime
dt, a
x')(DTime, a) -> SignalSampleStream a -> SignalSampleStream a
forall a. a -> [a] -> [a]
:SignalSampleStream a
xs')
                                         | Bool
otherwise -> DTime -> SignalSampleStream a -> SignalSampleStream a
forall a. DTime -> SignalSampleStream a -> SignalSampleStream a
sClipBeforeTime (DTime
dt DTime -> DTime -> DTime
forall a. Num a => a -> a -> a
- DTime
dt') ((DTime
0,a
x')(DTime, a) -> SignalSampleStream a -> SignalSampleStream a
forall a. a -> [a] -> [a]
:SignalSampleStream a
xs')


evalSF :: Monad m
       => MSF (ReaderT DTime m) a b
       -> SignalSampleStream a
       -> m (SampleStream b, MSF (ReaderT DTime m) a b)
evalSF :: MSF (ReaderT DTime m) a b
-> SignalSampleStream a
-> m (SampleStream b, MSF (ReaderT DTime m) a b)
evalSF MSF (ReaderT DTime m) a b
fsf SignalSampleStream a
as = do
  let msf'' :: MSF m (DTime, a) b
msf'' = MSF (ReaderT DTime m) a b -> MSF m (DTime, a) b
forall (m :: * -> *) r a b.
Monad m =>
MSF (ReaderT r m) a b -> MSF m (r, a) b
runReaderS MSF (ReaderT DTime m) a b
fsf
  (SampleStream b
ss, MSF m (DTime, a) b
msf') <- MSF m (DTime, a) b
-> SignalSampleStream a -> m (SampleStream b, MSF m (DTime, a) b)
forall (m :: * -> *) a b.
Monad m =>
MSF m a b -> SampleStream a -> m (SampleStream b, MSF m a b)
evalMSF MSF m (DTime, a) b
msf'' SignalSampleStream a
as
  (SampleStream b, MSF (ReaderT DTime m) a b)
-> m (SampleStream b, MSF (ReaderT DTime m) a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (SampleStream b
ss, MSF m (DTime, a) b -> MSF (ReaderT DTime m) a b
forall (m :: * -> *) r a b.
Monad m =>
MSF m (r, a) b -> MSF (ReaderT r m) a b
readerS MSF m (DTime, a) b
msf')


evalMSF :: Monad m
        => MSF m a b
       -> SampleStream a
       -> m (SampleStream b, MSF m a b)
evalMSF :: MSF m a b -> SampleStream a -> m (SampleStream b, MSF m a b)
evalMSF MSF m a b
fsf [] = (SampleStream b, MSF m a b) -> m (SampleStream b, MSF m a b)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], MSF m a b
fsf)
evalMSF MSF m a b
fsf (a
a:SampleStream a
as) = do
  (b
b, MSF m a b
fsf')   <- MSF m a b -> a -> m (b, MSF m a b)
forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF MSF m a b
fsf a
a
  (SampleStream b
bs, MSF m a b
fsf'') <- MSF m a b -> SampleStream a -> m (SampleStream b, MSF m a b)
forall (m :: * -> *) a b.
Monad m =>
MSF m a b -> SampleStream a -> m (SampleStream b, MSF m a b)
evalMSF MSF m a b
fsf' SampleStream a
as
  let outputStrm :: SampleStream b
outputStrm  = b
b b -> SampleStream b -> SampleStream b
forall a. a -> [a] -> [a]
: SampleStream b
bs
  (SampleStream b, MSF m a b) -> m (SampleStream b, MSF m a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (SampleStream b
outputStrm, MSF m a b
fsf'')