{- |
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'.
-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
module FRP.Rhine.Reactimation.ClockErasure where

-- base
import Control.Monad (join)
import Data.Maybe (fromJust, fromMaybe)

-- dunai
import Control.Monad.Trans.MSF.Reader
import Data.MonadicStreamFunction
import Data.MonadicStreamFunction.InternalCore

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

-- | Run a clocked signal function as a monadic stream function,
--   accepting the timestamps and tags as explicit inputs.
eraseClockClSF
  :: (Monad m, Clock m cl)
  => ClockProxy cl -> Time cl
  -> ClSF m cl a b
  -> MSF m (Time cl, Tag cl, a) b
eraseClockClSF :: ClockProxy cl
-> Time cl -> ClSF m cl a b -> MSF 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 -> MSF m (Time cl, Tag cl) (TimeInfo cl)
forall (m :: Type -> Type) cl.
(Monad m, Clock m cl) =>
ClockProxy cl -> Time cl -> MSF 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 -> MSF m (TimeInfo cl, a) b
forall (m :: Type -> Type) r a b.
Monad m =>
MSF (ReaderT r m) a b -> MSF m (r, a) b
runReaderS ClSF m cl a b
clsf                           -< (TimeInfo cl
timeInfo, a
a)

-- | Run a signal network as a monadic stream function.
--
--   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
  -> MSF 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 :: Time cl
-> SN m cl a b -> MSF 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 -> MSF 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 -> MSF 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)
  MSF 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 b
sn1 ResamplingBuffer m (Out clab) (In clcd) b c
resBuf SN m clcd c b
sn2) =
  let
    proxy1 :: ClockProxy (Cl (SN m clab a b))
proxy1 = SN m clab a b -> ClockProxy (Cl (SN m clab a b))
forall a. ToClockProxy a => a -> ClockProxy (Cl a)
toClockProxy SN m clab a b
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 cl, Tag (Out clab), b) (Time cl, Tag (In clcd)))
resBufIn <- case Tag cl
tag of
    Left  tagL -> do
      Maybe b
maybeB <- Time clab
-> SN m clab a b -> MSF m (Time clab, Tag clab, 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 -> MSF m (Time cl, Tag cl, Maybe a) (Maybe b)
eraseClockSN Time cl
Time clab
initialTime SN m clab a b
sn1 -< (Time cl
time, Tag clab
tagL, Maybe a
maybeA)
      MSF
  m
  (Maybe
     (Either (Time cl, Tag (Out clab), b) (Time cl, Tag (In clcd))))
  (Maybe
     (Either (Time cl, Tag (Out clab), b) (Time cl, Tag (In clcd))))
forall (a :: Type -> Type -> Type) b. Arrow a => a b b
returnA -< (Time cl, Tag (Out clab), b)
-> Either (Time cl, Tag (Out clab), b) (Time cl, Tag (In clcd))
forall a b. a -> Either a b
Left ((Time cl, Tag (Out clab), b)
 -> Either (Time cl, Tag (Out clab), b) (Time cl, Tag (In clcd)))
-> Maybe (Time cl, Tag (Out clab), b)
-> Maybe
     (Either (Time cl, Tag (Out clab), b) (Time cl, Tag (In clcd)))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Time cl
time, , ) (Tag (Out clab) -> b -> (Time cl, Tag (Out clab), b))
-> Maybe (Tag (Out clab))
-> Maybe (b -> (Time cl, Tag (Out clab), b))
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 b))
proxy1 Tag clab
tagL Maybe (b -> (Time cl, Tag (Out clab), b))
-> Maybe b -> Maybe (Time cl, Tag (Out clab), b)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Maybe b
maybeB)
    Right tagR -> do
      MSF
  m
  (Maybe
     (Either (Time cl, Tag (Out clab), b) (Time cl, Tag (In clcd))))
  (Maybe
     (Either (Time cl, Tag (Out clab), b) (Time cl, Tag (In clcd))))
forall (a :: Type -> Type -> Type) b. Arrow a => a b b
returnA -< (Time cl, Tag (In clcd))
-> Either (Time cl, Tag (Out clab), b) (Time cl, Tag (In clcd))
forall a b. b -> Either a b
Right ((Time cl, Tag (In clcd))
 -> Either (Time cl, Tag (Out clab), b) (Time cl, Tag (In clcd)))
-> (Tag (In clcd) -> (Time cl, Tag (In clcd)))
-> Tag (In clcd)
-> Either (Time cl, Tag (Out clab), b) (Time cl, Tag (In clcd))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Time cl
time, ) (Tag (In clcd)
 -> Either (Time cl, Tag (Out clab), b) (Time cl, Tag (In clcd)))
