{- |
Utilities to create 'ClSF's.
The fundamental effect that 'ClSF's have is
reading the time information of the clock.
It can be used for many purposes, for example digital signal processing.
-}

{-# LANGUAGE Arrows #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}

module FRP.Rhine.ClSF.Util where


-- base
import Control.Arrow
import Control.Category (Category)
import qualified Control.Category (id)
import Data.Maybe (fromJust)
import Data.Monoid (Last (Last), getLast)

-- containers
import Data.Sequence

-- transformers
import Control.Monad.Trans.Reader (ask, asks)

-- dunai
import Control.Monad.Trans.MSF.Reader (readerS)
import Data.MonadicStreamFunction.Instances.VectorSpace ()

-- simple-affine-space
import Data.VectorSpace

-- rhine
import FRP.Rhine.ClSF.Core
import FRP.Rhine.ClSF.Except


-- * Read time information

-- | Read the environment variable, i.e. the 'TimeInfo'.
timeInfo :: Monad m => ClSF m cl a (TimeInfo cl)
timeInfo :: ClSF m cl a (TimeInfo cl)
timeInfo = ReaderT (TimeInfo cl) m (TimeInfo cl) -> ClSF m cl a (TimeInfo cl)
forall (m :: Type -> Type) b a. Monad m => m b -> MSF m a b
constM ReaderT (TimeInfo cl) m (TimeInfo cl)
forall (m :: Type -> Type) r. Monad m => ReaderT r m r
ask

{- | Utility to apply functions to the current 'TimeInfo',
such as record selectors:
@
printAbsoluteTime :: ClSF IO cl () ()
printAbsoluteTime = timeInfoOf absolute >>> arrMCl print
@
-}
timeInfoOf :: Monad m => (TimeInfo cl -> b) -> ClSF m cl a b
timeInfoOf :: (TimeInfo cl -> b) -> ClSF m cl a b
timeInfoOf TimeInfo cl -> b
f = ReaderT (TimeInfo cl) m b -> ClSF m cl a b
forall (m :: Type -> Type) b a. Monad m => m b -> MSF m a b
constM (ReaderT (TimeInfo cl) m b -> ClSF m cl a b)
-> ReaderT (TimeInfo cl) m b -> ClSF m cl a b
forall a b. (a -> b) -> a -> b
$ (TimeInfo cl -> b) -> ReaderT (TimeInfo cl) m b
forall (m :: Type -> Type) r a.
Monad m =>
(r -> a) -> ReaderT r m a
asks TimeInfo cl -> b
f

-- | Continuously return the time difference since the last tick.
sinceLastS :: Monad m => ClSF m cl a (Diff (Time cl))
sinceLastS :: ClSF m cl a (Diff (Time cl))
sinceLastS = (TimeInfo cl -> Diff (Time cl)) -> ClSF m cl a (Diff (Time cl))
forall (m :: Type -> Type) cl b a.
Monad m =>
(TimeInfo cl -> b) -> ClSF m cl a b
timeInfoOf TimeInfo cl -> Diff (Time cl)
forall cl. TimeInfo cl -> Diff (Time cl)
sinceLast

-- | Continuously return the time difference since clock initialisation.
sinceInitS :: Monad m => ClSF m cl a (Diff (Time cl))
sinceInitS :: ClSF m cl a (Diff (Time cl))
sinceInitS = (TimeInfo cl -> Diff (Time cl)) -> ClSF m cl a (Diff (Time cl))
forall (m :: Type -> Type) cl b a.
Monad m =>
(TimeInfo cl -> b) -> ClSF m cl a b
timeInfoOf TimeInfo cl -> Diff (Time cl)
forall cl. TimeInfo cl -> Diff (Time cl)
sinceInit

-- | Continuously return the absolute time.
absoluteS :: Monad m => ClSF m cl a (Time cl)
absoluteS :: ClSF m cl a (Time cl)
absoluteS = (TimeInfo cl -> Time cl) -> ClSF m cl a (Time cl)
forall (m :: Type -> Type) cl b a.
Monad m =>
(TimeInfo cl -> b) -> ClSF m cl a b
timeInfoOf TimeInfo cl -> Time cl
forall cl. TimeInfo cl -> Time cl
absolute

-- | Continuously return the tag of the current tick.
tagS :: Monad m => ClSF m cl a (Tag cl)
tagS :: ClSF m cl a (Tag cl)
tagS = (TimeInfo cl -> Tag cl) -> ClSF m cl a (Tag cl)
forall (m :: Type -> Type) cl b a.
Monad m =>
(TimeInfo cl -> b) -> ClSF m cl a b
timeInfoOf TimeInfo cl -> Tag cl
forall cl. TimeInfo cl -> Tag cl
tag

{- |
Calculate the time passed since this 'ClSF' was instantiated.
This is _not_ the same as 'sinceInitS',
which measures the time since clock initialisation.

For example, the following gives a sawtooth signal:

@
sawtooth = safely $ do
  try $ sinceStart >>> proc time -> do
    throwOn () -< time > 1
    returnA    -< time
  safe sawtooth
@

If you replace 'sinceStart' by 'sinceInitS',
it will usually hang after one second,
since it doesn't reset after restarting the sawtooth.
-}
sinceStart :: (Monad m, TimeDomain time) => BehaviourF m time a (Diff time)
sinceStart :: BehaviourF m time a (Diff time)
sinceStart = MSF (ReaderT (TimeInfo cl) m) a time
forall (m :: Type -> Type) cl a. Monad m => ClSF m cl a (Time cl)
absoluteS MSF (ReaderT (TimeInfo cl) m) a time
-> MSF (ReaderT (TimeInfo cl) m) time (Diff time)
-> MSF (ReaderT (TimeInfo cl) m) a (Diff time)
forall k (cat :: k -> k -> Type) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> proc time
time -> do
  time
startTime <- ClSF m cl time time
forall (m :: Type -> Type) cl a. Monad m => ClSF m cl a a
keepFirst -< time
time
  MSF (ReaderT (TimeInfo cl) m) (Diff time) (Diff time)
forall (a :: Type -> Type -> Type) b. Arrow a => a b b
returnA                -< time
time time -> time -> Diff time
forall time. TimeDomain time => time -> time -> Diff time
`diffTime` time
startTime


-- * Useful aliases

-- TODO Is it cleverer to generalise to Arrow?
{- | Alias for 'Control.Category.>>>' (sequential composition)
with higher operator precedence, designed to work with the other operators, e.g.:

> clsf1 >-> clsf2 @@ clA ||@ sched @|| clsf3 >-> clsf4 @@ clB

The type signature specialises e.g. to

> (>->) :: Monad m => ClSF m cl a b -> ClSF m cl b c -> ClSF m cl a c
-}
infixr 6 >->
(>->) :: Category cat
      => cat a b
      -> cat   b c
      -> cat a   c
>-> :: cat a b -> cat b c -> cat a c
(>->) = cat a b -> cat b c -> cat a c
forall k (cat :: k -> k -> Type) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
(>>>)

-- | Alias for 'Control.Category.<<<'.
infixl 6 <-<
(<-<) :: Category cat
      => cat   b c
      -> cat a b
      -> cat a   c
<-< :: cat b c -> cat a b -> cat a c
(<-<) = cat b c -> cat a b -> cat a c
forall k (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
(<<<)

{- | Output a constant value.
Specialises e.g. to this type signature:

> arr_ :: Monad m => b -> ClSF m cl a b
-}
arr_ :: Arrow a => b -> a c b
arr_ :: b -> a c b
arr_ = (c -> b) -> a c b
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr ((c -> b) -> a c b) -> (b -> c -> b) -> b -> a c b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> c -> b
forall a b. a -> b -> a
const


-- | The identity synchronous stream function.
clId :: Monad m => ClSF m cl a a
clId :: ClSF m cl a a
clId = ClSF m cl a a
forall k (cat :: k -> k -> Type) (a :: k). Category cat => cat a a
Control.Category.id


-- * Basic signal processing components

-- ** Integration and differentiation

-- | The output of @integralFrom v0@ is the numerical Euler integral
--   of the input, with initial offset @v0@.
integralFrom
  :: ( Monad m, VectorSpace v s
     , s ~ Diff td)
  => v -> BehaviorF m td v v
integralFrom :: v -> BehaviorF m td v v
integralFrom v
v0 = proc v
v -> do
  s
_sinceLast <- (TimeInfo cl -> s) -> ClSF m cl () s
forall (m :: Type -> Type) cl b a.
Monad m =>
(TimeInfo cl -> b) -> ClSF m cl a b
timeInfoOf TimeInfo cl -> s
forall cl. TimeInfo cl -> Diff (Time cl)
sinceLast -< ()
  v -> MSF (ReaderT (TimeInfo cl) m) v v
forall v s (m :: Type -> Type).
(VectorSpace v s, Monad m) =>
v -> MSF m v v
sumFrom v
v0                         -< s
_sinceLast s -> v -> v
forall v a. VectorSpace v a => a -> v -> v
*^ v
v

-- | Euler integration, with zero initial offset.
integral
  :: ( Monad m, VectorSpace v s
     , s ~ Diff td)
  => BehaviorF m td v v
integral :: BehaviorF m td v v
integral = v -> BehaviorF m td v v
forall (m :: Type -> Type) v s td.
(Monad m, VectorSpace v s, s ~ Diff td) =>
v -> BehaviorF m td v v
integralFrom v
forall v a. VectorSpace v a => v
zeroVector


-- | The output of @derivativeFrom v0@ is the numerical derivative of the input,
--   with a Newton difference quotient.
--   The input is initialised with @v0@.
derivativeFrom
  :: ( Monad m, VectorSpace v s
     , s ~ Diff td)
  => v -> BehaviorF m td v v
derivativeFrom :: v -> BehaviorF m td v v
derivativeFrom v
v0 = proc v
v -> do
  v
vLast         <- v -> MSF (ReaderT (TimeInfo cl) m) v v
forall (m :: Type -> Type) a. Monad m => a -> MSF m a a
iPre v
v0  -< v
v
  TimeInfo {Diff (Time cl)
Time cl
Tag cl
tag :: Tag cl
absolute :: Time cl
sinceInit :: Diff (Time cl)
sinceLast :: Diff (Time cl)
tag :: forall cl. TimeInfo cl -> Tag cl
absolute :: forall cl. TimeInfo cl -> Time cl
sinceInit :: forall cl. TimeInfo cl -> Diff (Time cl)
sinceLast :: forall cl. TimeInfo cl -> Diff (Time cl)
..} <- ClSF m cl () (TimeInfo cl)
forall (m :: Type -> Type) cl a.
Monad m =>
ClSF m cl a (TimeInfo cl)
timeInfo -< ()
  MSF (ReaderT (TimeInfo cl) m) v v
forall (a :: Type -> Type -> Type) b. Arrow a => a b b
returnA                   -< (v
v v -> v -> v
forall v a. VectorSpace v a => v -> v -> v
^-^ v
vLast) v -> s -> v
forall v a. VectorSpace v a => v -> a -> v
^/ s
Diff (Time cl)
sinceLast

-- | Numerical derivative with input initialised to zero.
derivative
  :: ( Monad m, VectorSpace v s
     , s ~ Diff td)
  => BehaviorF m td v v
derivative :: BehaviorF m td v v
derivative = v -> BehaviorF m td v v
forall (m :: Type -> Type) v s td.
(Monad m, VectorSpace v s, s ~ Diff td) =>
v -> BehaviorF m td v v
derivativeFrom v
forall v a. VectorSpace v a => v
zeroVector

-- | Like 'derivativeFrom', but uses three samples to compute the derivative.
--   Consequently, it is delayed by one sample.
threePointDerivativeFrom
  :: ( Monad m, VectorSpace v s
     , s ~ Diff td)
  => v -- ^ The initial position
  -> BehaviorF m td v v
threePointDerivativeFrom :: v -> BehaviorF m td v v
threePointDerivativeFrom v
v0 = proc v
v -> do
  v
dv  <- v -> BehaviorF m td v v
forall (m :: Type -> Type) v s td.
(Monad m, VectorSpace v s, s ~ Diff td) =>
v -> BehaviorF m td v v
derivativeFrom v
v0 -< v
v
  v
dv' <- v -> ClSF m cl v v
forall (m :: Type -> Type) a. Monad m => a -> MSF m a a
iPre v
forall v a. VectorSpace v a => v
zeroVector   -< v
dv
  ClSF m cl v v
forall (a :: Type -> Type -> Type) b. Arrow a => a b b
returnA                  -< (v
dv v -> v -> v
forall v a. VectorSpace v a => v -> v -> v
^+^ v
dv') v -> s -> v
forall v a. VectorSpace v a => v -> a -> v
^/ s
2

-- | Like 'threePointDerivativeFrom',
--   but with the initial position initialised to 'zeroVector'.
threePointDerivative
  :: ( Monad m, VectorSpace v s
     , s ~ Diff td)
  => BehaviorF m td v v
threePointDerivative :: BehaviorF m td v v
threePointDerivative = v -> BehaviorF m td v v
forall (m :: Type -> Type) v s td.
(Monad m, VectorSpace v s, s ~ Diff td) =>
v -> BehaviorF m td v v
threePointDerivativeFrom v
forall v a. VectorSpace v a => v
zeroVector

-- ** Averaging and filters

-- | A weighted moving average signal function.
--   The output is the average of the first input,
--   weighted by the second input
--   (which is assumed to be always between 0 and 1).
--   The weight is applied to the average of the last tick,
--   so a weight of 1 simply repeats the past value unchanged,
--   whereas a weight of 0 outputs the current value.
weightedAverageFrom
  :: ( Monad m, VectorSpace v s
     , s ~ Diff td)
  => v -- ^ The initial position
  -> BehaviorF m td (v, s) v
weightedAverageFrom :: v -> BehaviorF m td (v, s) v
weightedAverageFrom v
v0 = v
-> MSF (ReaderT (TimeInfo cl) m) ((v, s), v) (v, v)
-> MSF (ReaderT (TimeInfo cl) m) (v, s) v
forall (m :: Type -> Type) c a b.
Monad m =>
c -> MSF m (a, c) (b, c) -> MSF m a b
feedback v
v0 (MSF (ReaderT (TimeInfo cl) m) ((v, s), v) (v, v)
 -> MSF (ReaderT (TimeInfo cl) m) (v, s) v)
-> MSF (ReaderT (TimeInfo cl) m) ((v, s), v) (v, v)
-> MSF (ReaderT (TimeInfo cl) m) (v, s) v
forall a b. (a -> b) -> a -> b
$ proc ((v
v, s
weight), v
vAvg) -> do
  let
    vAvg' :: v
vAvg' = s
weight s -> v -> v
forall v a. VectorSpace v a => a -> v -> v
*^ v
vAvg v -> v -> v
forall v a. VectorSpace v a => v -> v -> v
^+^ (s
1 s -> s -> s
forall a. Num a => a -> a -> a
- s
weight) s -> v -> v
forall v a. VectorSpace v a => a -> v -> v
*^ v
v
  MSF (ReaderT (TimeInfo cl) m) (v, v) (v, v)
forall (a :: Type -> Type -> Type) b. Arrow a => a b b
returnA -< (v
vAvg', v
vAvg')

-- | An exponential moving average, or low pass.
--   It will average out, or filter,
--   all features below a given time constant @t@.
--   (Equivalently, it filters out frequencies above @1 / (2 * pi * t)@.)
averageFrom
  :: ( Monad m, VectorSpace v s
     , Floating s
     , s ~ Diff td)
  => v -- ^ The initial position
  -> Diff td -- ^ The time scale on which the signal is averaged
  -> BehaviorF m td v v
averageFrom :: v -> Diff td -> BehaviorF m td v v
averageFrom v
v0 Diff td
t = proc v
v -> do
  TimeInfo {Diff (Time cl)
Time cl
Tag cl
tag :: Tag cl
absolute :: Time cl
sinceInit :: Diff (Time cl)
sinceLast :: Diff (Time cl)
tag :: forall cl. TimeInfo cl -> Tag cl
absolute :: forall cl. TimeInfo cl -> Time cl
sinceInit :: forall cl. TimeInfo cl -> Diff (Time cl)
sinceLast :: forall cl. TimeInfo cl -> Diff (Time cl)
..} <- ClSF m cl () (TimeInfo cl)
forall (m :: Type -> Type) cl a.
Monad m =>
ClSF m cl a (TimeInfo cl)
timeInfo -< ()
  let
    weight :: s
weight = s -> s
forall a. Floating a => a -> a
exp (s -> s) -> s -> s
forall a b. (a -> b) -> a -> b
$ - (s
Diff (Time cl)
sinceLast s -> s -> s
forall a. Fractional a => a -> a -> a
/ s
Diff td
t)
  v -> BehaviorF m td (v, s) v
forall (m :: Type -> Type) v s td.
(Monad m, VectorSpace v s, s ~ Diff td) =>
v -> BehaviorF m td (v, s) v
weightedAverageFrom v
v0    -< (v
v, s
weight)


-- | An average, or low pass, initialised to zero.
average
  :: ( Monad m, VectorSpace v s
     , Floating s
     , s ~ Diff td)
  => Diff td -- ^ The time scale on which the signal is averaged
  -> BehaviourF m td v v
average :: Diff td -> BehaviourF m td v v
average = v -> Diff td -> BehaviourF m td v v
forall (m :: Type -> Type) v s td.
(Monad m, VectorSpace v s, Floating s, s ~ Diff td) =>
v -> Diff td -> BehaviorF m td v v
averageFrom v
forall v a. VectorSpace v a => v
zeroVector

-- | A linearised version of 'averageFrom'.
--   It is more efficient, but only accurate
--   if the supplied time scale is much bigger
--   than the average time difference between two ticks.
averageLinFrom
  :: ( Monad m, VectorSpace v s
     , s ~ Diff td)
  => v -- ^ The initial position
  -> Diff td -- ^ The time scale on which the signal is averaged
  -> BehaviourF m td v v
averageLinFrom :: v -> Diff td -> BehaviourF m td v v
averageLinFrom v
v0 Diff td
t = proc v
v -> do
  TimeInfo {Diff (Time cl)
Time cl
Tag cl
tag :: Tag cl
absolute :: Time cl
sinceInit :: Diff (Time cl)
sinceLast :: Diff (Time cl)
tag :: forall cl. TimeInfo cl -> Tag cl
absolute :: forall cl. TimeInfo cl -> Time cl
sinceInit :: forall cl. TimeInfo cl -> Diff (Time cl)
sinceLast :: forall cl. TimeInfo cl -> Diff (Time cl)
..} <- ClSF m cl () (TimeInfo cl)
forall (m :: Type -> Type) cl a.
Monad m =>
ClSF m cl a (TimeInfo cl)
timeInfo -< ()
  let
    weight :: s
weight = s
Diff td
t s -> s -> s
forall a. Fractional a => a -> a -> a
/ (s
Diff (Time cl)
sinceLast s -> s -> s
forall a. Num a => a -> a -> a
+ s
Diff td
t)
  v -> BehaviorF m td (v, s) v
forall (m :: Type -> Type) v s td.
(Monad m, VectorSpace v s, s ~ Diff td) =>
v -> BehaviorF m td (v, s) v
weightedAverageFrom v
v0    -< (v
v, s
weight)

-- | Linearised version of 'average'.
averageLin
  :: ( Monad m, VectorSpace v s
     , s ~ Diff td)
  => Diff td -- ^ The time scale on which the signal is averaged
  -> BehaviourF m td v v
averageLin :: Diff td -> BehaviourF m td v v
averageLin = v -> Diff td -> BehaviourF m td v v
forall (m :: Type -> Type) v s td.
(Monad m, VectorSpace v s, s ~ Diff td) =>
v -> Diff td -> BehaviourF m td v v
averageLinFrom v
forall v a. VectorSpace v a => v
zeroVector

-- *** First-order filters

-- | Alias for 'average'.
lowPass
  :: ( Monad m, VectorSpace v s
     , Floating s
     , s ~ Diff td)
  => Diff td
  -> BehaviourF m td v v
lowPass :: Diff td -> BehaviourF m td v v
lowPass = Diff td -> ClSF m cl v v
forall (m :: Type -> Type) v s td.
(Monad m, VectorSpace v s, Floating s, s ~ Diff td) =>
Diff td -> BehaviourF m td v v
average

-- | Filters out frequencies below @1 / (2 * pi * t)@.
highPass
  :: ( Monad m, VectorSpace v s
     , Floating s
     , s ~ Diff td)
  => Diff td -- ^ The time constant @t@
  -> BehaviourF m td v v
highPass :: Diff td -> BehaviourF m td v v
highPass Diff td
t = ClSF m cl v v
forall (m :: Type -> Type) cl a. Monad m => ClSF m cl a a
clId ClSF m cl v v -> ClSF m cl v v -> ClSF m cl v v
forall v a. VectorSpace v a => v -> v -> v
^-^ Diff td -> BehaviourF m td v v
forall (m :: Type -> Type) v s td.
(Monad m, VectorSpace v s, Floating s, s ~ Diff td) =>
Diff td -> BehaviourF m td v v
lowPass Diff td
t

-- | Filters out frequencies other than @1 / (2 * pi * t)@.
bandPass
  :: ( Monad m, VectorSpace v s
     , Floating s
     , s ~ Diff td)
  => Diff td -- ^ The time constant @t@
  -> BehaviourF m td v v
bandPass :: Diff td -> BehaviourF m td v v
bandPass Diff td
t = Diff td -> BehaviourF m td v v
forall (m :: Type -> Type) v s td.
(Monad m, VectorSpace v s, Floating s, s ~ Diff td) =>
Diff td -> BehaviourF m td v v
lowPass Diff td
t ClSF m cl v v -> ClSF m cl v v -> ClSF m cl v v
forall k (cat :: k -> k -> Type) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Diff td -> BehaviourF m td v v
forall (m :: Type -> Type) v s td.
(Monad m, VectorSpace v s, Floating s, s ~ Diff td) =>
Diff td -> BehaviourF m td v v
highPass Diff td
t

-- | Filters out the frequency @1 / (2 * pi * t)@.
bandStop
  :: ( Monad m, VectorSpace v s
     , Floating s
     , s ~ Diff td)
  => Diff td -- ^ The time constant @t@
  -> BehaviourF m td v v
bandStop :: Diff td -> BehaviourF m td v v
bandStop Diff td
t = ClSF m cl v v
forall (m :: Type -> Type) cl a. Monad m => ClSF m cl a a
clId ClSF m cl v v -> ClSF m cl v v -> ClSF m cl v v
forall v a. VectorSpace v a => v -> v -> v
^-^ Diff td -> BehaviourF m td v v
forall (m :: Type -> Type) v s td.
(Monad m, VectorSpace v s, Floating s, s ~ Diff td) =>
Diff td -> BehaviourF m td v v
bandPass Diff td
t



-- * Delays

-- | Remembers and indefinitely outputs ("holds") the first input value.
keepFirst :: Monad m => ClSF m cl a a
keepFirst :: ClSF m cl a a
keepFirst = MSFExcept (ReaderT (TimeInfo cl) m) a a Void -> ClSF m cl a a
forall (m :: Type -> Type) a b.
Monad m =>
MSFExcept m a b Void -> MSF m a b
safely (MSFExcept (ReaderT (TimeInfo cl) m) a a Void -> ClSF m cl a a)
-> MSFExcept (ReaderT (TimeInfo cl) m) a a Void -> ClSF m cl a a
forall a b. (a -> b) -> a -> b
$ do
  a
a <- ClSF (ExceptT a m) cl a a -> ClSFExcept m cl a a a
forall (m :: Type -> Type) e cl a b.
Monad m =>
ClSF (ExceptT e m) cl a b -> ClSFExcept m cl a b e
try ClSF (ExceptT a m) cl a a
forall (m :: Type -> Type) e cl a.
Monad m =>
ClSF (ExceptT e m) cl e a
throwS
  ClSF m cl a a -> MSFExcept (ReaderT (TimeInfo cl) m) a a Void
forall (m :: Type -> Type) a b e.
Monad m =>
MSF m a b -> MSFExcept m a b e
safe (ClSF m cl a a -> MSFExcept (ReaderT (TimeInfo cl) m) a a Void)
-> ClSF m cl a a -> MSFExcept (ReaderT (TimeInfo cl) m) a a Void
forall a b. (a -> b) -> a -> b
$ (a -> a) -> ClSF m cl a a
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr ((a -> a) -> ClSF m cl a a) -> (a -> a) -> ClSF m cl a a
forall a b. (a -> b) -> a -> b
$ a -> a -> a
forall a b. a -> b -> a
const a
a

-- | Remembers all input values that arrived within a given time window.
--   New values are appended left.
historySince
  :: (Monad m, Ord (Diff (Time cl)), TimeDomain (Time cl))
  => Diff (Time cl) -- ^ The size of the time window
  -> ClSF m cl a (Seq (TimeInfo cl, a))
historySince :: Diff (Time cl) -> ClSF m cl a (Seq (TimeInfo cl, a))
historySince Diff (Time cl)
dTime = MSF m (TimeInfo cl, a) (Seq (TimeInfo cl, a))
-> ClSF m cl a (Seq (TimeInfo cl, a))
forall (m :: Type -> Type) r a b.
Monad m =>
MSF m (r, a) b -> MSF (ReaderT r m) a b
readerS (MSF m (TimeInfo cl, a) (Seq (TimeInfo cl, a))
 -> ClSF m cl a (Seq (TimeInfo cl, a)))
-> MSF m (TimeInfo cl, a) (Seq (TimeInfo cl, a))
-> ClSF m cl a (Seq (TimeInfo cl, a))
forall a b. (a -> b) -> a -> b
$ ((TimeInfo cl, a) -> Seq (TimeInfo cl, a) -> Seq (TimeInfo cl, a))
-> Seq (TimeInfo cl, a)
-> MSF m (TimeInfo cl, a) (Seq (TimeInfo cl, a))
forall (m :: Type -> Type) a s.
Monad m =>
(a -> s -> s) -> s -> MSF m a s
accumulateWith (TimeInfo cl, a) -> Seq (TimeInfo cl, a) -> Seq (TimeInfo cl, a)
appendValue Seq (TimeInfo cl, a)
forall a. Seq a
empty
  where
    appendValue :: (TimeInfo cl, a) -> Seq (TimeInfo cl, a) -> Seq (TimeInfo cl, a)
appendValue (TimeInfo cl
ti, a
a) Seq (TimeInfo cl, a)
tias  = ((TimeInfo cl, a) -> Bool)
-> Seq (TimeInfo cl, a) -> Seq (TimeInfo cl, a)
forall a. (a -> Bool) -> Seq a -> Seq a
takeWhileL (TimeInfo cl -> (TimeInfo cl, a) -> Bool
recentlySince TimeInfo cl
ti) (Seq (TimeInfo cl, a) -> Seq (TimeInfo cl, a))
-> Seq (TimeInfo cl, a) -> Seq (TimeInfo cl, a)
forall a b. (a -> b) -> a -> b
$ (TimeInfo cl
ti, a
a) (TimeInfo cl, a) -> Seq (TimeInfo cl, a) -> Seq (TimeInfo cl, a)
forall a. a -> Seq a -> Seq a
<| Seq (TimeInfo cl, a)
tias
    recentlySince :: TimeInfo cl -> (TimeInfo cl, a) -> Bool
recentlySince TimeInfo cl
ti (TimeInfo cl
ti', a
_) = Time cl -> Time cl -> Diff (Time cl)
forall time. TimeDomain time => time -> time -> Diff time
diffTime (TimeInfo cl -> Time cl
forall cl. TimeInfo cl -> Time cl
absolute TimeInfo cl
ti) (TimeInfo cl -> Time cl
forall cl. TimeInfo cl -> Time cl
absolute TimeInfo cl
ti') Diff (Time cl) -> Diff (Time cl) -> Bool
forall a. Ord a => a -> a -> Bool
< Diff (Time cl)
dTime

-- | Delay a signal by certain time span,
--   initialising with the first input.
delayBy
  :: (Monad m, Ord (Diff td), TimeDomain td)
  => Diff td            -- ^ The time span to delay the signal
  -> BehaviorF m td a a
delayBy :: Diff td -> BehaviorF m td a a
delayBy Diff td
dTime = Diff (Time cl) -> ClSF m cl a (Seq (TimeInfo cl, a))
forall (m :: Type -> Type) cl a.
(Monad m, Ord (Diff (Time cl)), TimeDomain (Time cl)) =>
Diff (Time cl) -> ClSF m cl a (Seq (TimeInfo cl, a))
historySince Diff td
Diff (Time cl)
dTime ClSF m cl a (Seq (TimeInfo cl, a))
-> MSF (ReaderT (TimeInfo cl) m) (Seq (TimeInfo cl, a)) a
-> MSF (ReaderT (TimeInfo cl) m) a a
forall k (cat :: k -> k -> Type) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Seq (TimeInfo cl, a) -> Maybe (TimeInfo cl, a))
-> MSF
     (ReaderT (TimeInfo cl) m)
     (Seq (TimeInfo cl, a))
     (Maybe (TimeInfo cl, a))
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr (Seq (TimeInfo cl, a) -> ViewR (TimeInfo cl, a)
forall a. Seq a -> ViewR a
viewr (Seq (TimeInfo cl, a) -> ViewR (TimeInfo cl, a))
-> (ViewR (TimeInfo cl, a) -> Maybe (TimeInfo cl, a))
-> Seq (TimeInfo cl, a)
-> Maybe (TimeInfo cl, a)
forall k (cat :: k -> k -> Type) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ViewR (TimeInfo cl, a) -> Maybe (TimeInfo cl, a)
forall a. ViewR a -> Maybe a
safeHead) MSF
  (ReaderT (TimeInfo cl) m)
  (Seq (TimeInfo cl, a))
  (Maybe (TimeInfo cl, a))
-> MSF (ReaderT (TimeInfo cl) m) (Maybe (TimeInfo cl, a)) a
-> MSF (ReaderT (TimeInfo cl) m) (Seq (TimeInfo cl, a)) a
forall k (cat :: k -> k -> Type) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (TimeInfo cl, a)
-> MSF
     (ReaderT (TimeInfo cl) m) (Maybe (TimeInfo cl, a)) (TimeInfo cl, a)
forall (m :: Type -> Type) a. Monad m => a -> MSF m (Maybe a) a
lastS (TimeInfo cl, a)
forall a. HasCallStack => a
undefined MSF
  (ReaderT (TimeInfo cl) m) (Maybe (TimeInfo cl, a)) (TimeInfo cl, a)
-> MSF (ReaderT (TimeInfo cl) m) (TimeInfo cl, a) a
-> MSF (ReaderT (TimeInfo cl) m) (Maybe (TimeInfo cl, a)) a
forall k (cat :: k -> k -> Type) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ((TimeInfo cl, a) -> a)
-> MSF (ReaderT (TimeInfo cl) m) (TimeInfo cl, a) a
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr (TimeInfo cl, a) -> a
forall a b. (a, b) -> b
snd
  where
    safeHead :: ViewR a -> Maybe a
safeHead ViewR a
EmptyR   = Maybe a
forall a. Maybe a
Nothing
    safeHead (Seq a
_ :> a
a) = a -> Maybe a
forall a. a -> Maybe a
Just a
a

-- * Timers

-- | Throws an exception after the specified time difference,
--   outputting the time passed since the 'timer' was instantiated.
timer
  :: ( Monad m
     , TimeDomain td
     , Ord (Diff td)
     )
  => Diff td
  -> BehaviorF (ExceptT () m) td a (Diff td)
timer :: Diff td -> BehaviorF (ExceptT () m) td a (Diff td)
timer Diff td
diff = proc a
_ -> do
  Diff td
time <- MSF (ReaderT (TimeInfo cl) (ExceptT () m)) () (Diff td)
forall (m :: Type -> Type) time a.
(Monad m, TimeDomain time) =>
BehaviourF m time a (Diff time)
sinceStart -< ()
  ()
_    <- () -> ClSF (ExceptT () m) cl Bool ()
forall (m :: Type -> Type) e cl.
Monad m =>
e -> ClSF (ExceptT e m) cl Bool ()
throwOn () -< Diff td
time Diff td -> Diff td -> Bool
forall a. Ord a => a -> a -> Bool
> Diff td
diff
  MSF (ReaderT (TimeInfo cl) (ExceptT () m)) (Diff td) (Diff td)
forall (a :: Type -> Type -> Type) b. Arrow a => a b b
returnA            -< Diff td
time

-- | Like 'timer_', but doesn't output the remaining time at all.
timer_
  :: ( Monad m
     , TimeDomain td
     , Ord (Diff td)
     )
  => Diff td
  -> BehaviorF (ExceptT () m) td a ()
timer_ :: Diff td -> BehaviorF (ExceptT () m) td a ()
timer_ Diff td
diff = Diff td -> BehaviorF (ExceptT () m) td a (Diff td)
forall (m :: Type -> Type) td a.
(Monad m, TimeDomain td, Ord (Diff td)) =>
Diff td -> BehaviorF (ExceptT () m) td a (Diff td)
timer Diff td
diff MSF (ReaderT (TimeInfo cl) (ExceptT () m)) a (Diff td)
-> MSF (ReaderT (TimeInfo cl) (ExceptT () m)) (Diff td) ()
-> MSF (ReaderT (TimeInfo cl) (ExceptT () m)) a ()
forall k (cat :: k -> k -> Type) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Diff td -> ())
-> MSF (ReaderT (TimeInfo cl) (ExceptT () m)) (Diff td) ()
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr (() -> Diff td -> ()
forall a b. a -> b -> a
const ())

-- | Like 'timer', but divides the remaining time by the total time.
scaledTimer
  :: ( Monad m
     , TimeDomain td
     , Fractional (Diff td)
     , Ord        (Diff td)
     )
  => Diff td
  -> BehaviorF (ExceptT () m) td a (Diff td)
scaledTimer :: Diff td -> BehaviorF (ExceptT () m) td a (Diff td)
scaledTimer Diff td
diff = Diff td -> BehaviorF (ExceptT () m) td a (Diff td)
forall (m :: Type -> Type) td a.
(Monad m, TimeDomain td, Ord (Diff td)) =>
Diff td -> BehaviorF (ExceptT () m) td a (Diff td)
timer Diff td
diff MSF (ReaderT (TimeInfo cl) (ExceptT () m)) a (Diff td)
-> MSF (ReaderT (TimeInfo cl) (ExceptT () m)) (Diff td) (Diff td)
-> MSF (ReaderT (TimeInfo cl) (ExceptT () m)) a (Diff td)
forall k (cat :: k -> k -> Type) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Diff td -> Diff td)
-> MSF (ReaderT (TimeInfo cl) (ExceptT () m)) (Diff td) (Diff td)
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr (Diff td -> Diff td -> Diff td
forall a. Fractional a => a -> a -> a
/ Diff td
diff)


-- * To be ported to Dunai

-- | Remembers the last 'Just' value,
--   defaulting to the given initialisation value.
lastS :: Monad m => a -> MSF m (Maybe a) a
lastS :: a -> MSF m (Maybe a) a
lastS a
a = (Maybe a -> Last a) -> MSF m (Maybe a) (Last a)
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr Maybe a -> Last a
forall a. Maybe a -> Last a
Last MSF m (Maybe a) (Last a) -> MSF m (Last a) a -> MSF m (Maybe a) a
forall k (cat :: k -> k -> Type) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Last a -> MSF m (Last a) (Last a)
forall n (m :: Type -> Type). (Monoid n, Monad m) => n -> MSF m n n
mappendFrom (Maybe a -> Last a
forall a. Maybe a -> Last a
Last (a -> Maybe a
forall a. a -> Maybe a
Just a
a)) MSF m (Last a) (Last a) -> MSF m (Last a) a -> MSF m (Last a) a
forall k (cat :: k -> k -> Type) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Last a -> a) -> MSF m (Last a) a
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr (Last a -> Maybe a
forall a. Last a -> Maybe a
getLast (Last a -> Maybe a) -> (Maybe a -> a) -> Last a -> a
forall k (cat :: k -> k -> Type) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust)