{-# LANGUAGE Arrows #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TupleSections #-}

{- | Translate clocked signal processing components to stream functions without explicit clock types.

This module is not meant to be used externally,
and is thus not exported from 'FRP.Rhine'.
-}
module FRP.Rhine.Reactimation.ClockErasure where

-- base
import Control.Monad (join)

-- automaton
import Data.Automaton.Trans.Reader
import Data.Stream.Result (Result (..))

-- rhine
import FRP.Rhine.ClSF hiding (runReaderS)
import FRP.Rhine.Clock
import FRP.Rhine.Clock.Proxy
import FRP.Rhine.Clock.Util
import FRP.Rhine.ResamplingBuffer
import FRP.Rhine.SN

{- | Run a clocked signal function as an automaton,
   accepting the timestamps and tags as explicit inputs.
-}
eraseClockClSF ::
  (Monad m, Clock m cl) =>
  ClockProxy cl ->
  Time cl ->
  ClSF m cl a b ->
  Automaton m (Time cl, Tag cl, a) b
eraseClockClSF :: forall (m :: Type -> Type) cl a b.
(Monad m, Clock m cl) =>
ClockProxy cl
-> Time cl -> ClSF m cl a b -> Automaton m (Time cl, Tag cl, a) b
eraseClockClSF ClockProxy cl
proxy Time cl
initialTime ClSF m cl a b
clsf = proc (Time cl
time, Tag cl
tag, a
a) -> do
  TimeInfo cl
timeInfo <- ClockProxy cl
-> Time cl -> Automaton m (Time cl, Tag cl) (TimeInfo cl)
forall (m :: Type -> Type) cl.
(Monad m, Clock m cl) =>
ClockProxy cl
-> Time cl -> Automaton m (Time cl, Tag cl) (TimeInfo cl)
genTimeInfo ClockProxy cl
proxy Time cl
initialTime -< (Time cl
time, Tag cl
tag)
  ClSF m cl a b -> Automaton m (TimeInfo cl, a) b
forall (m :: Type -> Type) r a b.
Monad m =>
Automaton (ReaderT r m) a b -> Automaton m (r, a) b
runReaderS ClSF m cl a b
clsf -< (TimeInfo cl
timeInfo, a
a)
{-# INLINE eraseClockClSF #-}

{- | Run a signal network as an automaton.

   Depending on the incoming clock,
   input data may need to be provided,
   and depending on the outgoing clock,
   output data may be generated.
   There are thus possible invalid inputs,
   which 'eraseClockSN' does not gracefully handle.
-}
eraseClockSN ::
  (Monad m, Clock m cl, GetClockProxy cl) =>
  Time cl ->
  SN m cl a b ->
  Automaton m (Time cl, Tag cl, Maybe a) (Maybe b)
-- A synchronous signal network is run by erasing the clock from the clocked signal function.
eraseClockSN :: 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
initialTime sn :: SN m cl a b
sn@(Synchronous ClSF m cl a b
clsf) = proc (Time cl
time, Tag cl
tag, Just a
a) -> do
  b
b <- ClockProxy cl
-> Time cl -> ClSF m cl a b -> Automaton m (Time cl, Tag cl, a) b
forall (m :: Type -> Type) cl a b.
(Monad m, Clock m cl) =>
ClockProxy cl
-> Time cl -> ClSF m cl a b -> Automaton m (Time cl, Tag cl, a) b
eraseClockClSF (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) Time cl
initialTime ClSF m cl a b
clsf -< (Time cl
time, Tag cl
tag, a
a)
  Automaton m (Maybe b) (Maybe b)
forall (a :: Type -> Type -> Type) b. Arrow a => a b b
returnA -< b -> Maybe b
forall a. a -> Maybe a
Just b
b

-- A sequentially composed signal network may either be triggered in its first component,
-- or its second component. In either case,
-- the resampling buffer (which connects the two components) may be triggered,
-- but only if the outgoing clock of the first component ticks,
-- or the incoming clock of the second component ticks.
eraseClockSN Time cl
initialTime (Sequential SN m clab a b1
sn1 ResamplingBuffer m (Out clab) (In clcd) b1 c
resBuf SN m clcd c b
sn2) =
  let
    proxy1 :: ClockProxy (Cl (SN m clab a b1))
proxy1 = SN m clab a b1 -> ClockProxy (Cl (SN m clab a b1))
forall a. ToClockProxy a => a -> ClockProxy (Cl a)
toClockProxy SN m clab a b1
sn1
    proxy2 :: ClockProxy (Cl (SN m clcd c b))
proxy2 = SN m clcd c b -> ClockProxy (Cl (SN m clcd c b))
forall a. ToClockProxy a => a -> ClockProxy (Cl a)
toClockProxy SN m clcd c b
sn2
   in
    proc (Time cl
time, Tag cl
tag, Maybe a
maybeA) -> do
      Maybe
  (Either
     (Time (In clcd), Tag (Out clab), b1)
     (Time (In clcd), Tag (In clcd)))
resBufIn <- case Tag cl
tag of
        Left Tag clab
tagL -> do
          Maybe b1
maybeB <- Time clab
-> SN m clab a b1
-> Automaton m (Time clab, Tag clab, Maybe a) (Maybe b1)
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
Time clab
initialTime SN m clab a b1
sn1 -< (Time cl
Time (In clcd)
time, Tag clab
tagL, Maybe a
maybeA)
          Automaton
  m
  (Maybe
     (Either
        (Time (In clcd), Tag (Out clab), b1)
        (Time (In clcd), Tag (In clcd))))
  (Maybe
     (Either
        (Time (In clcd), Tag (Out clab), b1)
        (Time (In clcd), Tag (In clcd))))
forall (a :: Type -> Type -> Type) b. Arrow a => a b b
returnA -< (Time (In clcd), Tag (Out clab), b1)
-> Either
     (Time (In clcd), Tag (Out clab), b1)
     (Time (In clcd), Tag (In clcd))
forall a b. a -> Either a b
Left ((Time (In clcd), Tag (Out clab), b1)
 -> Either
      (Time (In clcd), Tag (Out clab), b1)
      (Time (In clcd), Tag (In clcd)))
-> Maybe (Time (In clcd), Tag (Out clab), b1)
-> Maybe
     (Either
        (Time (In clcd), Tag (Out clab), b1)
        (Time (In clcd), Tag (In clcd)))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Time cl
Time (In clcd)
time,,) (Tag (Out clab) -> b1 -> (Time (In clcd), Tag (Out clab), b1))
-> Maybe (Tag (Out clab))
-> Maybe (b1 -> (Time (In clcd), Tag (Out clab), b1))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ClockProxy clab -> Tag clab -> Maybe (Tag (Out clab))
forall cl. ClockProxy cl -> Tag cl -> Maybe (Tag (Out cl))
outTag ClockProxy clab
ClockProxy (Cl (SN m clab a b1))
proxy1 Tag clab
tagL Maybe (b1 -> (Time (In clcd), Tag (Out clab), b1))
-> Maybe b1 -> Maybe (Time (In clcd), Tag (Out clab), b1)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Maybe b1
maybeB)
        Right Tag clcd
