packages feed

rhine 0.6.0 → 0.7.0

raw patch · 22 files changed

+339/−281 lines, 22 filesdep ~MonadRandomdep ~containersdep ~deepseq

Dependency ranges changed: MonadRandom, containers, deepseq, free, random, transformers, vector-sized

Files

ChangeLog.md view
@@ -4,6 +4,14 @@ Since `rhine` reexports modules from `dunai`, every major version in `dunai` triggers a major version in `rhine`. +## 0.7.0++* Replaced old reactimation mechanism by clock erasure+* Dropped GHC support for < 8.4+* Reworked `gloss` backends.+  There are now two pure backends and an `IO` backend.+* Relaxed all upper version bounds+ ## 0.6.0  * Synced with `dunai` version numbers
rhine.cabal view
@@ -1,6 +1,6 @@ name:                rhine -version:             0.6.0+version:             0.7.0  synopsis: Functional Reactive Programming with type-level clocks @@ -46,7 +46,7 @@ source-repository this   type:     git   location: git@github.com:turion/rhine.git-  tag:      v0.6.0+  tag:      v0.7.0   library@@ -54,14 +54,16 @@     Control.Monad.Schedule     FRP.Rhine     FRP.Rhine.Clock+    FRP.Rhine.Clock.FixedStep     FRP.Rhine.Clock.Periodic+    FRP.Rhine.Clock.Proxy     FRP.Rhine.Clock.Realtime.Audio     FRP.Rhine.Clock.Realtime.Busy     FRP.Rhine.Clock.Realtime.Event     FRP.Rhine.Clock.Realtime.Millisecond     FRP.Rhine.Clock.Realtime.Stdin     FRP.Rhine.Clock.Select-    FRP.Rhine.Clock.FixedStep+    FRP.Rhine.Clock.Util     FRP.Rhine.ClSF     FRP.Rhine.ClSF.Core     FRP.Rhine.ClSF.Except@@ -70,7 +72,7 @@     FRP.Rhine.ClSF.Upsample     FRP.Rhine.ClSF.Util     FRP.Rhine.Reactimation-    FRP.Rhine.Reactimation.Tick+    FRP.Rhine.Reactimation.ClockErasure     FRP.Rhine.Reactimation.Combinators     FRP.Rhine.ResamplingBuffer     FRP.Rhine.ResamplingBuffer.Collect@@ -100,14 +102,14 @@   -- Other library packages from which modules are imported.   build-depends:       base         >= 4.9 && < 5                      , dunai        >= 0.6-                     , transformers == 0.5.*+                     , transformers >= 0.5                      , time         >= 1.8-                     , free         == 5.1.*-                     , containers   == 0.6.*-                     , vector-sized == 1.4.*-                     , deepseq      == 1.4.*-                     , random       == 1.1.*-                     , MonadRandom  == 0.5.*+                     , free         >= 5.1+                     , containers   >= 0.5+                     , vector-sized >= 1.4+                     , deepseq      >= 1.4+                     , random       >= 1.1+                     , MonadRandom  >= 0.5                      , simple-affine-space    -- Directories containing source files.
src/FRP/Rhine.hs view
@@ -20,6 +20,8 @@  -- rhine import FRP.Rhine.Clock                    as X+import FRP.Rhine.Clock.Proxy              as X+import FRP.Rhine.Clock.Util               as X import FRP.Rhine.ClSF                     as X import FRP.Rhine.Reactimation             as X import FRP.Rhine.Reactimation.Combinators as X
src/FRP/Rhine/Clock.hs view
@@ -70,7 +70,6 @@     :: cl -- ^ The clock value, containing e.g. settings or device parameters     -> RunningClockInit m (Time cl) (Tag cl) -- ^ The stream of time stamps, and the initial time - -- * Auxiliary definitions and utilities  -- | An annotated, rich time stamp.@@ -91,22 +90,6 @@   => (Tag cl1 -> Tag cl2)   -> TimeInfo cl1 -> TimeInfo cl2 retag f TimeInfo {..} = TimeInfo { tag = f tag, .. }----- | Given a clock value and an initial time,---   generate a stream of time stamps.-genTimeInfo-  :: (Monad m, Clock m cl)-  => cl -> Time cl-  -> MSF m (Time cl, Tag cl) (TimeInfo cl)-genTimeInfo _ initialTime = proc (absolute, tag) -> do-  lastTime <- iPre initialTime -< absolute-  returnA                      -< TimeInfo-    { sinceLast = absolute `diffTime` lastTime-    , sinceInit = absolute `diffTime` initialTime-    , ..-    }-  -- * Certain universal building blocks to produce new clocks from given ones
src/FRP/Rhine/Clock/FixedStep.hs view
@@ -26,6 +26,7 @@  -- rhine import FRP.Rhine.Clock+import FRP.Rhine.Clock.Proxy import FRP.Rhine.ResamplingBuffer import FRP.Rhine.ResamplingBuffer.Collect import FRP.Rhine.ResamplingBuffer.Util@@ -50,6 +51,8 @@       &&& arr (const ())     , 0     )++instance GetClockProxy (FixedStep n)  -- | A singleton clock that counts the ticks. type Count = FixedStep 1
src/FRP/Rhine/Clock/Periodic.hs view
@@ -27,6 +27,7 @@  -- rhine import FRP.Rhine.Clock+import FRP.Rhine.Clock.Proxy import Control.Monad.Schedule  -- * The 'Periodic' clock@@ -48,6 +49,8 @@     ( cycleS (theList cl) >>> withSideEffect wait >>> (accumulateWith (+) 0) &&& arr (const ())     , 0     )++instance GetClockProxy (Periodic v)  -- * Type-level trickery to extract the type value from the singleton
+ src/FRP/Rhine/Clock/Proxy.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE TypeFamilies #-}+module FRP.Rhine.Clock.Proxy where++-- base+import Data.Kind (Type)++-- rhine+import FRP.Rhine.Clock+import FRP.Rhine.Schedule++-- | Witnesses the structure of a clock type,+--   in particular whether 'SequentialClock's or 'ParallelClock's are involved.+data ClockProxy cl where+  LeafProxy+    :: (cl ~ In cl, cl ~ Out cl)+    => ClockProxy cl+  SequentialProxy+    :: ClockProxy cl1+    -> ClockProxy cl2+    -> ClockProxy (SequentialClock m cl1 cl2)+  ParallelProxy+    :: ClockProxy clL+    -> ClockProxy clR+    -> ClockProxy (ParallelClock m clL clR)++inProxy :: ClockProxy cl -> ClockProxy (In cl)+inProxy LeafProxy = LeafProxy+inProxy (SequentialProxy p1 p2) = inProxy p1+inProxy (ParallelProxy pL pR) = ParallelProxy (inProxy pL) (inProxy pR)++outProxy :: ClockProxy cl -> ClockProxy (Out cl)+outProxy LeafProxy = LeafProxy+outProxy (SequentialProxy p1 p2) = outProxy p2+outProxy (ParallelProxy pL pR) = ParallelProxy (outProxy pL) (outProxy pR)++-- | Return the incoming tag, assuming that the incoming clock is ticked,+--   and 'Nothing' otherwise.+inTag :: ClockProxy cl -> Tag cl -> Maybe (Tag (In cl))+inTag (SequentialProxy p1 _) (Left  tag1) = inTag p1 tag1+inTag (SequentialProxy _  _) (Right _)    = Nothing+inTag (ParallelProxy pL _) (Left  tagL) = Left  <$> inTag pL tagL+inTag (ParallelProxy _ pR) (Right tagR) = Right <$> inTag pR tagR+inTag LeafProxy tag = Just tag++-- | Return the incoming tag, assuming that the outgoing clock is ticked,+--   and 'Nothing' otherwise.+outTag :: ClockProxy cl -> Tag cl -> Maybe (Tag (Out cl))+outTag (SequentialProxy _ _ ) (Left  _)    = Nothing+outTag (SequentialProxy _ p2) (Right tag2) = outTag p2 tag2+outTag (ParallelProxy pL _) (Left  tagL) = Left  <$> outTag pL tagL+outTag (ParallelProxy _ pR) (Right tagR) = Right <$> outTag pR tagR+outTag LeafProxy tag = Just tag++-- TODO Should this be a superclass with default implementation of clocks? But then we have a circular dependency...+-- No we don't, Schedule should not depend on clock (the type).+-- | Clocks should be able to automatically generate a proxy for themselves.+class GetClockProxy cl where+  getClockProxy :: ClockProxy cl++  default getClockProxy+    :: (cl ~ In cl, cl ~ Out cl)+    => ClockProxy cl+  getClockProxy = LeafProxy++instance (GetClockProxy cl1, GetClockProxy cl2) => GetClockProxy (SequentialClock m cl1 cl2) where+  getClockProxy = SequentialProxy getClockProxy getClockProxy++instance (GetClockProxy cl1, GetClockProxy cl2) => GetClockProxy (ParallelClock m cl1 cl2) where+  getClockProxy = ParallelProxy getClockProxy getClockProxy++instance GetClockProxy cl => GetClockProxy (HoistClock m1 m2 cl)+instance GetClockProxy cl => GetClockProxy (RescaledClock cl time)+instance GetClockProxy cl => GetClockProxy (RescaledClockM m cl time)+instance GetClockProxy cl => GetClockProxy (RescaledClockS m cl time tag)++-- | Extract a clock proxy from a type.+class ToClockProxy a where+  type Cl a :: Type++  toClockProxy :: a -> ClockProxy (Cl a)++  default toClockProxy+    :: GetClockProxy (Cl a)+    => a -> ClockProxy (Cl a)+  toClockProxy _ = getClockProxy
src/FRP/Rhine/Clock/Realtime/Audio.hs view
@@ -36,6 +36,7 @@  -- rhine import FRP.Rhine.Clock+import FRP.Rhine.Clock.Proxy  -- | Rates at which audio signals are typically sampled. data AudioRate@@ -122,6 +123,8 @@       , initialTime       ) +instance GetClockProxy (AudioClock rate bufferSize)+ {- | A side-effect free clock for audio synthesis and analysis. The sample rate is given by 'rate' (of type 'AudioRate').@@ -149,6 +152,7 @@     , 0     ) +instance GetClockProxy (PureAudioClock rate)  -- | A rescaled version of 'PureAudioClock' with 'TimeDomain' 'Float'. type PureAudioClockF (rate :: AudioRate) = RescaledClock (PureAudioClock rate) Float@@ -160,4 +164,4 @@ pureAudioClockF = RescaledClock   { unscaledClock = PureAudioClock   , rescale       = double2Float-}+  }
src/FRP/Rhine/Clock/Realtime/Busy.hs view
@@ -9,6 +9,7 @@  -- rhine import FRP.Rhine.Clock+import FRP.Rhine.Clock.Proxy  {- | A clock that ticks without waiting.@@ -28,3 +29,5 @@         &&& arr (const ())       , initialTime       )++instance GetClockProxy Busy
src/FRP/Rhine/Clock/Realtime/Event.hs view
@@ -43,6 +43,7 @@ import Control.Monad.Trans.Reader  -- rhine+import FRP.Rhine.Clock.Proxy import FRP.Rhine.ClSF import FRP.Rhine.Schedule import FRP.Rhine.Schedule.Concurrently@@ -160,6 +161,8 @@           return (time, event)       , initialTime       )++instance GetClockProxy (EventClock event)  -- | Create an event clock that is bound to a specific event channel. --   This is usually only useful if you can't apply 'runEventChanT'
src/FRP/Rhine/Clock/Realtime/Millisecond.hs view
@@ -21,6 +21,7 @@  -- rhine import FRP.Rhine.Clock+import FRP.Rhine.Clock.Proxy import FRP.Rhine.Clock.FixedStep import FRP.Rhine.Schedule import FRP.Rhine.ResamplingBuffer@@ -46,6 +47,7 @@   type Tag  (Millisecond n) = Bool   initClock (Millisecond cl) = initClock cl +instance GetClockProxy (Millisecond n)  -- | This implementation measures the time after each tick, --   and waits for the remaining time until the next tick.
src/FRP/Rhine/Clock/Realtime/Stdin.hs view
@@ -18,6 +18,7 @@  -- rhine import FRP.Rhine.Clock+import FRP.Rhine.Clock.Proxy import Data.Semigroup  {- |@@ -39,6 +40,8 @@           return (time, line)       , initialTime       )++instance GetClockProxy StdinClock  instance Semigroup StdinClock where   _ <> _ = StdinClock
src/FRP/Rhine/Clock/Select.hs view
@@ -16,6 +16,7 @@  -- rhine import FRP.Rhine.Clock+import FRP.Rhine.Clock.Proxy import FRP.Rhine.Schedule  -- dunai@@ -50,6 +51,7 @@         returnA                     -< (time, ) <$> select tag     return (runningSelectClock, initialTime) +instance GetClockProxy (SelectClock cl a)  -- | A universal schedule for two subclocks of the same main clock. --   The main clock must be a 'Semigroup' (e.g. a singleton).
+ src/FRP/Rhine/Clock/Util.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE Arrows #-}+{-# LANGUAGE RecordWildCards #-}+module FRP.Rhine.Clock.Util where++-- rhine+import FRP.Rhine.Clock+import FRP.Rhine.Clock.Proxy+import FRP.Rhine.TimeDomain++-- * Auxiliary definitions and utilities++-- | Given a clock value and an initial time,+--   generate a stream of time stamps.+genTimeInfo+  :: (Monad m, Clock m cl)+  => ClockProxy cl -> Time cl+  -> MSF m (Time cl, Tag cl) (TimeInfo cl)+genTimeInfo _ initialTime = proc (absolute, tag) -> do+  lastTime <- iPre initialTime -< absolute+  returnA                      -< TimeInfo+    { sinceLast = absolute `diffTime` lastTime+    , sinceInit = absolute `diffTime` initialTime+    , ..+    }
src/FRP/Rhine/Reactimation.hs view
@@ -3,18 +3,23 @@ as main loops. -} +{-# LANGUAGE Arrows #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE RecordWildCards #-} module FRP.Rhine.Reactimation where +-- base+import Control.Monad ((>=>))+import Data.Functor (void)  -- dunai import Data.MonadicStreamFunction.InternalCore  -- rhine import FRP.Rhine.Clock+import FRP.Rhine.Clock.Proxy import FRP.Rhine.ClSF.Core-import FRP.Rhine.Reactimation.Tick+import FRP.Rhine.Reactimation.ClockErasure import FRP.Rhine.Reactimation.Combinators import FRP.Rhine.Schedule import FRP.Rhine.Type@@ -53,32 +58,20 @@ -- TODO Can we chuck the constraints into Clock m cl? flow   :: ( Monad m, Clock m cl+     , GetClockProxy cl      , Time cl ~ Time (In  cl)      , Time cl ~ Time (Out cl)      )   => Rhine m cl () () -> m ()-flow Rhine {..} = do-  (runningClock, initTime) <- initClock clock-  -- Run the main loop-  flow' runningClock $ createTickable-    (trivialResamplingBuffer clock)-    sn-    (trivialResamplingBuffer clock)-    initTime-    where-      flow' runningClock tickable = do-        -- Fetch the next time stamp from the stream, wait if necessary-        ((now, tag), runningClock') <- unMSF runningClock ()-        -- Process the part of the signal network that is scheduled to run-        tickable' <- tick tickable now tag-        -- Loop-        flow' runningClock' tickable'-+flow rhine = do+  msf <- eraseClock rhine+  reactimate $ msf >>> arr (const ())  -- | Run a synchronous 'ClSF' with its clock as a main loop, --   similar to Yampa's, or Dunai's, 'reactimate'. reactimateCl   :: ( Monad m, Clock m cl+     , GetClockProxy cl      , cl ~ In  cl, cl ~ Out cl      )   => cl -> ClSF m cl () () -> m ()
+ src/FRP/Rhine/Reactimation/ClockErasure.hs view
@@ -0,0 +1,111 @@+{- |+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 proxy initialTime clsf = proc (time, tag, a) -> do+  timeInfo <- genTimeInfo proxy initialTime -< (time, tag)+  runReaderS clsf                           -< (timeInfo, 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 initialTime sn@(Synchronous clsf) = proc (time, tag, Just a) -> do+  b <- eraseClockClSF (toClockProxy sn) initialTime clsf -< (time, tag, a)+  returnA                                                -< Just 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 initialTime (Sequential sn1 resBuf sn2) =+  let+    proxy1 = toClockProxy sn1+    proxy2 = toClockProxy sn2+  in proc (time, tag, maybeA) -> do+  resBufIn <- case tag of+    Left  tagL -> do+      maybeB <- eraseClockSN initialTime sn1 -< (time, tagL, maybeA)+      returnA -< Left <$> ((time, , ) <$> outTag proxy1 tagL <*> maybeB)+    Right tagR -> do+      returnA -< Right <$> (time, ) <$> inTag proxy2 tagR+  maybeC <- mapMaybeS $ eraseClockResBuf (outProxy proxy1) (inProxy proxy2) initialTime resBuf -< resBufIn+  case tag of+    Left  _    -> do+      returnA -< Nothing+    Right tagR -> do+      eraseClockSN initialTime sn2 -< (time, tagR, join maybeC)++eraseClockSN initialTime (Parallel snL snR) = proc (time, tag, maybeA) -> do+  case tag of+    Left  tagL -> eraseClockSN initialTime snL -< (time, tagL, maybeA)+    Right tagR -> eraseClockSN initialTime snR -< (time, tagR, 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 proxy1 proxy2 initialTime resBuf0 = feedback resBuf0 $ proc (input, resBuf) -> do+  case input of+    Left (time1, tag1, a) -> do+      timeInfo1 <- genTimeInfo proxy1 initialTime   -< (time1, tag1)+      resBuf'   <- arrM (uncurry $ uncurry put)     -< ((resBuf, timeInfo1), a)+      returnA                                       -< (Nothing, resBuf')+    Right (time2, tag2) -> do+      timeInfo2    <- genTimeInfo proxy2 initialTime -< (time2, tag2)+      (b, resBuf') <- arrM (uncurry get)             -< (resBuf, timeInfo2)+      returnA                                        -< (Just b, resBuf')
src/FRP/Rhine/Reactimation/Combinators.hs view
@@ -21,6 +21,7 @@  -- rhine import FRP.Rhine.Clock+import FRP.Rhine.Clock.Proxy import FRP.Rhine.ClSF.Core import FRP.Rhine.ResamplingBuffer import FRP.Rhine.Schedule@@ -98,8 +99,9 @@          , Time cl1 ~ Time cl2          , Time (Out cl1) ~ Time cl1          , Time (In  cl2) ~ Time cl2-         , Clock m (Out cl1)-         , Clock m (In  cl2)+         , Clock m (Out cl1), Clock m (Out cl2)+         , Clock m (In  cl1), Clock m (In  cl2)+         , GetClockProxy cl1, GetClockProxy cl2          )       => RhineAndResamplingPoint   m cl1 cl2  a b       -> Rhine m                         cl2    b c@@ -139,6 +141,8 @@ infix 3 @++ (@++)   :: ( Monad m, Clock m clL, Clock m clR+     , Clock m (Out clL), Clock m (Out clR)+     , GetClockProxy clL, GetClockProxy clR      , Time clL ~ Time (Out clL), Time clR ~ Time (Out clR)      , Time clL ~ Time (In  clL), Time clR ~ Time (In  clR)      , Time clL ~ Time clR@@ -176,6 +180,8 @@ infix 3 @|| (@||)   :: ( Monad m, Clock m clL, Clock m clR+     , Clock m (Out clL), Clock m (Out clR)+     , GetClockProxy clL, GetClockProxy clR      , Time clL ~ Time (Out clL), Time clR ~ Time (Out clR)      , Time clL ~ Time (In  clL), Time clR ~ Time (In  clR)      , Time clL ~ Time clR
− src/FRP/Rhine/Reactimation/Tick.hs 
@@ -1,231 +0,0 @@-{- |-This module contains internals needed for the reactimation of signal functions.-None of it should be relevant for a typical user of this library.--}--{-# LANGUAGE GADTs #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE RecordWildCards #-}-module FRP.Rhine.Reactimation.Tick where---- transformers-import Control.Monad.Trans.Reader---- dunai-import Data.MonadicStreamFunction-import Data.MonadicStreamFunction.InternalCore---- rhine-import FRP.Rhine.Clock-import FRP.Rhine.ResamplingBuffer-import FRP.Rhine.Schedule-import FRP.Rhine.SN---{- | A signal network ('SN') enclosed by matching 'ResamplingBuffer's and further auxiliary data,-such that it can be stepped with each arriving tick from a clock 'cl'.-They play a similar role like 'ReactHandle's in dunai.--The type parameters:--* 'm': The monad in which the 'SN' and the 'ResamplingBuffer's produce side effects-* 'cla': The (irrelevant) input clock of the left 'ResamplingBuffer'-* 'clb': The clock at which the left 'ResamplingBuffer' produces output-* 'cl': The clock at which the 'SN' ticks-* 'clc': The clock at which the right 'ResamplingBuffer' accepts input-* 'cld': The (irrelevant) output clock of the right 'ResamplingBuffer'-* 'a': The (irrelevant) input type of the left 'ResamplingBuffer'-* 'b': The input type of the 'SN'-* 'c': The output type of the 'SN'-* 'd': The (irrelevant) output type of the right 'ResamplingBuffer'--}-data Tickable m cla clb cl clc cld a b c d = Tickable-  { -- | The left buffer from which the input is taken.-    buffer1     :: ResamplingBuffer m cla clb          a b-    -- | The signal network that will process the data.-  , ticksn      :: SN               m        cl          b c-    -- | The right buffer in which the output is stored.-  , buffer2     :: ResamplingBuffer m          clc cld     c d-    -- | The leftmost clock of the signal network, 'cl',-    --   may be a parallel subclock of the buffer clock.-    --   'parClockIn' specifies in which position 'In cl'-    --   is a parallel subclock of 'clb'.-  , parClockIn  :: ParClockInclusion (In  cl) clb-    -- | The same on the output side.-  , parClockOut :: ParClockInclusion (Out cl) clc-    -- | The last times when the different parts of the signal tree have ticked.-  , lastTime    :: LastTime cl-    -- | The time when the whole clock was initialised.-  , initTime    :: Time cl-  }----- | Initialise the tree of last tick times.-initLastTime :: SN m cl a b -> Time cl -> LastTime cl-initLastTime (Synchronous _)        initTime = LeafLastTime initTime-initLastTime (Sequential sn1 _ sn2) initTime =-  SequentialLastTime-    (initLastTime sn1 initTime)-    (initLastTime sn2 initTime)-initLastTime (Parallel sn1 sn2)     initTime =-  ParallelLastTime-    (initLastTime sn1 initTime)-    (initLastTime sn2 initTime)---- | Initialise a 'Tickable' from a signal network,---   two matching enclosing resampling buffers and an initial time.-createTickable-  :: ResamplingBuffer m cla (In cl)                 a b-  -> SN               m         cl                      b c-  -> ResamplingBuffer m                (Out cl) cld     c d-  -> Time cl-  -> Tickable         m cla (In cl) cl (Out cl) cld a b c d-createTickable buffer1 ticksn buffer2 initTime = Tickable-  { parClockIn  = ParClockRefl-  , parClockOut = ParClockRefl-  , lastTime    = initLastTime ticksn initTime-  , ..-  }--{- | In this function, one tick, or step of an asynchronous signal network happens.-The 'TimeInfo' holds the information which part of the signal tree will tick.-This information is encoded in the 'Tag' of the 'TimeInfo',-which is of type 'Either tag1 tag2' in case of a 'SequentialClock' or a 'ParallelClock',-encoding either a tick for the left clock or the right clock.--}-tick :: ( Monad m, Clock m cl-        , Time cla ~ Time cl-        , Time clb ~ Time cl-        , Time clc ~ Time cl-        , Time cld ~ Time cl-        , Time (In  cl) ~ Time cl-        , Time (Out cl) ~ Time cl-        )-     => Tickable    m cla clb cl clc cld a b c d-     -> Time cl -- ^ Timestamp of the present tick-     -> Tag cl -- ^ 'Tag' of the overall clock; contains the information which subsystem will become active-     -> m (Tickable m cla clb cl clc cld a b c d)--- Only if we have reached a leaf of the tree, data is actually processed.-tick Tickable-  { ticksn   = Synchronous clsf-  , lastTime = LeafLastTime lastTime-  , .. } now tag = do-    let-      ti = TimeInfo-        { sinceLast = diffTime now lastTime-        , sinceInit = diffTime now initTime-        , absolute  = now-        , tag       = tag-        }-    -- Get an input value from the left buffer-    (b, buffer1') <- get buffer1 $ retag (parClockTagInclusion parClockIn ) ti-    -- Run it through the signal function-    (c, clsf')  <- unMSF clsf b `runReaderT` ti-    -- Put the output into the right buffer-    buffer2'      <- put buffer2 (retag (parClockTagInclusion parClockOut) ti) c-    return Tickable-      { buffer1  = buffer1'-      , ticksn   = Synchronous clsf'-      , buffer2  = buffer2'-      , lastTime = LeafLastTime now-      , .. }--- The left part of a sequential composition is stepped.-tick tickable@Tickable-  { ticksn   = Sequential sn1 bufferMiddle sn2-  , lastTime = SequentialLastTime lastTimeL lastTimeR-  , initTime-  , parClockIn-  } now (Left tag) = do-    leftTickable <- tick Tickable-      { buffer1     = buffer1 tickable-      , ticksn      = sn1-      , buffer2     = bufferMiddle-      , parClockIn  = parClockIn-      , parClockOut = ParClockRefl-      , lastTime    = lastTimeL-      , initTime    = initTime-      } now tag-    return $ tickable-      { buffer1  = buffer1 leftTickable-      , ticksn   = Sequential (ticksn leftTickable) (buffer2 leftTickable) sn2-      , lastTime = SequentialLastTime (lastTime leftTickable) lastTimeR-      }--- The right part of a sequential composition is stepped.-tick tickable@Tickable-  { ticksn   = Sequential sn1 bufferMiddle sn2-  , lastTime = SequentialLastTime lastTimeL lastTimeR-  , initTime-  , parClockOut-  } now (Right tag) = do-    rightTickable <- tick Tickable-      { buffer1     = bufferMiddle-      , ticksn      = sn2-      , buffer2     = buffer2 tickable-      , parClockIn  = ParClockRefl-      , parClockOut = parClockOut-      , lastTime    = lastTimeR-      , initTime    = initTime-      } now tag-    return $ tickable-      { buffer2  = buffer2 rightTickable-      , ticksn   = Sequential sn1 (buffer1 rightTickable) (ticksn rightTickable)-      , lastTime = SequentialLastTime lastTimeL (lastTime rightTickable)-      }--- A parallel composition is stepped.-tick tickable@Tickable-  { ticksn   = Parallel snA snB-  , lastTime = ParallelLastTime lastTimeA lastTimeB-  , initTime-  , parClockIn-  , parClockOut-  } now tag = case tag of-    Left tagL -> do-      leftTickable <- tick Tickable-        { buffer1     = buffer1 tickable-        , ticksn      = snA-        , buffer2     = buffer2 tickable-        , parClockIn  = ParClockInL parClockIn-        , parClockOut = ParClockInL parClockOut-        , lastTime    = lastTimeA-        , initTime    = initTime-        } now tagL-      return $ tickable-        { buffer1  = buffer1 leftTickable-        , ticksn   = Parallel (ticksn leftTickable) snB-        , buffer2  = buffer2 leftTickable-        , lastTime = ParallelLastTime (lastTime leftTickable) lastTimeB-        }-    Right tagR -> do-      rightTickable <- tick Tickable-        { buffer1     = buffer1 tickable-        , ticksn      = snB-        , buffer2     = buffer2 tickable-        , parClockIn  = ParClockInR parClockIn-        , parClockOut = ParClockInR parClockOut-        , lastTime    = lastTimeB-        , initTime    = initTime-        } now tagR-      return $ tickable-        { buffer1  = buffer1 rightTickable-        , ticksn   = Parallel snA (ticksn rightTickable)-        , buffer2  = buffer2 rightTickable-        , lastTime = ParallelLastTime lastTimeA (lastTime rightTickable)-        }-tick Tickable {} _ _ = error "Impossible pattern in tick"---- TODO It seems wasteful to unwrap and rewrap log(N) Tickables--- (where N is the size of the clock tree) each tick,--- but I have no better idea.--{- | A 'ResamplingBuffer' producing only units.-(Slightly more efficient and direct implementation than the one in 'FRP.Rhine.Timeless'-that additionally unifies the clock types in a way needed for the tick implementation.)--}-trivialResamplingBuffer-  :: Monad m => cl-  -> ResamplingBuffer m (Out cl) (In cl) () ()-trivialResamplingBuffer _ = go-  where-    go  = ResamplingBuffer {..}-    put _ _ = return      go-    get _   = return ((), go)
src/FRP/Rhine/ResamplingBuffer.hs view
@@ -18,7 +18,6 @@ -- rhine import FRP.Rhine.Clock - -- base import Control.Arrow (second)
src/FRP/Rhine/SN.hs view
@@ -7,13 +7,16 @@ combinators are found in a submodule. -} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeFamilies #-} module FRP.Rhine.SN where   -- rhine import FRP.Rhine.Clock+import FRP.Rhine.Clock.Proxy import FRP.Rhine.ClSF.Core import FRP.Rhine.ResamplingBuffer import FRP.Rhine.Schedule@@ -41,6 +44,9 @@   -- | Two 'SN's may be sequentially composed if there is a matching 'ResamplingBuffer' between them.   Sequential     :: ( Clock m clab, Clock m clcd+       , Clock m (Out clab), Clock m (Out clcd)+       , Clock m (In  clab), Clock m (In  clcd)+       , GetClockProxy clab, GetClockProxy clcd        , Time clab ~ Time clcd        , Time clab ~ Time (Out clab)        , Time clcd ~ Time (In  clcd)@@ -52,6 +58,8 @@   -- | Two 'SN's with the same input and output data may be parallely composed.   Parallel     :: ( Clock m cl1, Clock m cl2+       , Clock m (Out cl1), Clock m (Out cl2)+       , GetClockProxy cl1, GetClockProxy cl2        , Time cl1 ~ Time (Out cl1)        , Time cl2 ~ Time (Out cl2)        , Time cl1 ~ Time cl2@@ -61,3 +69,6 @@     => SN m                  cl1      a b     -> SN m                      cl2  a b     -> SN m (ParallelClock m cl1 cl2) a b++instance GetClockProxy cl => ToClockProxy (SN m cl a b) where+  type Cl (SN m cl a b) = cl
src/FRP/Rhine/SN/Combinators.hs view
@@ -2,12 +2,14 @@ Combinators for composing signal networks sequentially and parallely. -} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} module FRP.Rhine.SN.Combinators where   -- rhine import FRP.Rhine.ClSF.Core+import FRP.Rhine.Clock.Proxy import FRP.Rhine.ResamplingBuffer.Util import FRP.Rhine.Schedule import FRP.Rhine.SN@@ -61,6 +63,8 @@ --   Note: This is essentially an infix synonym of 'Parallel' (||||)   :: ( Monad m, Clock m clL, Clock m clR+     , Clock m (Out clL), Clock m (Out clR)+     , GetClockProxy clL, GetClockProxy clR      , Time clL ~ Time clR      , Time clL ~ Time (Out clL), Time clL ~ Time (In clL)      , Time clR ~ Time (Out clR), Time clR ~ Time (In clR)@@ -75,6 +79,8 @@ --   dependent on which constituent clock has ticked. (++++)   :: ( Monad m, Clock m clL, Clock m clR+     , Clock m (Out clL), Clock m (Out clR)+     , GetClockProxy clL, GetClockProxy clR      , Time clL ~ Time clR      , Time clL ~ Time (Out clL), Time clL ~ Time (In clL)      , Time clR ~ Time (Out clR), Time clR ~ Time (In clR)
src/FRP/Rhine/Type.hs view
@@ -3,19 +3,52 @@ A signal network together with a matching clock value. -} +{-# LANGUAGE Arrows #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-} module FRP.Rhine.Type where +-- dunai+import Data.MonadicStreamFunction++-- rhine+import FRP.Rhine.Reactimation.ClockErasure+import FRP.Rhine.Clock+import FRP.Rhine.Clock.Proxy import FRP.Rhine.SN  {- | A 'Rhine' consists of a 'SN' together with a clock of matching type 'cl'.+ It is a reactive program, possibly with open inputs and outputs. If the input and output types 'a' and 'b' are both '()', that is, the 'Rhine' is "closed", then it is a standalone reactive program that can be run with the function 'flow'.++Otherwise, one can start the clock and the signal network jointly as a monadic stream function,+using 'eraseClock'. -} data Rhine m cl a b = Rhine   { sn    :: SN m cl a b   , clock :: cl   }++instance GetClockProxy cl => ToClockProxy (Rhine m cl a b) where+  type Cl (Rhine m cl a b) = cl+++{- |+Start the clock and the signal network,+effectively hiding the clock type from the outside.+-}+eraseClock+  :: (Monad m, Clock m cl, GetClockProxy cl)+  => Rhine  m cl a        b+  -> m (MSF m    a (Maybe b))+eraseClock Rhine {..} = do+  (runningClock, initTime) <- initClock clock+  -- Run the main loop+  return $ proc a -> do+    (time, tag) <- runningClock -< ()+    eraseClockSN initTime sn -< (time, tag, a <$ inTag (toClockProxy sn) tag)