Stream.hs

{-# LANGUAGE MultiWayIf #-}
-- | Streams and stream manipulation API.
--
-- The evaluation of Yampa SFs, especially for testing purposes, needs the
-- generation of suitable input streams.
--
-- While some streams can be generated randomly using QuickCheck, it is
-- sometimes useful to be able to preprend or adapt an input stream. It is also
-- useful to debug programs when you have recorded input streams using Haskell
-- Titan.
--
-- This module defines types for input streams, as well as an API to create,
-- examine and combine streams. It also provides evaluation functions that are
-- needed to apply an SF to a stream and obtain an output stream and a
-- continuation SF.
module FRP.Yampa.Stream where

import FRP.Yampa (DTime, SF, FutureSF, evalAtZero, evalAt)

-- * Types

-- | A stream of samples, with their sampling times.
type SignalSampleStream a = (a, FutureSampleStream a)

-- | A stream of future samples, with their sampling times. The difference
-- between 'SignalSampleStream' and 'FutureSampleStream' is that all elements
-- in the latter have a non-zero time delta.
type FutureSampleStream a = [(DTime, a)]

-- * 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 (x:xs) ds = (x, zip ds xs)
groupDeltas xs     ds = error $ "groupDeltas: called me with lists with lengths" ++ show (length xs) ++ " and " ++ show (length ds)

-- * Examination

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

-- | Return the first sample in a sample stream.
firstSample :: SignalSampleStream a -> a
firstSample = head . samples

-- | Return the last sample in a sample stream.
lastSample :: SignalSampleStream a -> a
lastSample = last . samples

-- * Manipulation

-- | Merge two streams, using an auxilary function to merge samples that fall
-- at the exact same sampling time.
sMerge :: (a -> a -> a) -> SignalSampleStream a -> SignalSampleStream a -> SignalSampleStream a
sMerge f (x1, xs1) (x2, xs2) = (f x1 x2, sMergeTail f xs1 xs2)
  where
    sMergeTail :: (a -> a -> a) -> FutureSampleStream a -> FutureSampleStream a -> FutureSampleStream a
    sMergeTail f []              xs2             = xs2
    sMergeTail f xs1             []              = xs1
    sMergeTail f ((dt1, x1):xs1) ((dt2, x2):xs2)
      | dt1 == dt2 = (dt1, f x1 x2) : sMergeTail f xs1 xs2
      | dt1 <  dt2 = (dt1, x1) : sMergeTail f xs1 ((dt2-dt1, x2):xs2)
      | otherwise  = (dt2, x2) : sMergeTail f ((dt1-dt2, x1):xs1) xs2

-- | Concatenate two sample streams, separating them by a given time delta.
sConcat :: SignalSampleStream a -> DTime -> SignalSampleStream a -> SignalSampleStream a
sConcat (x1, xs1) dt (x2, xs2) = (x1 , xs1 ++ ((dt, x2):xs2))

-- | Refine a stream by establishing the maximum time delta.
--
-- If two samples are separated by a time delta bigger than the given max DT,
-- the former is replicated as many times as necessary.
sRefine :: DTime -> SignalSampleStream a -> SignalSampleStream a
sRefine maxDT (a, as) = (a, sRefineFutureStream maxDT a as)
  where
    sRefineFutureStream :: DTime -> a -> FutureSampleStream a -> FutureSampleStream a
    sRefineFutureStream maxDT _ [] = []
    sRefineFutureStream maxDT a0 ((dt, a):as)
      | dt > maxDT = (maxDT, a0) : sRefineFutureStream maxDT a0 ((dt - maxDT, a):as)
      | otherwise  = (dt, a) : sRefineFutureStream maxDT a as

-- | Refine a stream by establishing the maximum time delta.
--
-- If two samples are separated by a time delta bigger than the given max DT,
-- the auxiliary interpolation function is used to determine the intermendiate
-- sample.
sRefineWith :: (a -> a -> a) -> DTime -> SignalSampleStream a -> SignalSampleStream a
sRefineWith interpolate maxDT (a, as) = (a, refineFutureStreamWith interpolate maxDT a as)
  where
    refineFutureStreamWith :: (a -> a -> a) -> DTime -> a -> FutureSampleStream a -> FutureSampleStream a
    refineFutureStreamWith interpolate maxDT _  [] = []
    refineFutureStreamWith interpolate maxDT a0 ((dt, a):as)
      | dt > maxDT = let a' = interpolate a0 a
                     in (maxDT, interpolate a0 a) : refineFutureStreamWith interpolate maxDT a' ((dt - maxDT, a):as)
      | otherwise  = (dt, a) : refineFutureStreamWith interpolate maxDT a as

-- | Clip a sample stream at a given number of samples.
sClipAfterFrame  :: Int -> SignalSampleStream a -> SignalSampleStream a
sClipAfterFrame  0 (x,_)  = (x, [])
sClipAfterFrame  n (x,xs) = (x, xs')
  where
    xs' = take (n-1) xs

-- | Clip a sample stream after a certain (non-zero) time.
sClipAfterTime   :: DTime -> SignalSampleStream a -> SignalSampleStream a
sClipAfterTime dt (x,xs) = (x, sClipAfterTime' dt xs)
  where
    sClipAfterTime' dt [] = []
    sClipAfterTime' dt ((dt',x):xs)
      | dt < dt'  = []
      | otherwise = ((dt',x):sClipAfterTime' (dt - dt') xs)

-- | Drop the first n samples of a signal stream. The time
-- deltas are not re-calculated.
sClipBeforeFrame :: Int -> SignalSampleStream a -> SignalSampleStream a
sClipBeforeFrame 0 (x,xs) = (x,xs)
sClipBeforeFrame n (x,[]) = (x,[])
sClipBeforeFrame n (_,(dt,x):xs) = sClipBeforeFrame (n-1) (x, xs)

-- | Drop the first samples of a signal stream up to a given time. The time
-- deltas are not re-calculated to match the original stream.
sClipBeforeTime  :: DTime -> SignalSampleStream a -> SignalSampleStream a
sClipBeforeTime dt xs
  | dt <= 0   = xs
  | otherwise = case xs of
                  (x,[])           -> (x,[])
                  (_,(dt',x'):xs') -> if | dt < dt'  -> -- (dt' - dt, x'):xs'
                                                        (x',xs')
                                         | otherwise -> sClipBeforeTime (dt - dt') (x', xs')

-- ** Stream-based evaluation

-- | Evaluate an SF with a 'SignalSampleStream', obtaining an output
-- stream and a continuation.
--
-- You should never use this for actual execution in your applications,
-- only for testing.
evalSF :: SF a b
       -> SignalSampleStream a
       -> (SignalSampleStream b, FutureSF a b)
evalSF sf (a, as) = (outputStrm, fsf')
  where (b,  fsf)  = evalAtZero sf a
        (bs, fsf') = evalFutureSF fsf as
        outputStrm = (b, bs)

-- | Evaluate an initialised SF with a 'FutureSampleStream', obtaining
-- an output stream and a continuation.
--
-- You should never use this for actual execution in your applications,
-- only for testing.
evalFutureSF :: FutureSF a b
             -> FutureSampleStream a
             -> (FutureSampleStream b, FutureSF a b)
evalFutureSF fsf [] = ([], fsf)
evalFutureSF fsf ((dt, a):as) = (outputStrm, fsf'')
  where (b, fsf')   = evalAt fsf dt a
        (bs, fsf'') = evalFutureSF fsf' as
        outputStrm  = (dt, b) : bs