tagR -> do
          Automaton
  m
  (Maybe
     (Either
        (Time (In clcd), Tag (Out clab), b1)
        (Time (In clcd), Tag (In clcd))))
  (Maybe
     (Either
        (Time (In clcd), Tag (Out clab), b1)
        (Time (In clcd), Tag (In clcd))))
forall (a :: Type -> Type -> Type) b. Arrow a => a b b
returnA -< (Time (In clcd), Tag (In clcd))
-> Either
     (Time (In clcd), Tag (Out clab), b1)
     (Time (In clcd), Tag (In clcd))
forall a b. b -> Either a b
Right ((Time (In clcd), Tag (In clcd))
 -> Either
      (Time (In clcd), Tag (Out clab), b1)
      (Time (In clcd), Tag (In clcd)))
-> (Tag (In clcd) -> (Time (In clcd), Tag (In clcd)))
-> Tag (In clcd)
-> Either
     (Time (In clcd), Tag (Out clab), b1)
     (Time (In clcd), Tag (In clcd))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Time cl
Time (In clcd)
time,) (Tag (In clcd)
 -> Either
      (Time (In clcd), Tag (Out clab), b1)
      (Time (In clcd), Tag (In clcd)))
-> Maybe (Tag (In clcd))
-> Maybe
     (Either
        (Time (In clcd), Tag (Out clab), b1)
        (Time (In clcd), Tag (In clcd)))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ClockProxy clcd -> Tag clcd -> Maybe (Tag (In clcd))
forall cl. ClockProxy cl -> Tag cl -> Maybe (Tag (In cl))
inTag ClockProxy clcd
ClockProxy (Cl (SN m clcd c b))
proxy2 Tag clcd
tagR
      Maybe (Maybe c)
maybeC <- Automaton
  m
  (Either
     (Time (In clcd), Tag (Out clab), b1)
     (Time (In clcd), Tag (In clcd)))
  (Maybe c)
-> Automaton
     m
     (Maybe
        (Either
           (Time (In clcd), Tag (Out clab), b1)
           (Time (In clcd), Tag (In clcd))))
     (Maybe (Maybe c))
forall (m :: Type -> Type) a b.
Monad m =>
Automaton m a b -> Automaton m (Maybe a) (Maybe b)
mapMaybeS (Automaton
   m
   (Either
      (Time (In clcd), Tag (Out clab), b1)
      (Time (In clcd), Tag (In clcd)))
   (Maybe c)
 -> Automaton
      m
      (Maybe
         (Either
            (Time (In clcd), Tag (Out clab), b1)
            (Time (In clcd), Tag (In clcd))))
      (Maybe (Maybe c)))
-> Automaton
     m
     (Either
        (Time (In clcd), Tag (Out clab), b1)
        (Time (In clcd), Tag (In clcd)))
     (Maybe c)
-> Automaton
     m
     (Maybe
        (Either
           (Time (In clcd), Tag (Out clab), b1)
           (Time (In clcd), Tag (In clcd))))
     (Maybe (Maybe c))
