{-# LANGUAGE Arrows #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
module FRP.Rhine.ClSF.Util where
import Control.Arrow
import Control.Category (Category)
import Control.Category qualified (id)
import Data.Sequence
import Control.Monad.Trans.Reader (ask, asks)
import Data.Automaton.Trans.Reader (readerS)
import Data.VectorSpace
import FRP.Rhine.ClSF.Core
import FRP.Rhine.ClSF.Except
import FRP.Rhine.Clock
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
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
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
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
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
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
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
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
(>>>)
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
(<<<)
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
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
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
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
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
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
threePointDerivativeFrom ::
( Monad m
, VectorSpace v s
, s ~ Diff td
, Num s
) =>
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
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
weightedAverageFrom ::
( Monad m
, VectorSpace v s
, s ~ Diff td
, Num s
) =>
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')
averageFrom ::
( Monad m
, VectorSpace v s
, Floating s
, s ~ Diff td
) =>
v ->
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)
average ::
( Monad m
, VectorSpace v s
, Floating s
, s ~ Diff td
) =>
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
averageLinFrom ::
( Monad m
, VectorSpace v s
, Floating s
, s ~ Diff td
) =>
v ->
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)
averageLin ::
( Monad m
, VectorSpace v s
, Floating s
, s ~ Diff td
) =>
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
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
highPass ::
( Monad m
, VectorSpace v s
, Floating s
, Eq s
, s ~ Diff td
) =>
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
bandPass ::
( Monad m
, VectorSpace v s
, Floating s
, Eq s
, s ~ Diff td
) =>
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
bandStop ::
( Monad m
, VectorSpace v s
, Floating s
, Eq s
, s ~ Diff td
) =>
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
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
historySince ::
(Monad m, Ord (Diff (Time cl)), TimeDomain (Time cl)) =>
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
delayBy ::
(Monad m, Ord (Diff td), TimeDomain td) =>
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
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
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 ())
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)