-> Maybe (Tag (In clcd))
-> Maybe
     (Either (Time cl, Tag (Out clab), b) (Time cl, 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 <- MSF
  m
  (Either (Time cl, Tag (Out clab), b) (Time cl, Tag (In clcd)))
  (Maybe c)
-> MSF
     m
     (Maybe
        (Either (Time cl, Tag (Out clab), b) (Time cl, Tag (In clcd))))
     (Maybe (Maybe c))
forall (m :: Type -> Type) a b.
Monad m =>
MSF m a b -> MSF m (Maybe a) (Maybe b)
mapMaybeS (MSF
   m
   (Either (Time cl, Tag (Out clab), b) (Time cl, Tag (In clcd)))
   (Maybe c)
 -> MSF
      m
      (Maybe
         (Either (Time cl, Tag (Out clab), b) (Time cl, Tag (In clcd))))
      (Maybe (Maybe c)))
-> MSF
     m
     (Either (Time cl, Tag (Out clab), b) (Time cl, Tag (In clcd)))
     (Maybe c)
-> MSF
     m
     (Maybe
        (Either (Time cl, Tag (Out clab), b) (Time cl, 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) b c
-> MSF
     m
     (Either
        (Time (Out clab), Tag (Out clab), b)
        (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
-> MSF
     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 b))
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) b c
resBuf -< Maybe
  (Either (Time cl, Tag (Out clab), b) (Time cl, Tag (In clcd)))
resBufIn
  case Tag cl
tag of
    Left  _    -> do
      MSF 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 tagR -> do
      Time clcd
-> SN m clcd c b -> MSF 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 -> MSF m (Time cl, Tag cl, Maybe a) (Maybe b)
eraseClockSN Time cl
Time clcd
initialTime SN m clcd c b
sn2 -< (Time cl
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  tagL -> Time cl1
-> SN m cl1 a b -> MSF 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 -> MSF m (Time cl, Tag cl, Maybe a) (Maybe b)
eraseClockSN Time cl
Time cl1
initialTime SN m cl1 a b
snL -< (Time cl
time, Tag cl1
tagL, Maybe a
maybeA)
    Right tagR -> Time cl2
-> SN m cl2 a b -> MSF 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 -> MSF m (Time cl, Tag cl, Maybe a) (Maybe b)
eraseClockSN Time cl
Time cl2
initialTime SN m cl2 a b
snR -< (Time cl
time, Tag cl2
tagR, Maybe a
maybeA)

-- | Translate a resampling buffer into a monadic stream function.
--
--   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
  -> MSF m (Either (Time cl1, Tag cl1, a) (Time cl2, Tag cl2)) (Maybe b)
eraseClockResBuf :: ClockProxy cl1
-> ClockProxy cl2
-> Time cl1
-> ResBuf m cl1 cl2 a b
-> MSF
     m (Either (Time cl1, Tag cl1, a) (Time cl2, Tag cl2)) (Maybe b)
eraseClockResBuf ClockProxy cl1
proxy1 ClockProxy cl2
proxy2 Time cl1
initialTime ResBuf m cl1 cl2 a b
resBuf0 = ResBuf m cl1 cl2 a b
-> MSF
     m
     (Either (Time cl2, Tag cl1, a) (Time cl2, Tag cl2),
      ResBuf m cl1 cl2 a b)
     (Maybe b, ResBuf m cl1 cl2 a b)
-> MSF
     m (Either (Time cl2, Tag cl1, a) (Time cl2, Tag cl2)) (Maybe b)
forall (m :: Type -> Type) c a b.
Monad m =>
c -> MSF m (a, c) (b, c) -> MSF m a b
feedback ResBuf m cl1 cl2 a b
resBuf0 (MSF
   m
   (Either (Time cl2, Tag cl1, a) (Time cl2, Tag cl2),
    ResBuf m cl1 cl2 a b)
   (Maybe b, ResBuf m cl1 cl2 a b)
 -> MSF
      m (Either (Time cl2, Tag cl1, a) (Time cl2, Tag cl2)) (Maybe b))
-> MSF
     m
     (Either (Time cl2, Tag cl1, a) (Time cl2, Tag cl2),
      ResBuf m cl1 cl2 a b)
     (Maybe b, ResBuf m cl1 cl2 a b)
-> MSF
     m (Either (Time cl2, Tag cl1, a) (Time cl2, Tag cl2)) (Maybe b)
forall a b. (a -> b) -> a -> b
$ proc (Either (Time cl2, Tag cl1, a) (Time cl2, Tag cl2)
input, ResBuf m cl1 cl2 a b
resBuf) -> do
  case Either (Time cl2, Tag cl1, a) (Time cl2, Tag cl2)
input of
    Left (Time cl2
time1, Tag cl1
tag1, a
a) -> do
      TimeInfo cl1
timeInfo1 <- ClockProxy cl1
-> Time cl1 -> MSF m (Time cl1, Tag cl1) (TimeInfo cl1)
forall (m :: Type -> Type) cl.
(Monad m, Clock m cl) =>
ClockProxy cl -> Time cl -> MSF m (Time cl, Tag cl) (TimeInfo cl)
genTimeInfo ClockProxy cl1
proxy1 Time cl1
initialTime   -< (Time cl2
time1, Tag cl1
tag1)
      ResBuf m cl1 cl2 a b
resBuf'   <- (((ResBuf m cl1 cl2 a b, TimeInfo cl1), a)
 -> m (ResBuf m cl1 cl2 a b))
-> MSF
     m ((ResBuf m cl1 cl2 a b, TimeInfo cl1), a) (ResBuf m cl1 cl2 a b)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> MSF m a b
arrM (((ResBuf m cl1 cl2 a b, TimeInfo cl1)
 -> a -> m (ResBuf m cl1 cl2 a b))
-> ((ResBuf m cl1 cl2 a b, TimeInfo cl1), a)
-> m (ResBuf m cl1 cl2 a b)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (((ResBuf m cl1 cl2 a b, TimeInfo cl1)
  -> a -> m (ResBuf m cl1 cl2 a b))
 -> ((ResBuf m cl1 cl2 a b, TimeInfo cl1), a)
 -> m (ResBuf m cl1 cl2 a b))
-> ((ResBuf m cl1 cl2 a b, TimeInfo cl1)
    -> a -> m (ResBuf m cl1 cl2 a b))
-> ((ResBuf m cl1 cl2 a b, TimeInfo cl1), a)
-> m (ResBuf m cl1 cl2 a b)
forall a b. (a -> b) -> a -> b
$ (ResBuf m cl1 cl2 a b
 -> TimeInfo cl1 -> a -> m (ResBuf m cl1 cl2 a b))
-> (ResBuf m cl1 cl2 a b, TimeInfo cl1)
-> a
-> m (ResBuf m cl1 cl2 a b)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ResBuf m cl1 cl2 a b
-> TimeInfo cl1 -> a -> m (ResBuf m cl1 cl2 a b)
forall (m :: Type -> Type) cla clb a b.
ResamplingBuffer m cla clb a b
-> TimeInfo cla -> a -> m (ResamplingBuffer m cla clb a b)
put)     -< ((ResBuf m cl1 cl2 a b
resBuf, TimeInfo cl1
timeInfo1), a
a)
      MSF
  m (Maybe b, ResBuf m cl1 cl2 a b) (Maybe b, ResBuf m cl1 cl2 a b)
forall (a :: Type -> Type -> Type) b. Arrow a => a b b
returnA                                       -< (Maybe b
forall a. Maybe a
Nothing, ResBuf m cl1 cl2 a b
resBuf')
    Right (Time cl2
time2, Tag cl2
tag2) -> do
      TimeInfo cl2
timeInfo2    <- ClockProxy cl2
-> Time cl2 -> MSF m (Time cl2, Tag cl2) (TimeInfo cl2)
forall (m :: Type -> Type) cl.
(Monad m, Clock m cl) =>
ClockProxy cl -> Time cl -> MSF m (Time cl, Tag cl) (TimeInfo cl)
genTimeInfo ClockProxy cl2
proxy2 Time cl1
Time cl2
initialTime -< (Time cl2
time2, Tag cl2
tag2)
      (b
b, ResBuf m cl1 cl2 a b
resBuf') <- ((ResBuf m cl1 cl2 a b, TimeInfo cl2)
 -> m (b, ResBuf m cl1 cl2 a b))
-> MSF
     m (ResBuf m cl1 cl2 a b, TimeInfo cl2) (b, ResBuf m cl1 cl2 a b)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> MSF m a b
arrM ((ResBuf m cl1 cl2 a b
 -> TimeInfo cl2 -> m (b, ResBuf m cl1 cl2 a b))
-> (ResBuf m cl1 cl2 a b, TimeInfo cl2)
-> m (b, ResBuf m cl1 cl2 a b)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ResBuf m cl1 cl2 a b -> TimeInfo cl2 -> m (b, ResBuf m cl1 cl2 a b)
forall (m :: Type -> Type) cla clb a b.
ResamplingBuffer m cla clb a b
-> TimeInfo clb -> m (b, ResamplingBuffer m cla clb a b)
get)             -< (ResBuf m cl1 cl2 a b
resBuf, TimeInfo cl2
timeInfo2)
      MSF
  m (Maybe b, ResBuf m cl1 cl2 a b) (Maybe b, ResBuf m cl1 cl2 a b)
forall (a :: Type -> Type -> Type) b. Arrow a => a b b
returnA                                        -< (b -> Maybe b
forall a. a -> Maybe a
Just b
b, ResBuf m cl1 cl2 a b
resBuf')