forall a b. (a -> b) -> a -> b
$ ClockProxy (Out clab)
-> ClockProxy (In clcd)
-> Time (Out clab)
-> ResamplingBuffer m (Out clab) (In clcd) b1 c
-> Automaton
     m
     (Either
        (Time (Out clab), Tag (Out clab), b1)
        (Time (In clcd), Tag (In clcd)))
     (Maybe c)
forall (m :: Type -> Type) cl1 cl2 a b.
(Monad m, Clock m cl1, Clock m cl2, Time cl1 ~ Time cl2) =>
ClockProxy cl1
-> ClockProxy cl2
-> Time cl1
-> ResBuf m cl1 cl2 a b
-> Automaton
     m (Either (Time cl1, Tag cl1, a) (Time cl2, Tag cl2)) (Maybe b)
eraseClockResBuf (ClockProxy clab -> ClockProxy (Out clab)
forall cl. ClockProxy cl -> ClockProxy (Out cl)
outProxy ClockProxy clab
ClockProxy (Cl (SN m clab a b1))
proxy1) (ClockProxy clcd -> ClockProxy (In clcd)
forall cl. ClockProxy cl -> ClockProxy (In cl)
inProxy ClockProxy clcd
ClockProxy (Cl (SN m clcd c b))
proxy2) Time cl
Time (Out clab)
initialTime ResamplingBuffer m (Out clab) (In clcd) b1 c
resBuf -< Maybe
  (Either
     (Time (In clcd), Tag (Out clab), b1)
     (Time (In clcd), Tag (In clcd)))
resBufIn
      case Tag cl
tag of
        Left Tag clab
_ -> do
          Automaton m (Maybe b) (Maybe b)
forall (a :: Type -> Type -> Type) b. Arrow a => a b b
returnA -< Maybe b
forall a. Maybe a
Nothing
        Right Tag clcd
tagR -> do
          Time clcd
