{-# LANGUAGE Arrows #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
module FRP.Rhine.Type where
import Data.Automaton
import FRP.Rhine.Clock
import FRP.Rhine.Clock.Proxy
import FRP.Rhine.Reactimation.ClockErasure
import FRP.Rhine.ResamplingBuffer (ResamplingBuffer)
import FRP.Rhine.SN
import FRP.Rhine.Schedule (In, Out)
data Rhine m cl a b = Rhine
{ forall (m :: Type -> Type) cl a b. Rhine m cl a b -> SN m cl a b
sn :: SN m cl a b
, forall (m :: Type -> Type) cl a b. Rhine m cl a b -> cl
clock :: cl
}
instance (GetClockProxy cl) => ToClockProxy (Rhine m cl a b) where
type Cl (Rhine m cl a b) = cl
eraseClock ::
(Monad m, Clock m cl, GetClockProxy cl) =>
Rhine m cl a b ->
m (Automaton m a (Maybe b))
eraseClock :: forall (m :: Type -> Type) cl a b.
(Monad m, Clock m cl, GetClockProxy cl) =>
Rhine m cl a b -> m (Automaton m a (Maybe b))
eraseClock Rhine {cl
SN m cl a b
sn :: forall (m :: Type -> Type) cl a b. Rhine m cl a b -> SN m cl a b
clock :: forall (m :: Type -> Type) cl a b. Rhine m cl a b -> cl
sn :: SN m cl a b
clock :: cl
..} = do
(Automaton m () (Time cl, Tag cl)
runningClock, Time cl
initTime) <- cl -> m (Automaton m () (Time cl, Tag cl), Time cl)
forall (m :: Type -> Type) cl.
Clock m cl =>
cl -> RunningClockInit m (Time cl) (Tag cl)
initClock cl
clock
Automaton m a (Maybe b) -> m (Automaton m a (Maybe b))
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Automaton m a (Maybe b) -> m (Automaton m a (Maybe b)))
-> Automaton m a (Maybe b) -> m (Automaton m a (Maybe b))
forall a b. (a -> b) -> a -> b
$ proc a
a -> do
(Time cl
time, Tag cl
tag) <- Automaton m () (Time cl, Tag cl)
runningClock -< ()
Time cl
-> SN m cl a b -> Automaton m (Time cl, Tag cl, Maybe a) (Maybe b)
forall (m :: Type -> Type) cl a b.
(Monad m, Clock m cl, GetClockProxy cl) =>
Time cl
-> SN m cl a b -> Automaton m (Time cl, Tag cl, Maybe a) (Maybe b)
eraseClockSN Time cl
initTime SN m cl a b
sn -< (Time cl
time, Tag cl
tag, a
a a -> Maybe (Tag (In cl)) -> Maybe a
forall a b. a -> Maybe b -> Maybe a
forall (f :: Type -> Type) a b. Functor f => a -> f b -> f a
<$ ClockProxy cl -> Tag cl -> Maybe (Tag (In cl))
forall cl. ClockProxy cl -> Tag cl -> Maybe (Tag (In cl))
inTag (SN m cl a b -> ClockProxy (Cl (SN m cl a b))
forall a. ToClockProxy a => a -> ClockProxy (Cl a)
toClockProxy SN m cl a b
sn) Tag cl
tag)
{-# INLINE eraseClock #-}
feedbackRhine ::
( Clock m (In cl)
, Clock m (Out cl)
, Time (In cl) ~ Time cl
, Time (Out cl) ~ Time cl
) =>
ResamplingBuffer m (Out cl) (In cl) d c ->
Rhine m cl (a, c) (b, d) ->
Rhine m cl a b
feedbackRhine :: forall (m :: Type -> Type) cl d c a b.
(Clock m (In cl), Clock m (Out cl), Time (In cl) ~ Time cl,
Time (Out cl) ~ Time cl) =>
ResamplingBuffer m (Out cl) (In cl) d c
-> Rhine m cl (a, c) (b, d) -> Rhine m cl a b
feedbackRhine ResamplingBuffer m (Out cl) (In cl) d c
buf Rhine {cl
SN m cl (a, c) (b, d)
sn :: forall (m :: Type -> Type) cl a b. Rhine m cl a b -> SN m cl a b
clock :: forall (m :: Type -> Type) cl a b. Rhine m cl a b -> cl
sn :: SN m cl (a, c) (b, d)
clock :: cl
..} =
Rhine
{ sn :: SN m cl a b
sn = ResamplingBuffer m (Out cl) (In cl) d c
-> SN m cl (a, c) (b, d) -> SN m cl a b
forall (m :: Type -> Type) cl d c a b.
(Clock m (In cl), Clock m (Out cl), Time (In cl) ~ Time cl,
Time (Out cl) ~ Time cl) =>
ResBuf m (Out cl) (In cl) d c
-> SN m cl (a, c) (b, d) -> SN m cl a b
Feedback ResamplingBuffer m (Out cl) (In cl) d c
buf SN m cl (a, c) (b, d)
sn
, cl
clock :: cl
clock :: cl
clock
}
{-# INLINE feedbackRhine #-}