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

{- |
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.
-}
module FRP.Rhine.ClSF.Util where

-- base
import Control.Arrow
import Control.Category (Category)
import Control.Category qualified (id)

-- containers
import Data.Sequence

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

-- dunai
import Data.Automaton.Trans.Reader (readerS)

-- simple-affine-space
import Data.VectorSpace

-- time-domain
import Data.TimeDomain

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

-- * Read time information

-- | Read the environment variable, i.e. the 'TimeInfo'.
timeInfo :: (Monad m) => ClSF m cl a (TimeInfo cl)
timeInfo :: forall (m :: Type -> Type) cl a.
Monad m =>
ClSF m cl a (TimeInfo cl)
timeInfo = ReaderT (TimeInfo cl) m (TimeInfo cl)
-> Automaton (ReaderT (TimeInfo cl) m) a (TimeInfo cl)
forall (m :: Type -> Type) b a. Functor m => m b -> Automaton 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 :: forall (m :: Type -> Type) cl b a.
Monad m =>
(TimeInfo cl -> b) -> ClSF m cl a b
timeInfoOf TimeInfo cl -> b
f = ReaderT (TimeInfo cl) m b
-> Automaton (ReaderT (TimeInfo cl) m) a b
forall (m :: Type -> Type) b a. Functor m => m b -> Automaton m a b
constM (ReaderT (TimeInfo cl) m b
 -> Automaton (ReaderT (TimeInfo cl) m) a b)
-> ReaderT (TimeInfo cl) m b
-> Automaton (ReaderT (TimeInfo cl) m) 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 :: forall (m :: Type -> Type) cl a.
Monad m =>
ClSF m cl a (Diff (Time cl))
sinceLastS = (TimeInfo cl -> Diff (Time cl))
-> Automaton (ReaderT (TimeInfo cl) m) 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 :: forall (m :: Type -> Type) cl a.
Monad m =>
ClSF m cl a (Diff (Time cl))
sinceInitS = (TimeInfo cl -> Diff (Time cl))
-> Automaton (ReaderT (TimeInfo cl) m) 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 :: forall (m :: Type -> Type) cl a. Monad m => ClSF m cl a (Time cl)
absoluteS = (TimeInfo cl -> Time cl)
-> Automaton (ReaderT (TimeInfo cl) m) 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 :: forall (m :: Type -> Type) cl a. Monad m => ClSF m cl a (Tag cl)
tagS = (TimeInfo cl -> Tag cl)
-> Automaton (ReaderT (TimeInfo cl) m) 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,
i.e. since the first tick on which this 'ClSF' was run.

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.

Even in the absence of conditional activation of 'ClSF's,
there is a difference:
For a clock that doesn't tick at its initialisation time,
'sinceStart' and 'sinceInitS' will have a constant offset of the duration between initialisation time and first tick.
-}
sinceStart :: (Monad m, TimeDomain time) => BehaviourF m time a (Diff time)
sinceStart :: forall (m :: Type -> Type) time a.
(Monad m, TimeDomain time) =>
BehaviourF m time a (Diff time)
sinceStart =
  Automaton (ReaderT (TimeInfo cl) m) a time
