bearriver 0.10.4.6 → 0.13.1

raw patch · 3 files changed

+424/−134 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• bearriver.cabal +1/−1
• src/FRP/BearRiver.hs +420/−131
• src/FRP/Yampa.hs +3/−2

@@ -1,5 +1,5 @@ name:                bearriver-version:             0.10.4.6+version:             0.13.1 synopsis:            A replacement of Yampa based on Monadic Stream Functions. description:         A Yampa replacement built using Dunai. homepage:            keera.co.uk

@@ -19,111 +19,183 @@ import           Control.Monad.Random import           Control.Monad.Trans.Maybe import           Control.Monad.Trans.MSF                        hiding (switch)-import           Control.Monad.Trans.MSF.Except                 as MSF hiding (switch)-import           Control.Monad.Trans.MSF.List                   (widthFirst, sequenceS)+import qualified Control.Monad.Trans.MSF                        as MSF+import           Control.Monad.Trans.MSF.Except                 as MSF hiding+                                                                        (switch)+import           Control.Monad.Trans.MSF.List                   (sequenceS,+                                                                 widthFirst) import           Control.Monad.Trans.MSF.Random import           Data.Functor.Identity import           Data.Maybe-import           Data.MonadicStreamFunction.InternalCore import           Data.MonadicStreamFunction                     as X hiding (reactimate,+                                                                      repeatedly,                                                                       sum,                                                                       switch,                                                                       trace) import qualified Data.MonadicStreamFunction                     as MSF-import qualified Control.Monad.Trans.MSF                        as MSF import           Data.MonadicStreamFunction.Instances.ArrowLoop+import           Data.MonadicStreamFunction.InternalCore import           Data.Traversable                               as T import           FRP.Yampa.VectorSpace                          as X +infixr 0 -->, -:>, >--, >=-++-- * Basic definitions+ type Time  = Double+ type DTime = Double  type SF m        = MSF (ClockInfo m)+ type ClockInfo m = ReaderT DTime m +data Event a = Event a | NoEvent+ deriving (Eq, Show)++-- ** Lifting+arrPrim :: Monad m => (a -> b) -> SF m a b+arrPrim = arr++arrEPrim :: Monad m => (Event a -> b) -> SF m (Event a) b+arrEPrim = arr++-- * Signal functions++-- ** Basic signal functions+ identity :: Monad m => SF m a a identity = Category.id  constant :: Monad m => b -> SF m a b constant = arr . const ---- * Continuous time+localTime :: Monad m => SF m a Time+localTime = constant 1.0 >>> integral -time :: Monad m => SF m () Time+time :: Monad m => SF m a Time time = localTime -localTime :: Monad m => SF m () Time-localTime = constant 1.0 >>> integral+-- ** Initialization -integral :: (Monad m, VectorSpace a s) => SF m a a-integral = integralFrom zeroVector+-- | Initialization operator (cf. Lustre/Lucid Synchrone).+--+-- The output at time zero is the first argument, and from+-- that point on it behaves like the signal function passed as+-- second argument.+(-->) :: Monad m => b -> SF m a b -> SF m a b+b0 --> sf = sf >>> replaceOnce b0 -integralFrom :: (Monad m, VectorSpace a s) => a -> SF m a a-integralFrom a0 = proc a -> do-  dt <- constM ask         -< ()-  accumulateWith (^+^) a0 -< realToFrac dt *^ a+-- | Output pre-insert operator.+--+-- Insert a sample in the output, and from that point on, behave+-- like the given sf.+(-:>) :: Monad m => b -> SF m a b -> SF m a b+b -:> sf = iPost b sf -derivative :: (Monad m, VectorSpace a s) => SF m a a-derivative = derivativeFrom zeroVector+-- | Input initialization operator.+--+-- The input at time zero is the first argument, and from+-- that point on it behaves like the signal function passed as+-- second argument.+(>--) :: Monad m => a -> SF m a b -> SF m a b+a0 >-- sf = replaceOnce a0 >>> sf -derivativeFrom :: (Monad m, VectorSpace a s) => a -> SF m a a-derivativeFrom a0 = proc a -> do-  dt   <- constM ask   -< ()-  aOld <- MSF.iPre a0 -< a-  returnA             -< (a ^-^ aOld) ^/ realToFrac dt+(>=-) :: Monad m => (a -> a) -> SF m a b -> SF m a b+f >=- sf = MSF $ \a -> do+  (b, sf') <- unMSF sf (f a)+  return (b, sf') --- * Events+initially :: Monad m => a -> SF m a a+initially = (--> identity) -data Event a = Event a | NoEvent- deriving (Eq, Show)+-- * Simple, stateful signal processing+sscan :: Monad m => (b -> a -> b) -> b -> SF m a b+sscan f b_init = feedback b_init u+  where u = undefined -- (arr f >>^ dup) -instance Functor Event where-  fmap f NoEvent   = NoEvent-  fmap f (Event c) = Event (f c)+sscanPrim :: Monad m => (c -> a -> Maybe (c, b)) -> c -> b -> SF m a b+sscanPrim f c_init b_init = MSF $ \a -> do+  let o = f c_init a+  case o of+    Nothing       -> return (b_init, sscanPrim f c_init b_init)+    Just (c', b') -> return (b',     sscanPrim f c' b') -instance Applicative Event where-  pure = Event -  Event f <*> Event x = Event (f x)-  _       <*> _       = NoEvent+-- | Event source that never occurs.+never :: Monad m => SF m a (Event b)+never = constant NoEvent -noEvent :: Event a-noEvent = NoEvent+-- | Event source with a single occurrence at time 0. The value of the event+-- is given by the function argument.+now :: Monad m => b -> SF m a (Event b)+now b0 = Event b0 --> never -event :: a -> (b -> a) -> Event b -> a-event _ f (Event x) = f x-event x _ NoEvent   = x+after :: Monad m+      => Time -- ^ The time /q/ after which the event should be produced+      -> b    -- ^ Value to produce at that time+      -> SF m a (Event b)+after q x = feedback q go+ where go = MSF $ \(_, t) -> do+              dt <- ask+              let t' = t - dt+                  e  = if t > 0 && t' < 0 then Event x else NoEvent+                  ct = if t' < 0 then constant (NoEvent, t') else go+              return ((e, t'), ct) -fromEvent (Event x) = x-fromEvent _         = error "fromEvent NoEvent"+repeatedly :: Monad m => Time -> b -> SF m a (Event b)+repeatedly q x+    | q > 0     = afterEach qxs+    | otherwise = error "bearriver: repeatedly: Non-positive period."+  where+    qxs = (q,x):qxs -isEvent (Event _) = True-isEvent _         = False+-- | Event source with consecutive occurrences at the given intervals.+-- Should more than one event be scheduled to occur in any sampling interval,+-- only the first will in fact occur to avoid an event backlog. -tag :: Event a -> b -> Event b-tag NoEvent   _ = NoEvent-tag (Event _) b = Event b+-- After all, after, repeatedly etc. are defined in terms of afterEach.+afterEach :: Monad m => [(Time,b)] -> SF m a (Event b)+afterEach qxs = afterEachCat qxs >>> arr (fmap head) -mergeBy :: (a -> a -> a) -> Event a -> Event a -> Event a-mergeBy _       NoEvent      NoEvent      = NoEvent-mergeBy _       le@(Event _) NoEvent      = le-mergeBy _       NoEvent      re@(Event _) = re-mergeBy resolve (Event l)    (Event r)    = Event (resolve l r)+-- | Event source with consecutive occurrences at the given intervals.+-- Should more than one event be scheduled to occur in any sampling interval,+-- the output list will contain all events produced during that interval.+afterEachCat :: Monad m => [(Time,b)] -> SF m a (Event [b])+afterEachCat = afterEachCat' 0+  where+    afterEachCat' :: Monad m => Time -> [(Time,b)] -> SF m a (Event [b])+    afterEachCat' _ []  = never+    afterEachCat' t qxs = MSF $ \_ -> do+      dt <- ask+      let t' = t + dt+          (qxsNow, qxsLater) = span (\p -> fst p <= t') qxs+          ev = if null qxsNow then NoEvent else Event (map snd qxsNow)+      return (ev, afterEachCat' t' qxsLater) --- | Left-biased event merge (always prefer left event, if present).-lMerge :: Event a -> Event a -> Event a-lMerge = mergeBy (\e1 _ -> e1) --- | Right-biased event merge (always prefer right event, if present).-rMerge :: Event a -> Event a -> Event a-rMerge = flip lMerge+-- * Events +instance Functor Event where+  fmap f NoEvent   = NoEvent+  fmap f (Event c) = Event (f c) +instance Applicative Event where+  pure = Event++  Event f <*> Event x = Event (f x)+  _       <*> _       = NoEvent++-- | Apply an 'MSF' to every input. Freezes temporarily if the input is+-- 'NoEvent', and continues as soon as an 'Event' is received.+mapEventS :: Monad m => MSF m a b -> MSF m (Event a) (Event b)+mapEventS msf = proc eventA -> case eventA of+  Event a -> arr Event <<< msf -< a+  NoEvent -> returnA           -< NoEvent+ -- ** Relation to other types  eventToMaybe = event Nothing Just-maybeToEvent = maybe NoEvent Event  boolToEvent :: Bool -> Event () boolToEvent True  = Event ()@@ -134,10 +206,38 @@ edge :: Monad m => SF m Bool (Event ()) edge = edgeFrom True +iEdge :: Monad m => Bool -> SF m Bool (Event ())+iEdge = edgeFrom++-- | Like 'edge', but parameterized on the tag value.+--+-- From Yampa+edgeTag :: Monad m => a -> SF m Bool (Event a)+edgeTag a = edge >>> arr (`tag` a)++-- | Edge detector particularized for detecting transtitions+--   on a 'Maybe' signal from 'Nothing' to 'Just'.+--+-- From Yampa++-- !!! 2005-07-09: To be done or eliminated+-- !!! Maybe could be kept as is, but could be easy to implement directly+-- !!! in terms of sscan?+edgeJust :: Monad m => SF m (Maybe a) (Event a)+edgeJust = edgeBy isJustEdge (Just undefined)+    where+        isJustEdge Nothing  Nothing     = Nothing+        isJustEdge Nothing  ma@(Just _) = ma+        isJustEdge (Just _) (Just _)    = Nothing+        isJustEdge (Just _) Nothing     = Nothing+ edgeBy :: Monad m => (a -> a -> Maybe b) -> a -> SF m a (Event b) edgeBy isEdge a_prev = MSF $ \a ->   return (maybeToEvent (isEdge a_prev a), edgeBy isEdge a) +maybeToEvent :: Maybe a -> Event a+maybeToEvent = maybe NoEvent Event+ edgeFrom :: Monad m => Bool -> SF m Bool (Event()) edgeFrom prev = MSF $ \a -> do   let res | prev      = NoEvent@@ -146,28 +246,13 @@       ct  = edgeFrom a   return (res, ct) +-- * Stateful event suppression+ -- | Suppression of initial (at local time 0) event. notYet :: Monad m => SF m (Event a) (Event a) notYet = feedback False $ arr (\(e,c) ->   if c then (e, True) else (NoEvent, True)) -hold :: Monad m => a -> SF m (Event a) a-hold a = feedback a $ arr $ \(e,a') ->-  dup (event a' id e)- where dup x = (x,x)--loopPre :: Monad m => c -> SF m (a, c) (b, c) -> SF m a b-loopPre = feedback---- | Event source that never occurs.-never :: Monad m => SF m a (Event b)-never = constant NoEvent---- | Event source with a single occurrence at time 0. The value of the event--- is given by the function argument.-now :: Monad m => b -> SF m a (Event b)-now b0 = Event b0 --> never- -- | Suppress all but the first event. once :: Monad m => SF m (Event a) (Event a) once = takeEvents 1@@ -177,57 +262,169 @@ takeEvents n | n <= 0 = never takeEvents n = dSwitch (arr dup) (const (NoEvent >-- takeEvents (n - 1))) -after :: Monad m-      => Time -- ^ The time /q/ after which the event should be produced-      -> b    -- ^ Value to produce at that time-      -> SF m a (Event b)-after q x = feedback q go- where go = MSF $ \(_, t) -> do-              dt <- ask-              let t' = t - dt-                  e  = if t > 0 && t' < 0 then Event x else NoEvent-                  ct = if t' < 0 then constant (NoEvent, t') else go-              return ((e, t'), ct)+-- | Suppress first n events. -occasionally :: MonadRandom m-             => Time -- ^ The time /q/ after which the event should be produced on average-             -> b    -- ^ Value to produce at time of event-             -> SF m a (Event b)-occasionally tAvg b-  | tAvg <= 0 = error "dunai: Non-positive average interval in occasionally."-  | otherwise = proc _ -> do-      r   <- getRandomRS (0, 1) -< ()-      dt  <- timeDelta          -< ()-      let p = 1 - exp (-(dt / tAvg))-      returnA -< if r < p then Event b else NoEvent- where-  timeDelta :: Monad m => SF m a DTime-  timeDelta = constM ask+-- Here dSwitch or switch does not really matter.+dropEvents :: Monad m => Int -> SF m (Event a) (Event a)+dropEvents n | n <= 0  = identity+dropEvents n = dSwitch (never &&& identity)+                             (const (NoEvent >-- dropEvents (n - 1))) --- | Initialization operator (cf. Lustre/Lucid Synchrone).+-- * Pointwise functions on events++noEvent :: Event a+noEvent = NoEvent++-- | Suppress any event in the first component of a pair.+noEventFst :: (Event a, b) -> (Event c, b)+noEventFst (_, b) = (NoEvent, b)+++-- | Suppress any event in the second component of a pair.+noEventSnd :: (a, Event b) -> (a, Event c)+noEventSnd (a, _) = (a, NoEvent)++event :: a -> (b -> a) -> Event b -> a+event _ f (Event x) = f x+event x _ NoEvent   = x++fromEvent (Event x) = x+fromEvent _         = error "fromEvent NoEvent"++isEvent (Event _) = True+isEvent _         = False++isNoEvent (Event _) = False+isNoEvent _         = True++tag :: Event a -> b -> Event b+tag NoEvent   _ = NoEvent+tag (Event _) b = Event b++-- | Tags an (occurring) event with a value ("replacing" the old value). Same+-- as 'tag' with the arguments swapped. ----- The output at time zero is the first argument, and from--- that point on it behaves like the signal function passed as--- second argument.-(-->) :: Monad m => b -> SF m a b -> SF m a b-b0 --> sf = sf >>> replaceOnce b0+-- Applicative-based definition:+-- tagWith = (<$)+tagWith :: b -> Event a -> Event b+tagWith = flip tag --- | Input initialization operator.+-- | Attaches an extra value to the value of an occurring event.+attach :: Event a -> b -> Event (a, b)+e `attach` b = fmap (\a -> (a, b)) e++-- | Left-biased event merge (always prefer left event, if present).+lMerge :: Event a -> Event a -> Event a+lMerge = mergeBy (\e1 _ -> e1)++-- | Right-biased event merge (always prefer right event, if present).+rMerge :: Event a -> Event a -> Event a+rMerge = flip lMerge++merge :: Event a -> Event a -> Event a+merge = mergeBy $ error "Bearriver: merge: Simultaneous event occurrence."++mergeBy :: (a -> a -> a) -> Event a -> Event a -> Event a+mergeBy _       NoEvent      NoEvent      = NoEvent+mergeBy _       le@(Event _) NoEvent      = le+mergeBy _       NoEvent      re@(Event _) = re+mergeBy resolve (Event l)    (Event r)    = Event (resolve l r)++-- | A generic event merge-map utility that maps event occurrences,+-- merging the results. The first three arguments are mapping functions,+-- the third of which will only be used when both events are present.+-- Therefore, 'mergeBy' = 'mapMerge' 'id' 'id' ----- The input at time zero is the first argument, and from--- that point on it behaves like the signal function passed as--- second argument.-(>--) :: Monad m => a -> SF m a b -> SF m a b-a0 >-- sf = replaceOnce a0 >>> sf+-- Applicative-based definition:+-- mapMerge lf rf lrf le re = (f <$> le <*> re) <|> (lf <$> le) <|> (rf <$> re)+mapMerge :: (a -> c) -> (b -> c) -> (a -> b -> c)+            -> Event a -> Event b -> Event c+mapMerge _  _  _   NoEvent   NoEvent   = NoEvent+mapMerge lf _  _   (Event l) NoEvent   = Event (lf l)+mapMerge _  rf _   NoEvent   (Event r) = Event (rf r)+mapMerge _  _  lrf (Event l) (Event r) = Event (lrf l r) -replaceOnce :: Monad m => a -> SF m a a-replaceOnce a = dSwitch (arr $ const (a, Event ())) (const $ arr id)+-- | Merge a list of events; foremost event has priority.+--+-- Foldable-based definition:+-- mergeEvents :: Foldable t => t (Event a) -> Event a+-- mergeEvents =  asum+mergeEvents :: [Event a] -> Event a+mergeEvents = foldr lMerge NoEvent -accumHoldBy :: Monad m => (b -> a -> b) -> b -> SF m (Event a) b-accumHoldBy f b = feedback b $ arr $ \(a, b') ->-  let b'' = event b' (f b') a-  in (b'', b'')+-- | Collect simultaneous event occurrences; no event if none.+--+-- Traverable-based definition:+-- catEvents :: Foldable t => t (Event a) -> Event (t a)+-- carEvents e  = if (null e) then NoEvent else (sequenceA e)+catEvents :: [Event a] -> Event [a]+catEvents eas = case [ a | Event a <- eas ] of+                    [] -> NoEvent+                    as -> Event as +-- | Join (conjunction) of two events. Only produces an event+-- if both events exist.+--+-- Applicative-based definition:+-- joinE = liftA2 (,)+joinE :: Event a -> Event b -> Event (a,b)+joinE NoEvent   _         = NoEvent+joinE _         NoEvent   = NoEvent+joinE (Event l) (Event r) = Event (l,r)++-- | Split event carrying pairs into two events.+splitE :: Event (a,b) -> (Event a, Event b)+splitE NoEvent       = (NoEvent, NoEvent)+splitE (Event (a,b)) = (Event a, Event b)++------------------------------------------------------------------------------+-- Event filtering+------------------------------------------------------------------------------++-- | Filter out events that don't satisfy some predicate.+filterE :: (a -> Bool) -> Event a -> Event a+filterE p e@(Event a) = if p a then e else NoEvent+filterE _ NoEvent     = NoEvent+++-- | Combined event mapping and filtering. Note: since 'Event' is a 'Functor',+-- see 'fmap' for a simpler version of this function with no filtering.+mapFilterE :: (a -> Maybe b) -> Event a -> Event b+mapFilterE _ NoEvent   = NoEvent+mapFilterE f (Event a) = case f a of+                            Nothing -> NoEvent+                            Just b  -> Event b+++-- | Enable/disable event occurences based on an external condition.+gate :: Event a -> Bool -> Event a+_ `gate` False = NoEvent+e `gate` True  = e++-- * Switching++-- ** Basic switchers++switch :: Monad m => SF m a (b, Event c) -> (c -> SF m a b) -> SF m a b+switch sf sfC = MSF $ \a -> do+  (o, ct) <- unMSF sf a+  case o of+    (_, Event c) -> unMSF (sfC c) a+    (b, NoEvent) -> return (b, switch ct sfC)++dSwitch ::  Monad m => SF m a (b, Event c) -> (c -> SF m a b) -> SF m a b+dSwitch sf sfC = MSF $ \a -> do+  (o, ct) <- unMSF sf a+  case o of+    (b, Event c) -> do (_,ct') <- unMSF (sfC c) a+                       return (b, ct')+    (b, NoEvent) -> return (b, dSwitch ct sfC)+++-- * Parallel composition and switching++-- ** Parallel composition and switching over collections with broadcasting+ #if MIN_VERSION_base(4,8,0) parB :: (Monad m) => [SF m a b] -> SF m a [b] #else@@ -248,20 +445,7 @@              NoEvent -> dpSwitchB sfs' sfF' sfCs   return (bs, ct) -dSwitch ::  Monad m => SF m a (b, Event c) -> (c -> SF m a b) -> SF m a b-dSwitch sf sfC = MSF $ \a -> do-  (o, ct) <- unMSF sf a-  case o of-    (b, Event c) -> do (_,ct') <- unMSF (sfC c) a-                       return (b, ct')-    (b, NoEvent) -> return (b, dSwitch ct sfC)--switch :: Monad m => SF m a (b, Event c) -> (c -> SF m a b) -> SF m a b-switch sf sfC = MSF $ \a -> do-  (o, ct) <- unMSF sf a-  case o of-    (_, Event c) -> unMSF (sfC c) a-    (b, NoEvent) -> return (b, switch ct sfC)+-- ** Parallel composition over collections  parC :: Monad m => SF m a b -> SF m [a] [b] parC sf = parC' [sf]@@ -273,6 +457,52 @@       cts = fmap snd os   return (bs, parC' cts) +-- * Discrete to continuous-time signal functions++-- ** Wave-form generation++hold :: Monad m => a -> SF m (Event a) a+hold a = feedback a $ arr $ \(e,a') ->+    dup (event a' id e)+  where+    dup x = (x,x)++-- ** Accumulators++-- | Accumulator parameterized by the accumulation function.+accumBy :: Monad m => (b -> a -> b) -> b -> SF m (Event a) (Event b)+accumBy f b = mapEventS $ accumulateWith (flip f) b++accumHoldBy :: Monad m => (b -> a -> b) -> b -> SF m (Event a) b+accumHoldBy f b = feedback b $ arr $ \(a, b') ->+  let b'' = event b' (f b') a+  in (b'', b'')++-- * State keeping combinators++-- ** Loops with guaranteed well-defined feedback+loopPre :: Monad m => c -> SF m (a, c) (b, c) -> SF m a b+loopPre = feedback++-- * Integration and differentiation++integral :: (Monad m, VectorSpace a s) => SF m a a+integral = integralFrom zeroVector++integralFrom :: (Monad m, VectorSpace a s) => a -> SF m a a+integralFrom a0 = proc a -> do+  dt <- constM ask         -< ()+  accumulateWith (^+^) a0 -< realToFrac dt *^ a++derivative :: (Monad m, VectorSpace a s) => SF m a a+derivative = derivativeFrom zeroVector++derivativeFrom :: (Monad m, VectorSpace a s) => a -> SF m a a+derivativeFrom a0 = proc a -> do+  dt   <- constM ask   -< ()+  aOld <- MSF.iPre a0 -< a+  returnA             -< (a ^-^ aOld) ^/ realToFrac dt+ -- NOTE: BUG in this function, it needs two a's but we -- can only provide one iterFrom :: Monad m => (a -> a -> DTime -> b -> b) -> b -> SF m a b@@ -281,6 +511,27 @@   let b' = f a a dt b   return (b, iterFrom f b') +-- * Noise (random signal) sources and stochastic event sources++occasionally :: MonadRandom m+             => Time -- ^ The time /q/ after which the event should be produced on average+             -> b    -- ^ Value to produce at time of event+             -> SF m a (Event b)+occasionally tAvg b+  | tAvg <= 0 = error "bearriver: Non-positive average interval in occasionally."+  | otherwise = proc _ -> do+      r   <- getRandomRS (0, 1) -< ()+      dt  <- timeDelta          -< ()+      let p = 1 - exp (-(dt / tAvg))+      returnA -< if r < p then Event b else NoEvent+ where+  timeDelta :: Monad m => SF m a DTime+  timeDelta = constM ask++-- * Execution/simulation++-- ** Reactimation+ reactimate :: Monad m => m a -> (Bool -> m (DTime, Maybe a)) -> (Bool -> b -> m Bool) -> SF Identity a b -> m () reactimate senseI sense actuate sf = do   -- runMaybeT $ MSF.reactimate $ liftMSFTrans (senseSF >>> sfIO) >>> actuateSF@@ -303,7 +554,45 @@         switch sf sfC = MSF.switch (sf >>> second (arr eventToMaybe)) sfC --- * Auxiliary+-- * Debugging / Step by step simulation++-- | Evaluate an SF, and return an output and an initialized SF.+--+--   /WARN/: Do not use this function for standard simulation. This function is+--   intended only for debugging/testing. Apart from being potentially slower+--   and consuming more memory, it also breaks the FRP abstraction by making+--   samples discrete and step based.+evalAtZero :: SF Identity a b -> a -> (b, SF Identity a b)+evalAtZero sf a = runIdentity $ runReaderT (unMSF sf a) 0++-- | Evaluate an initialized SF, and return an output and a continuation.+--+--   /WARN/: Do not use this function for standard simulation. This function is+--   intended only for debugging/testing. Apart from being potentially slower+--   and consuming more memory, it also breaks the FRP abstraction by making+--   samples discrete and step based.+evalAt :: SF Identity a b -> DTime -> a -> (b, SF Identity a b)+evalAt sf dt a = runIdentity $ runReaderT (unMSF sf a) dt++-- | Given a signal function and time delta, it moves the signal function into+--   the future, returning a new uninitialized SF and the initial output.+--+--   While the input sample refers to the present, the time delta refers to the+--   future (or to the time between the current sample and the next sample).+--+--   /WARN/: Do not use this function for standard simulation. This function is+--   intended only for debugging/testing. Apart from being potentially slower+--   and consuming more memory, it also breaks the FRP abstraction by making+--   samples discrete and step based.+--+evalFuture :: SF Identity a b -> a -> DTime -> (b, SF Identity a b)+evalFuture sf = flip (evalAt sf)++-- * Auxiliary functions++-- ** Event handling+replaceOnce :: Monad m => a -> SF m a a+replaceOnce a = dSwitch (arr $ const (a, Event ())) (const $ arr id)  -- ** Tuples dup  x     = (x,x)

@@ -1,4 +1,4 @@-module FRP.Yampa (module X, SF) where+module FRP.Yampa (module X, SF, FutureSF) where  import           FRP.BearRiver         as X hiding (andThen, SF) import           FRP.Yampa.AffineSpace as X@@ -11,4 +11,5 @@ import           Data.Functor.Identity import qualified FRP.BearRiver         as BR -type SF = BR.SF Identity+type SF       = BR.SF Identity+type FutureSF = BR.SF Identity