-> SN m clcd c b
-> Automaton m (Time clcd, Tag clcd, Maybe c) (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
Time clcd
initialTime SN m clcd c b
sn2 -< (Time cl
Time (In clcd)
time, Tag clcd
tagR, Maybe (Maybe c) -> Maybe c
forall (m :: Type -> Type) a. Monad m => m (m a) -> m a
join Maybe (Maybe c)
maybeC)
eraseClockSN Time cl
initialTime (Parallel SN m cl1 a b
snL SN m cl2 a b
snR) = proc (Time cl
time, Tag cl
tag, Maybe a
maybeA) -> do
  case Tag cl
tag of
    Left Tag cl1
tagL -> Time cl1
-> SN m cl1 a b
-> Automaton m (Time cl1, Tag cl1, 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
Time cl1
initialTime SN m cl1 a b
snL -< (Time cl
Time (In cl2)
time, Tag cl1
tagL, Maybe a
maybeA)
    Right Tag cl2
tagR -> Time cl2
-> SN m cl2 a b
-> Automaton m (Time cl2, Tag cl2, 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
Time cl2
initialTime SN m cl2 a b
snR -< (Time cl
Time (In cl2)
time, Tag cl2
tagR, Maybe a
maybeA)
eraseClockSN Time cl
initialTime (Postcompose SN m cl a b1
sn ClSF m (Out cl) b1 b
clsf) =
  let
    proxy :: ClockProxy (Cl (SN m cl a b1))
proxy = SN m cl a b1 -> ClockProxy (Cl (SN m cl a b1))
forall a. ToClockProxy a => a -> ClockProxy (Cl a)
toClockProxy SN m cl a b1
sn
   in
    proc input :: (Time cl, Tag cl, Maybe a)
input@(Time cl
time, Tag cl
tag, Maybe a
_) -> do
      Maybe b1
bMaybe <- Time cl
-> SN m cl a b1
-> Automaton m (Time cl, Tag cl, Maybe a) (Maybe b1)
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
initialTime SN m cl a b1
sn -< (Time cl, Tag cl, Maybe a)
(Time (Out cl), Tag cl, Maybe a)
input
      Automaton m (Time (Out cl), Tag (Out cl), b1) b
-> Automaton m (Maybe (Time (Out cl), Tag (Out cl), b1)) (Maybe b)
forall (m :: Type -> Type) a b.
Monad m =>
Automaton m a b -> Automaton m (Maybe a) (Maybe b)
mapMaybeS (Automaton m (Time (Out cl), Tag (Out cl), b1) b
 -> Automaton m (Maybe (Time (Out cl), Tag (Out cl), b1)) (Maybe b))
-> Automaton m (Time (Out cl), Tag (Out cl), b1) b
-> Automaton m (Maybe (Time (Out cl), Tag (Out cl), b1)) (Maybe b)
forall a b. (a -> b) -> a -> b
$ ClockProxy (Out cl)
-> Time (Out cl)
-> ClSF m (Out cl) b1 b
-> Automaton m (Time (Out cl), Tag (Out cl), b1) b
forall (m :: Type -> Type) cl a b.
(Monad m, Clock m cl) =>
ClockProxy cl
-> Time cl -> ClSF m cl a b -> Automaton m (Time cl, Tag cl, a) b
eraseClockClSF (ClockProxy cl -> ClockProxy (Out cl)
forall cl. ClockProxy cl -> ClockProxy (Out cl)
outProxy ClockProxy cl
ClockProxy (Cl (SN m cl a b1))
proxy) Time cl
Time (Out cl)
initialTime ClSF m (Out cl) b1 b
clsf -< (Time cl
Time (Out cl)
time,,) (Tag (Out cl) -> b1 -> (Time (Out cl), Tag (Out cl), b1))
-> Maybe (Tag (Out cl))
-> Maybe (b1 -> (Time (Out cl), Tag (Out cl), b1))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ClockProxy cl -> Tag cl -> Maybe (Tag (Out cl))
forall cl. ClockProxy cl -> Tag cl -> Maybe (Tag (Out cl))
outTag ClockProxy cl
ClockProxy (Cl (SN m cl a b1))
proxy Tag cl
tag Maybe (b1 -> (Time (Out cl), Tag (Out cl), b1))
-> Maybe b1 -> Maybe (Time (Out cl), Tag (Out cl), b1)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Maybe b1
bMaybe
eraseClockSN Time cl
initialTime (Precompose ClSF m (In cl) a b1
clsf SN m cl b1 b
sn) =
  let
    proxy :: ClockProxy (Cl (SN m cl b1 b))
proxy = SN m cl b1 b -> ClockProxy (Cl (SN m cl b1 b))
forall a. ToClockProxy a => a -> ClockProxy (Cl a)
toClockProxy SN m cl b1 b
sn
   in
    proc (Time cl
time, Tag cl
tag, Maybe a
aMaybe) -> do
      Maybe b1
bMaybe <- Automaton m (Time (In cl), Tag (In cl), a) b1
-> Automaton m (Maybe (Time (In cl), Tag (In cl), a)) (Maybe b1)
forall (m :: Type -> Type) a b.
Monad m =>
Automaton m a b -> Automaton m (Maybe a) (Maybe b)
mapMaybeS (Automaton m (Time (In cl), Tag (In cl), a) b1
 -> Automaton m (Maybe (Time (In cl), Tag (In cl), a)) (Maybe b1))
-> Automaton m (Time (In cl), Tag (In cl), a) b1
-> Automaton m (Maybe (Time (In cl), Tag (In cl), a)) (Maybe b1)
forall a b. (a -> b) -> a -> b
$ ClockProxy (In cl)
-> Time (In cl)
-> ClSF m (In cl) a b1
-> Automaton m (Time (In cl), Tag (In cl), a) b1
forall (m :: Type -> Type) cl a b.
(Monad m, Clock m cl) =>
ClockProxy cl
-> Time cl -> ClSF m cl a b -> Automaton m (Time cl, Tag cl, a) b
eraseClockClSF (ClockProxy cl -> ClockProxy (In cl)
forall cl. ClockProxy cl -> ClockProxy (In cl)
inProxy ClockProxy cl
ClockProxy (Cl (SN m cl b1 b))
proxy) Time cl
Time (In cl)
initialTime ClSF m (In cl) a b1
clsf -< (Time cl
Time (In cl)
time,,) (Tag (In cl) -> a -> (Time (In cl), Tag (In cl), a))
-> Maybe (Tag (In cl))
-> Maybe (a -> (Time (In cl), Tag (In cl), a))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ClockProxy cl -> Tag cl -> Maybe (Tag (In cl))
forall cl. ClockProxy cl -> Tag cl -> Maybe (Tag (In cl))
inTag ClockProxy cl
ClockProxy (Cl (SN m cl b1 b))
proxy Tag cl
tag Maybe (a -> (Time (In cl), Tag (In cl), a))
-> Maybe a -> Maybe (Time (In cl), Tag (In cl), a)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Maybe a
aMaybe
      Time cl
-> SN m cl b1 b
-> Automaton m (Time cl, Tag cl, Maybe b1) (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
initialTime SN m cl b1 b
sn -< (Time cl
Time (In cl)
time, Tag cl
tag, Maybe b1
bMaybe)
eraseClockSN Time cl
initialTime (Feedback ResamplingBuffer {s
buffer :: s
buffer :: ()
buffer, TimeInfo (Out cl) -> d -> s -> m s
put :: TimeInfo (Out cl) -> d -> s -> m s
put :: ()
put, TimeInfo (In cl) -> s -> m (Result s c)
get :: TimeInfo (In cl) -> s -> m (Result s c)
get :: ()
get} SN m cl (a, c) (b, d)
sn) =
  let
    proxy :: ClockProxy (Cl (SN m cl (a, c) (b, d)))
proxy = SN m cl (a, c) (b, d) -> ClockProxy (Cl (SN m cl (a, c) (b, d)))
forall a. ToClockProxy a => a -> ClockProxy (Cl a)
toClockProxy SN m cl (a, c) (b, d)
sn
   in
    s
-> Automaton m ((Time cl, Tag cl, Maybe a), s) (Maybe b, s)
-> Automaton m (Time cl, Tag cl, Maybe a) (Maybe b)
forall (m :: Type -> Type) c a b.
Functor m =>
c -> Automaton m (a, c) (b, c) -> Automaton m a b
feedback s
buffer (Automaton m ((Time cl, Tag cl, Maybe a), s) (Maybe b, s)
 -> Automaton m (Time cl, Tag cl, Maybe a) (Maybe b))
-> Automaton m ((Time cl, Tag cl, Maybe a), s) (Maybe b, s)
-> Automaton m (Time cl, Tag cl, Maybe a) (Maybe b)
forall a b. (a -> b) -> a -> b
$ proc ((Time cl
time, Tag cl
tag, Maybe a
aMaybe), s
buf) -> do
      (Maybe c
cMaybe, s
buf') <- case ClockProxy cl -> Tag cl -> Maybe (Tag (In cl))
forall cl. ClockProxy cl -> Tag cl -> Maybe (Tag (In cl))
inTag ClockProxy cl
ClockProxy (Cl (SN m cl (a, c) (b, d)))
proxy Tag cl
tag of
        Maybe (Tag (In cl))
Nothing -> do
          Automaton m (Maybe c, s) (Maybe c, s)
forall (a :: Type -> Type -> Type) b. Arrow a => a b b
returnA -< (Maybe c
forall a. Maybe a
Nothing, s
buf)
        Just Tag (In cl)
tagIn -> do
          TimeInfo (In cl)
timeInfo <- ClockProxy (In cl)
-> Time (In cl)
-> Automaton m (Time (In cl), Tag (In cl)) (TimeInfo (In cl))
forall (m :: Type -> Type) cl.
(Monad m, Clock m cl) =>
ClockProxy cl
-> Time cl -> Automaton m (Time cl, Tag cl) (TimeInfo cl)
genTimeInfo (ClockProxy cl -> ClockProxy (In cl)
forall cl. ClockProxy cl -> ClockProxy (In cl)
inProxy ClockProxy cl
ClockProxy (Cl (SN m cl (a, c) (b, d)))
proxy) Time cl
Time (In cl)
initialTime -< (Time cl
Time (In cl)
time, Tag (In cl)
tagIn)
          Result s
buf' c
c <- ((TimeInfo (In cl), s) -> m (Result s c))
-> Automaton m (TimeInfo (In cl), s) (Result s c)
forall (m :: Type -> Type) a b.
Functor m =>
(a -> m b) -> Automaton m a b
arrM (((TimeInfo (In cl), s) -> m (Result s c))
 -> Automaton m (TimeInfo (In cl), s) (Result s c))
-> ((TimeInfo (In cl), s) -> m (Result s c))
-> Automaton m (TimeInfo (In cl), s) (Result s c)
forall a b. (a -> b) -> a -> b
$ (TimeInfo (In cl) -> s -> m (Result s c))
-> (TimeInfo (In cl), s) -> m (Result s c)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry TimeInfo (In cl) -> s -> m (Result s c)
get -< (TimeInfo (In cl)
timeInfo, s
buf)
          Automaton m (Maybe c, s) (Maybe c, s)
forall (a :: Type -> Type -> Type) b. Arrow a => a b b
returnA -< (c -> Maybe c
forall a. a -> Maybe a
Just c
c, s
buf')
      Maybe (b, d)
bdMaybe <- Time cl
-> SN m cl (a, c) (b, d)
-> Automaton m (Time cl, Tag cl, Maybe (a, c)) (Maybe (b, d))
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
initialTime SN m cl (a, c) (b, d)
sn -< (Time cl
time, Tag cl
tag, (,) (a -> c -> (a, c)) -> Maybe a -> Maybe (c -> (a, c))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
aMaybe Maybe (c -> (a, c)) -> Maybe c -> Maybe (a, c)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Maybe c
cMaybe)
      case (,) (Tag (Out cl) -> (b, d) -> (Tag (Out cl), (b, d)))
-> Maybe (Tag (Out cl)) -> Maybe ((b, d) -> (Tag (Out cl), (b, d)))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ClockProxy cl -> Tag cl -> Maybe (Tag (Out cl))
forall cl. ClockProxy cl -> Tag cl -> Maybe (Tag (Out cl))
outTag ClockProxy cl
ClockProxy (Cl (SN m cl (a, c) (b, d)))
proxy Tag cl
tag Maybe ((b, d) -> (Tag (Out cl), (b, d)))
-> Maybe (b, d) -> Maybe (Tag (Out cl), (b, d))
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Maybe (b, d)
bdMaybe of
        Maybe (Tag (Out cl), (b, d))
Nothing -> do
          Automaton m (Maybe b, s) (Maybe b, s)
forall (a :: Type -> Type -> Type) b. Arrow a => a b b
returnA -< (Maybe b
forall a. Maybe a
Nothing, s
buf')
        Just (Tag (Out cl)
tagOut, (b
b, d
d)) -> do
          TimeInfo (Out cl)
timeInfo <- ClockProxy (Out cl)
-> Time (Out cl)
-> Automaton m (Time (Out cl), Tag (Out cl)) (TimeInfo (Out cl))
forall (m :: Type -> Type) cl.
(Monad m, Clock m cl) =>
ClockProxy cl
-> Time cl -> Automaton m (Time cl, Tag cl) (TimeInfo cl)
genTimeInfo (ClockProxy cl -> ClockProxy (Out cl)
forall cl. ClockProxy cl -> ClockProxy (Out cl)
outProxy ClockProxy cl
ClockProxy (Cl (SN m cl (a, c) (b, d)))
proxy) Time cl
Time (Out cl)
initialTime -< (Time cl
Time (Out cl)
time, Tag (Out cl)
tagOut)
          s
buf'' <- (((TimeInfo (Out cl), d), s) -> m s)
-> Automaton m ((TimeInfo (Out cl), d), s) s
forall (m :: Type -> Type) a b.
Functor m =>
(a -> m b) -> Automaton m a b
arrM ((((TimeInfo (Out cl), d), s) -> m s)
 -> Automaton m ((TimeInfo (Out cl), d), s) s)
-> (((TimeInfo (Out cl), d), s) -> m s)
-> Automaton m ((TimeInfo (Out cl), d), s) s
forall a b. (a -> b) -> a -> b
$ ((TimeInfo (Out cl), d) -> s -> m s)
-> ((TimeInfo (Out cl), d), s) -> m s
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (((TimeInfo (Out cl), d) -> s -> m s)
 -> ((TimeInfo (Out cl), d), s) -> m s)
-> ((TimeInfo (Out cl), d) -> s -> m s)
-> ((TimeInfo (Out cl), d), s)
-> m s
forall a b. (a -> b) -> a -> b
$ (TimeInfo (Out cl) -> d -> s -> m s)
-> (TimeInfo (Out cl), d) -> s -> m s
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry TimeInfo (Out cl) -> d -> s -> m s
put -< ((TimeInfo (Out cl)
timeInfo, d
d), s
buf')
          Automaton m (Maybe b, s) (Maybe b, s)
forall (a :: Type -> Type -> Type) b. Arrow a => a b b
returnA -< (b -> Maybe b
forall a. a -> Maybe a
Just b
b, s
buf'')
eraseClockSN Time cl
initialTime (FirstResampling SN m cl a1 b1
sn ResamplingBuffer m (In cl) (Out cl) c d
buf) =
  let
    proxy :: ClockProxy (Cl (SN m cl a1 b1))
proxy = SN m cl a1 b1 -> ClockProxy (Cl (SN m cl a1 b1))
forall a. ToClockProxy a => a -> ClockProxy (Cl a)
toClockProxy SN m cl a1 b1
sn
   in
    proc (Time cl
time, Tag cl
tag, Maybe a
acMaybe) -> do
      Maybe b1
bMaybe <- Time cl
-> SN m cl a1 b1
-> Automaton m (Time cl, Tag cl, Maybe a1) (Maybe b1)
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
initialTime SN m cl a1 b1
sn -< (Time cl
Time (In cl)
time, Tag cl
tag, (a1, c) -> a1
forall a b. (a, b) -> a
fst ((a1, c) -> a1) -> Maybe (a1, c) -> Maybe a1
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
Maybe (a1, c)
acMaybe)
      let
        resBufInput :: Maybe
  (Either
     (Time (In cl), Tag (In cl), c) (Time (In cl), Tag (Out cl)))
resBufInput = case (ClockProxy cl -> Tag cl -> Maybe (Tag (In cl))
forall cl. ClockProxy cl -> Tag cl -> Maybe (Tag (In cl))
inTag ClockProxy cl
ClockProxy (Cl (SN m cl a1 b1))
proxy Tag cl
tag, ClockProxy cl -> Tag cl -> Maybe (Tag (Out cl))
forall cl. ClockProxy cl -> Tag cl -> Maybe (Tag (Out cl))
outTag ClockProxy cl
ClockProxy (Cl (SN m cl a1 b1))
proxy Tag cl
tag, (a1, c) -> c
forall a b. (a, b) -> b
snd ((a1, c) -> c) -> Maybe (a1, c) -> Maybe c
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
Maybe (a1, c)
acMaybe) of
          (Just Tag (In cl)
tagIn, Maybe (Tag (Out cl))
_, Just c
c) -> Either (Time (In cl), Tag (In cl), c) (Time (In cl), Tag (Out cl))
-> Maybe
     (Either
        (Time (In cl), Tag (In cl), c) (Time (In cl), Tag (Out cl)))
forall a. a -> Maybe a
Just (Either (Time (In cl), Tag (In cl), c) (Time (In cl), Tag (Out cl))
 -> Maybe
      (Either
         (Time (In cl), Tag (In cl), c) (Time (In cl), Tag (Out cl))))
-> Either
     (Time (In cl), Tag (In cl), c) (Time (In cl), Tag (Out cl))
-> Maybe
     (Either
        (Time (In cl), Tag (In cl), c) (Time (In cl), Tag (Out cl)))
forall a b. (a -> b) -> a -> b
$ (Time (In cl), Tag (In cl), c)
-> Either
     (Time (In cl), Tag (In cl), c) (Time (In cl), Tag (Out cl))
forall a b. a -> Either a b
Left (Time cl
Time (In cl)
time, Tag (In cl)
tagIn, c
c)
          (Maybe (Tag (In cl))
_, Just Tag (Out cl)
tagOut, Maybe c
_) -> Either (Time (In cl), Tag (In cl), c) (Time (In cl), Tag (Out cl))
-> Maybe
     (Either
        (Time (In cl), Tag (In cl), c) (Time (In cl), Tag (Out cl)))
forall a. a -> Maybe a
Just (Either (Time (In cl), Tag (In cl), c) (Time (In cl), Tag (Out cl))
 -> Maybe
      (Either
         (Time (In cl), Tag (In cl), c) (Time (In cl), Tag (Out cl))))
-> Either
     (Time (In cl), Tag (In cl), c) (Time (In cl), Tag (Out cl))
-> Maybe
     (Either
        (Time (In cl), Tag (In cl), c) (Time (In cl), Tag (Out cl)))
forall a b. (a -> b) -> a -> b
$ (Time (In cl), Tag (Out cl))
-> Either
     (Time (In cl), Tag (In cl), c) (Time (In cl), Tag (Out cl))
forall a b. b -> Either a b
Right (Time cl
Time (In cl)
time, Tag (Out cl)
tagOut)
          (Maybe (Tag (In cl)), Maybe (Tag (Out cl)), Maybe c)
_ -> Maybe
  (Either
     (Time (In cl), Tag (In cl), c) (Time (In cl), Tag (Out cl)))
forall a. Maybe a
Nothing
      Maybe (Maybe d)
dMaybe <- Automaton
  m
  (Either
     (Time (In cl), Tag (In cl), c) (Time (In cl), Tag (Out cl)))
  (Maybe d)
-> Automaton
     m
     (Maybe
        (Either
           (Time (In cl), Tag (In cl), c) (Time (In cl), Tag (Out cl))))
     (Maybe (Maybe d))
forall (m :: Type -> Type) a b.
Monad m =>
Automaton m a b -> Automaton m (Maybe a) (Maybe b)
mapMaybeS (Automaton
   m
   (Either
      (Time (In cl), Tag (In cl), c) (Time (In cl), Tag (Out cl)))
   (Maybe d)
 -> Automaton
      m
      (Maybe
         (Either
            (Time (In cl), Tag (In cl), c) (Time (In cl), Tag (Out cl))))
      (Maybe (Maybe d)))
-> Automaton
     m
     (Either
        (Time (In cl), Tag (In cl), c) (Time (In cl), Tag (Out cl)))
     (Maybe d)
-> Automaton
     m
     (Maybe
        (Either
           (Time (In cl), Tag (In cl), c) (Time (In cl), Tag (Out cl))))
     (Maybe (Maybe d))
forall a b. (a -> b) -> a -> b
$ ClockProxy (In cl)
-> ClockProxy (Out cl)
-> Time (In cl)
-> ResamplingBuffer m (In cl) (Out cl) c d
-> Automaton
     m
     (Either
        (Time (In cl), Tag (In cl), c) (Time (Out cl), Tag (Out cl)))
     (Maybe d)
forall (m :: Type -> Type) cl1 cl2 a b.
(Monad m, Clock m cl1, Clock m cl2, Time cl1 ~ Time cl2) =>
ClockProxy cl1
-> ClockProxy cl2
-> Time cl1
-> ResBuf m cl1 cl2 a b
-> Automaton
     m (Either (Time cl1, Tag cl1, a) (Time cl2, Tag cl2)) (Maybe b)
eraseClockResBuf (ClockProxy cl -> ClockProxy (In cl)
forall cl. ClockProxy cl -> ClockProxy (In cl)
inProxy ClockProxy cl
ClockProxy (Cl (SN m cl a1 b1))
proxy) (ClockProxy cl -> ClockProxy (Out cl)
forall cl. ClockProxy cl -> ClockProxy (Out cl)
outProxy ClockProxy cl
ClockProxy (Cl (SN m cl a1 b1))
proxy) Time cl
Time (In cl)
initialTime ResamplingBuffer m (In cl) (Out cl) c d
buf -< Maybe
  (Either
     (Time (In cl), Tag (In cl), c) (Time (In cl), Tag (Out cl)))
resBufInput
      Automaton m (Maybe b) (Maybe b)
forall (a :: Type -> Type -> Type) b. Arrow a => a b b
returnA -< (,) (b1 -> d -> b) -> Maybe b1 -> Maybe (d -> b)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe b1
bMaybe Maybe (d -> b) -> Maybe d -> Maybe b
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Maybe (Maybe d) -> Maybe d
forall (m :: Type -> Type) a. Monad m => m (m a) -> m a
join Maybe (Maybe d)
dMaybe
{-# INLINE eraseClockSN #-}

{- | Translate a resampling buffer into an automaton.

   The input decides whether the buffer is to accept input or has to produce output.
   (In the latter case, only time information is provided.)
-}
eraseClockResBuf ::
  ( Monad m
  , Clock m cl1
  , Clock m cl2
  , Time cl1 ~ Time cl2
  ) =>
  ClockProxy cl1 ->
  ClockProxy cl2 ->
  Time cl1 ->
  ResBuf m cl1 cl2 a b ->
  Automaton m (Either (Time cl1, Tag cl1, a) (Time cl2, Tag cl2)) (Maybe b)
eraseClockResBuf :: forall (m :: Type -> Type) cl1 cl2 a b.
(Monad m, Clock m cl1, Clock m cl2, Time cl1 ~ Time cl2) =>
ClockProxy cl1
-> ClockProxy cl2
-> Time cl1
-> ResBuf m cl1 cl2 a b
-> Automaton
     m (Either (Time cl1, Tag cl1, a) (Time cl2, Tag cl2)) (Maybe b)
eraseClockResBuf ClockProxy cl1
proxy1 ClockProxy cl2
proxy2 Time cl1
initialTime ResamplingBuffer {s
buffer :: ()
buffer :: s
buffer, TimeInfo cl1 -> a -> s -> m s
put :: ()
put :: TimeInfo cl1 -> a -> s -> m s
put, TimeInfo cl2 -> s -> m (Result s b)
get :: ()
get :: TimeInfo cl2 -> s -> m (Result s b)
get} = s
-> Automaton
     m
     (Either (Time cl1, Tag cl1, a) (Time cl2, Tag cl2), s)
     (Maybe b, s)
-> Automaton
     m (Either (Time cl1, Tag cl1, a) (Time cl2, Tag cl2)) (Maybe b)
forall (m :: Type -> Type) c a b.
Functor m =>
c -> Automaton m (a, c) (b, c) -> Automaton m a b
feedback s
buffer (Automaton
   m
   (Either (Time cl1, Tag cl1, a) (Time cl2, Tag cl2), s)
   (Maybe b, s)
 -> Automaton
      m (Either (Time cl1, Tag cl1, a) (Time cl2, Tag cl2)) (Maybe b))
-> Automaton
     m
     (Either (Time cl1, Tag cl1, a) (Time cl2, Tag cl2), s)
     (Maybe b, s)
-> Automaton
     m (Either (Time cl1, Tag cl1, a) (Time cl2, Tag cl2)) (Maybe b)
forall a b. (a -> b) -> a -> b
$ proc (Either (Time cl1, Tag cl1, a) (Time cl2, Tag cl2)
input, s
resBuf) -> do
  case Either (Time cl1, Tag cl1, a) (Time cl2, Tag cl2)
input of
    Left (Time cl1
time1, Tag cl1
tag1, a
a) -> do
      TimeInfo cl1
timeInfo1 <- ClockProxy cl1
-> Time cl1 -> Automaton m (Time cl1, Tag cl1) (TimeInfo cl1)
forall (m :: Type -> Type) cl.
(Monad m, Clock m cl) =>
ClockProxy cl
-> Time cl -> Automaton m (Time cl, Tag cl) (TimeInfo cl)
genTimeInfo ClockProxy cl1
proxy1 Time cl1
initialTime -< (Time cl1
Time cl2
time1, Tag cl1
tag1)
      s
resBuf' <- (((TimeInfo cl1, a), s) -> m s)
-> Automaton m ((TimeInfo cl1, a), s) s
forall (m :: Type -> Type) a b.
Functor m =>
(a -> m b) -> Automaton m a b
arrM (((TimeInfo cl1, a) -> s -> m s) -> ((TimeInfo cl1, a), s) -> m s
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (((TimeInfo cl1, a) -> s -> m s) -> ((TimeInfo cl1, a), s) -> m s)
-> ((TimeInfo cl1, a) -> s -> m s) -> ((TimeInfo cl1, a), s) -> m s
forall a b. (a -> b) -> a -> b
$ (TimeInfo cl1 -> a -> s -> m s) -> (TimeInfo cl1, a) -> s -> m s
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry TimeInfo cl1 -> a -> s -> m s
put) -< ((TimeInfo cl1
timeInfo1, a
a), s
resBuf)
      Automaton m (Maybe b, s) (Maybe b, s)
forall (a :: Type -> Type -> Type) b. Arrow a => a b b
returnA -< (Maybe b
forall a. Maybe a
Nothing, s
resBuf')
    Right (Time cl2
time2, Tag cl2
tag2) -> do
      TimeInfo cl2
timeInfo2 <- ClockProxy cl2
-> Time cl2 -> Automaton m (Time cl2, Tag cl2) (TimeInfo cl2)
forall (m :: Type -> Type) cl.
(Monad m, Clock m cl) =>
ClockProxy cl
-> Time cl -> Automaton m (Time cl, Tag cl) (TimeInfo cl)
genTimeInfo ClockProxy cl2
proxy2 Time cl1
Time cl2
initialTime -< (Time cl2
time2, Tag cl2
tag2)
      Result s
resBuf' b
b <- ((TimeInfo cl2, s) -> m (Result s b))
-> Automaton m (TimeInfo cl2, s) (Result s b)
forall (m :: Type -> Type) a b.
Functor m =>
(a -> m b) -> Automaton m a b
arrM ((TimeInfo cl2 -> s -> m (Result s b))
-> (TimeInfo cl2, s) -> m (Result s b)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry TimeInfo cl2 -> s -> m (Result s b)
get) -< (TimeInfo cl2
timeInfo2, s
resBuf)
      Automaton m (Maybe b, s) (Maybe b, s)
forall (a :: Type -> Type -> Type) b. Arrow a => a b b
returnA -< (b -> Maybe b
forall a. a -> Maybe a
Just b
b, s
resBuf')
{-# INLINE eraseClockResBuf #-}