ClSF m cl a (Time cl)
forall (m :: Type -> Type) cl a. Monad m => ClSF m cl a (Time cl)
absoluteS Automaton (ReaderT (TimeInfo cl) m) a time
-> Automaton (ReaderT (TimeInfo cl) m) time (Diff time)
-> Automaton (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
    Automaton (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 |@| 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
>-> :: forall (cat :: Type -> Type -> Type) a b c.
Category cat =>
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
<-< :: forall (cat :: Type -> Type -> Type) b c a.
Category cat =>
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_ :: forall (a :: Type -> Type -> Type) b c. Arrow a => b -> a c b
arr_ = (c -> b) -> a c b
forall b c. (b -> c) -> a b c
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 :: forall (m :: Type -> Type) cl a. Monad m => ClSF m cl a a
clId = Automaton (ReaderT (TimeInfo cl) m) a a
forall a. Automaton (ReaderT (TimeInfo cl) m) 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 :: forall (m :: Type -> Type) v s td.
(Monad m, VectorSpace v s, s ~ Diff td) =>
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
TimeInfo cl -> Diff (Time cl)
forall cl. TimeInfo cl -> Diff (Time cl)
sinceLast -< ()
  v -> Automaton (ReaderT (TimeInfo cl) m) v v
forall v s (m :: Type -> Type).
(VectorSpace v s, Monad m) =>
v -> Automaton 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 :: forall (m :: Type -> Type) v s td.
(Monad m, VectorSpace v s, s ~ Diff td) =>
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 :: forall (m :: Type -> Type) v s td.
(Monad m, VectorSpace v s, s ~ Diff td) =>
v -> BehaviorF m td v v
derivativeFrom v
v0 = proc v
v -> do
  v
vLast <- v -> Automaton (ReaderT (TimeInfo cl) m) v v
forall (m :: Type -> Type) a. Applicative m => a -> Automaton m a a
delay v
v0 -< v
v
  TimeInfo {Diff (Time cl)
Time cl
Tag cl
sinceLast :: forall cl. TimeInfo cl -> Diff (Time cl)
sinceInit :: forall cl. TimeInfo cl -> Diff (Time cl)
absolute :: forall cl. TimeInfo cl -> Time cl
tag :: forall cl. TimeInfo cl -> Tag cl
sinceLast :: Diff (Time cl)
sinceInit :: Diff (Time cl)
absolute :: Time cl
tag :: Tag cl
..} <- ClSF m cl () (TimeInfo cl)
forall (m :: Type -> Type) cl a.
Monad m =>
ClSF m cl a (TimeInfo cl)
timeInfo -< ()
  Automaton (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 :: forall (m :: Type -> Type) v s td.
(Monad m, VectorSpace v s, s ~ Diff td) =>
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
  , Num s
  ) =>
  -- | The initial position
  v ->
  BehaviorF m td v v
threePointDerivativeFrom :: forall (m :: Type -> Type) v s td.
(Monad m, VectorSpace v s, s ~ Diff td, Num s) =>
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. Applicative m => a -> Automaton m a a
delay 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
  , Num s
  ) =>
  BehaviorF m td v v
threePointDerivative :: forall (m :: Type -> Type) v s td.
(Monad m, VectorSpace v s, s ~ Diff td, Num s) =>
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, Num s) =>
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
  , Num s
  ) =>
  -- | The initial position
  v ->
  BehaviorF m td (v, s) v
weightedAverageFrom :: forall (m :: Type -> Type) v s td.
(Monad m, VectorSpace v s, s ~ Diff td, Num s) =>
v -> BehaviorF m td (v, s) v
weightedAverageFrom v
v0 = v
-> Automaton (ReaderT (TimeInfo cl) m) ((v, s), v) (v, v)
-> Automaton (ReaderT (TimeInfo cl) m) (v, s) v
forall (m :: Type -> Type) c a b.
Functor m =>
c -> Automaton m (a, c) (b, c) -> Automaton m a b
feedback v
v0 (Automaton (ReaderT (TimeInfo cl) m) ((v, s), v) (v, v)
 -> Automaton (ReaderT (TimeInfo cl) m) (v, s) v)
-> Automaton (ReaderT (TimeInfo cl) m) ((v, s), v) (v, v)
-> Automaton (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
  Automaton (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
  ) =>
  -- | The initial position
  v ->
  -- | The time scale on which the signal is averaged
  Diff td ->
  BehaviorF m td v v
averageFrom :: 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
v0 Diff td
t = proc v
v -> do
  TimeInfo {Diff (Time cl)
Time cl
Tag cl
sinceLast :: forall cl. TimeInfo cl -> Diff (Time cl)
sinceInit :: forall cl. TimeInfo cl -> Diff (Time cl)
absolute :: forall cl. TimeInfo cl -> Time cl
tag :: forall cl. TimeInfo cl -> Tag cl
sinceLast :: Diff (Time cl)
sinceInit :: Diff (Time cl)
absolute :: Time cl
tag :: Tag 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, Num s) =>
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
  ) =>
  -- | The time scale on which the signal is averaged
  Diff td ->
  BehaviourF m td v v
average :: 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 = v -> Diff td -> BehaviorF 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
  , Floating s
  , s ~ Diff td
  ) =>
  -- | The initial position
  v ->
  -- | The time scale on which the signal is averaged
  Diff td ->
  BehaviourF m td v v
averageLinFrom :: 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
averageLinFrom v
v0 Diff td
t = proc v
v -> do
  TimeInfo {Diff (Time cl)
Time cl
Tag cl
sinceLast :: forall cl. TimeInfo cl -> Diff (Time cl)
sinceInit :: forall cl. TimeInfo cl -> Diff (Time cl)
absolute :: forall cl. TimeInfo cl -> Time cl
tag :: forall cl. TimeInfo cl -> Tag cl
sinceLast :: Diff (Time cl)
sinceInit :: Diff (Time cl)
absolute :: Time cl
tag :: Tag 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, Num s) =>
v -> BehaviorF m td (v, s) v
weightedAverageFrom v
v0 -< (v
v, s
weight)

-- | Linearised version of 'average'.
averageLin ::
  ( Monad m
  , VectorSpace v s
  , Floating s
  , s ~ Diff td
  ) =>
  -- | The time scale on which the signal is averaged
  Diff td ->
  BehaviourF m td v v
averageLin :: forall (m :: Type -> Type) v s td.
(Monad m, VectorSpace v s, Floating s, s ~ Diff td) =>
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, Floating s, s ~ Diff td) =>
v -> Diff td -> BehaviorF 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 :: 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 -> ClSF m cl 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
average

-- | Filters out frequencies below @1 / (2 * pi * t)@.
highPass ::
  ( Monad m
  , VectorSpace v s
  , Floating s
  , Eq s
  , s ~ Diff td
  ) =>
  -- | The time constant @t@
  Diff td ->
  BehaviourF m td v v
highPass :: forall (m :: Type -> Type) v s td.
(Monad m, VectorSpace v s, Floating s, Eq s, s ~ Diff td) =>
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
  , Eq s
  , s ~ Diff td
  ) =>
  -- | The time constant @t@
  Diff td ->
  BehaviourF m td v v
bandPass :: forall (m :: Type -> Type) v s td.
(Monad m, VectorSpace v s, Floating s, Eq s, s ~ Diff td) =>
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, Eq 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
  , Eq s
  , s ~ Diff td
  ) =>
  -- | The time constant @t@
  Diff td ->
  BehaviourF m td v v
bandStop :: forall (m :: Type -> Type) v s td.
(Monad m, VectorSpace v s, Floating s, Eq s, s ~ Diff td) =>
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, Eq 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 :: forall (m :: Type -> Type) cl a. Monad m => ClSF m cl a a
keepFirst = AutomatonExcept a a (ReaderT (TimeInfo cl) m) Void
-> Automaton (ReaderT (TimeInfo cl) m) a a
forall (m :: Type -> Type) a b.
Monad m =>
AutomatonExcept a b m Void -> Automaton m a b
safely (AutomatonExcept a a (ReaderT (TimeInfo cl) m) Void
 -> Automaton (ReaderT (TimeInfo cl) m) a a)
-> AutomatonExcept a a (ReaderT (TimeInfo cl) m) Void
-> Automaton (ReaderT (TimeInfo cl) m) a a
forall a b. (a -> b) -> a -> b
$ do
  a
a <- ClSF (ExceptT a m) cl a a -> ClSFExcept cl a a m a
forall (m :: Type -> Type) e cl a b.
Monad m =>
ClSF (ExceptT e m) cl a b -> ClSFExcept cl a b m 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
  Automaton (ReaderT (TimeInfo cl) m) a a
-> AutomatonExcept a a (ReaderT (TimeInfo cl) m) Void
forall (m :: Type -> Type) a b e.
Monad m =>
Automaton m a b -> AutomatonExcept a b m e
safe (Automaton (ReaderT (TimeInfo cl) m) a a
 -> AutomatonExcept a a (ReaderT (TimeInfo cl) m) Void)
-> Automaton (ReaderT (TimeInfo cl) m) a a
-> AutomatonExcept a a (ReaderT (TimeInfo cl) m) Void
forall a b. (a -> b) -> a -> b
$ (a -> a) -> Automaton (ReaderT (TimeInfo cl) m) a a
forall b c. (b -> c) -> Automaton (ReaderT (TimeInfo cl) m) b c
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr ((a -> a) -> Automaton (ReaderT (TimeInfo cl) m) a a)
-> (a -> a) -> Automaton (ReaderT (TimeInfo cl) m) 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)) =>
  -- | The size of the time window
  Diff (Time cl) ->
  ClSF m cl a (Seq (TimeInfo cl, a))
historySince :: 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 (Time cl)
dTime = Automaton m (TimeInfo cl, a) (Seq (TimeInfo cl, a))
-> Automaton (ReaderT (TimeInfo cl) m) a (Seq (TimeInfo cl, a))
forall (m :: Type -> Type) r a b.
Monad m =>
Automaton m (r, a) b -> Automaton (ReaderT r m) a b
readerS (Automaton m (TimeInfo cl, a) (Seq (TimeInfo cl, a))
 -> Automaton (ReaderT (TimeInfo cl) m) a (Seq (TimeInfo cl, a)))
-> Automaton m (TimeInfo cl, a) (Seq (TimeInfo cl, a))
-> Automaton (ReaderT (TimeInfo cl) m) 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)
-> Automaton m (TimeInfo cl, a) (Seq (TimeInfo cl, a))
forall (m :: Type -> Type) a b.
Monad m =>
(a -> b -> b) -> b -> Automaton m a b
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) =>
  -- | The time span to delay the signal
  Diff td ->
  BehaviorF m td a a
delayBy :: forall (m :: Type -> Type) td a.
(Monad m, Ord (Diff td), TimeDomain td) =>
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))
-> Automaton (ReaderT (TimeInfo cl) m) (Seq (TimeInfo cl, a)) a
-> Automaton (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))
-> Automaton
     (ReaderT (TimeInfo cl) m)
     (Seq (TimeInfo cl, a))
     (Maybe (TimeInfo cl, a))
forall b c. (b -> c) -> Automaton (ReaderT (TimeInfo cl) m) b c
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) Automaton
  (ReaderT (TimeInfo cl) m)
  (Seq (TimeInfo cl, a))
  (Maybe (TimeInfo cl, a))
-> Automaton (ReaderT (TimeInfo cl) m) (Maybe (TimeInfo cl, a)) a
-> Automaton (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)
-> Automaton
     (ReaderT (TimeInfo cl) m) (Maybe (TimeInfo cl, a)) (TimeInfo cl, a)
forall (m :: Type -> Type) a.
Monad m =>
a -> Automaton m (Maybe a) a
lastS (TimeInfo cl, a)
forall a. HasCallStack => a
undefined Automaton
  (ReaderT (TimeInfo cl) m) (Maybe (TimeInfo cl, a)) (TimeInfo cl, a)
-> Automaton (ReaderT (TimeInfo cl) m) (TimeInfo cl, a) a
-> Automaton (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)
-> Automaton (ReaderT (TimeInfo cl) m) (TimeInfo cl, a) a
forall b c. (b -> c) -> Automaton (ReaderT (TimeInfo cl) m) b c
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 :: 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 = proc a
_ -> do
  Diff td
time <- ClSF (ExceptT () m) cl () (Diff td)
BehaviourF (ExceptT () m) td () (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
  Automaton
  (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_ :: forall (m :: Type -> Type) td a.
(Monad m, TimeDomain td, Ord (Diff td)) =>
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 ClSF (ExceptT () m) cl a (Diff td)
-> Automaton (ReaderT (TimeInfo cl) (ExceptT () m)) (Diff td) ()
-> Automaton (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 -> ())
-> Automaton (ReaderT (TimeInfo cl) (ExceptT () m)) (Diff td) ()
forall b c.
(b -> c) -> Automaton (ReaderT (TimeInfo cl) (ExceptT () m)) b c
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 :: forall (m :: Type -> Type) td a.
(Monad m, TimeDomain td, Fractional (Diff td), Ord (Diff td)) =>
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 Automaton (ReaderT (TimeInfo cl) (ExceptT () m)) a (Diff td)
-> Automaton
     (ReaderT (TimeInfo cl) (ExceptT () m)) (Diff td) (Diff td)
-> Automaton (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)
-> Automaton
     (ReaderT (TimeInfo cl) (ExceptT () m)) (Diff td) (Diff td)
forall b c.
(b -> c) -> Automaton (ReaderT (TimeInfo cl) (ExceptT () m)) b c
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)