{-# LANGUAGE CPP           #-}
{-# LANGUAGE GADTs         #-}
{-# LANGUAGE MultiWayIf    #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE Rank2Types    #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  FRP.Yampa.Simulation
-- Copyright   :  (c) Antony Courtney and Henrik Nilsson, Yale University, 2003
-- License     :  BSD-style (see the LICENSE file in the distribution)
--
-- Maintainer  :  ivan.perez@keera.co.uk
-- Stability   :  provisional
-- Portability :  non-portable (GHC extensions)
--
-- Execution/simulation of signal functions.
--
-- SFs can be executed in two ways: by running them, feeding input samples one
-- by one, obtained from a monadic environment (presumably, @IO@), or by
-- passing an input stream and calculating an output stream. The former is
-- called /reactimation/, and the latter is called /embedding/.
--
-- * Running:
-- Normally, to run an SF, you would use 'reactimate', providing input samples,
-- and consuming the output samples in the 'IO' monad. This function takes over
-- the program, implementing a "main loop". If you want more control over the
-- evaluation loop (for instance, if you are using Yampa in combination with a
-- backend that also implements some main loop), you may want to use the
-- lower-level API for reactimation ('ReactHandle', 'reactInit', 'react').
--
-- * Embedding:
-- You can use 'embed' for testing, to evaluate SFs in a terminal, and to embed
-- an SF inside a larger system. The helper functions 'deltaEncode' and
-- 'deltaEncodeBy' facilitate producing input /signals/ from plain lists of
-- input samples.
--
-- This module also includes debugging aids needed to execute signal functions
-- step by step, which are used by Yampa's testing facilities.
--------------------------------------------------------------------------------

module FRP.Yampa.Simulation (
   -- * Reactimation
    reactimate,         -- :: IO a
                        --    -> (Bool -> IO (DTime, Maybe a))
                        --    -> (Bool -> b -> IO Bool)
                        --    -> SF a b
                        --    -> IO ()

    -- ** Low-level reactimation interface
    ReactHandle,
    reactInit,          -- :: IO a -- init
                        -- -> (ReactHandle a b -> Bool -> b -> IO Bool)
                        --     -- actuate
                        -- -> SF a b
                        -- -> IO (ReactHandle a b)

                        -- process a single input sample:
    react,              --    ReactHandle a b
                        --    -> (DTime,Maybe a)
                        --    -> IO Bool

    -- * Embedding
    embed,              -- :: SF a b -> (a, [(DTime, Maybe a)]) -> [b]
    embedSynch,         -- :: SF a b -> (a, [(DTime, Maybe a)]) -> SF Double b
    deltaEncode,        -- :: Eq a => DTime -> [a] -> (a, [(DTime, Maybe a)])
    deltaEncodeBy,      -- :: (a -> a -> Bool) -> DTime -> [a]
                        --    -> (a, [(DTime, Maybe a)])

    -- * Debugging / Step by step simulation

    FutureSF,
    evalAtZero,
    evalAt,
    evalFuture,


) where

import Control.Monad (unless)
import Data.IORef
import Data.Maybe (fromMaybe)

import FRP.Yampa.InternalCore (SF(..), SF'(..), sfTF', DTime)

import FRP.Yampa.Diagnostics

------------------------------------------------------------------------------
-- Reactimation
------------------------------------------------------------------------------

-- Reactimation of a signal function.
-- init ....... IO action for initialization. Will only be invoked once,
--              at (logical) time 0, before first call to "sense".
--              Expected to return the value of input at time 0.
-- sense ...... IO action for sensing of system input.
--      arg. #1 ....... True: action may block, waiting for an OS event.
--                      False: action must not block.
--      res. #1 ....... Time interval since previous invocation of the sensing
--                      action (or, the first time round, the init action),
--                      returned. The interval must be _strictly_ greater
--                      than 0. Thus even a non-blocking invocation must
--                      ensure that time progresses.
--      res. #2 ....... Nothing: input is unchanged w.r.t. the previously
--                      returned input sample.
--                      Just i: the input is currently i.
--                      It is OK to always return "Just", even if input is
--                      unchanged.
-- actuate .... IO action for outputting the system output.
--      arg. #1 ....... True: output may have changed from previous output
--                      sample.
--                      False: output is definitely unchanged from previous
--                      output sample.
--                      It is OK to ignore argument #1 and assume that the
--                      the output has always changed.
--      arg. #2 ....... Current output sample.
--      result .......  Termination flag. Once True, reactimate will exit
--                      the reactimation loop and return to its caller.
-- sf ......... Signal function to reactimate.

-- | Convenience function to run a signal function indefinitely, using a IO
-- actions to obtain new input and process the output.
--
-- This function first runs the initialization action, which provides the
-- initial input for the signal transformer at time 0.
--
-- Afterwards, an input sensing action is used to obtain new input (if any) and
-- the time since the last iteration. The argument to the input sensing
-- function indicates if it can block. If no new input is received, it is
-- assumed to be the same as in the last iteration.
--
-- After applying the signal function to the input, the actuation IO action is
-- executed. The first argument indicates if the output has changed, the second
-- gives the actual output). Actuation functions may choose to ignore the first
-- argument altogether. This action should return True if the reactimation must
-- stop, and False if it should continue.
--
-- Note that this becomes the program's /main loop/, which makes using this
-- function incompatible with GLUT, Gtk and other graphics libraries. It may
-- also impose a sizeable constraint in larger projects in which different
-- subparts run at different time steps. If you need to control the main loop
-- yourself for these or other reasons, use 'reactInit' and 'react'.

reactimate :: Monad m
           => m a                          -- ^ Initialization action
           -> (Bool -> m (DTime, Maybe a)) -- ^ Input sensing action
           -> (Bool -> b -> m Bool)        -- ^ Actuation (output processing)
                                           --   action
           -> SF a b                       -- ^ Signal function
           -> m ()
reactimate :: m a
-> (Bool -> m (DTime, Maybe a))
-> (Bool -> b -> m Bool)
-> SF a b
-> m ()
reactimate m a
init Bool -> m (DTime, Maybe a)
sense Bool -> b -> m Bool
actuate (SF {sfTF :: forall a b. SF a b -> a -> Transition a b
sfTF = a -> Transition a b
tf0}) =
    do
        a
a0 <- m a
init
        let (SF' a b
sf, b
b0) = a -> Transition a b
tf0 a
a0
        SF' a b -> a -> b -> m ()
loop SF' a b
sf a
a0 b
b0
    where
        loop :: SF' a b -> a -> b -> m ()
loop SF' a b
sf a
a b
b = do
            Bool
done <- Bool -> b -> m Bool
actuate Bool
True b
b
            Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (a
a a -> Bool -> Bool
`seq` b
b b -> Bool -> Bool
`seq` Bool
done) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
                (DTime
dt, Maybe a
ma') <- Bool -> m (DTime, Maybe a)
sense Bool
False
                let a' :: a
a' = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
a Maybe a
ma'
                    (SF' a b
sf', b
b') = (SF' a b -> DTime -> a -> Transition a b
forall a b. SF' a b -> DTime -> a -> Transition a b
sfTF' SF' a b
sf) DTime
dt a
a'
                SF' a b -> a -> b -> m ()
loop SF' a b
sf' a
a' b
b'


-- An API for animating a signal function when some other library
-- needs to own the top-level control flow:

-- reactimate's state, maintained across samples:
data ReactState a b = ReactState {
    ReactState a b -> ReactHandle a b -> Bool -> b -> IO Bool
rsActuate :: ReactHandle a b -> Bool -> b -> IO Bool,
    ReactState a b -> SF' a b
rsSF :: SF' a b,
    ReactState a b -> a
rsA :: a,
    ReactState a b -> b
rsB :: b
  }

-- | A reference to reactimate's state, maintained across samples.
newtype ReactHandle a b = ReactHandle
  { ReactHandle a b -> IORef (ReactState a b)
reactHandle :: IORef (ReactState a b) }

-- | Initialize a top-level reaction handle.
reactInit :: IO a -- init
             -> (ReactHandle a b -> Bool -> b -> IO Bool) -- actuate
             -> SF a b
             -> IO (ReactHandle a b)
reactInit :: IO a
-> (ReactHandle a b -> Bool -> b -> IO Bool)
-> SF a b
-> IO (ReactHandle a b)
reactInit IO a
init ReactHandle a b -> Bool -> b -> IO Bool
actuate (SF {sfTF :: forall a b. SF a b -> a -> Transition a b
sfTF = a -> Transition a b
tf0}) =
  do a
a0 <- IO a
init
     let (SF' a b
sf,b
b0) = a -> Transition a b
tf0 a
a0
     -- TODO: really need to fix this interface, since right now we
     -- just ignore termination at time 0:
     IORef (ReactState a b)
r' <- ReactState a b -> IO (IORef (ReactState a b))
forall a. a -> IO (IORef a)
newIORef (ReactState :: forall a b.
(ReactHandle a b -> Bool -> b -> IO Bool)
-> SF' a b -> a -> b -> ReactState a b
ReactState { rsActuate :: ReactHandle a b -> Bool -> b -> IO Bool
rsActuate = ReactHandle a b -> Bool -> b -> IO Bool
actuate, rsSF :: SF' a b
rsSF = SF' a b
sf
                                , rsA :: a
rsA = a
a0, rsB :: b
rsB = b
b0
                                }
                    )
     let r :: ReactHandle a b
r = IORef (ReactState a b) -> ReactHandle a b
forall a b. IORef (ReactState a b) -> ReactHandle a b
ReactHandle IORef (ReactState a b)
r'
     Bool
_ <- ReactHandle a b -> Bool -> b -> IO Bool
actuate ReactHandle a b
r Bool
True b
b0
     ReactHandle a b -> IO (ReactHandle a b)
forall (m :: * -> *) a. Monad m => a -> m a
return ReactHandle a b
r

-- | Process a single input sample.
react :: ReactHandle a b
      -> (DTime,Maybe a)
      -> IO Bool
react :: ReactHandle a b -> (DTime, Maybe a) -> IO Bool
react ReactHandle a b
rh (DTime
dt,Maybe a
ma') =
  do ReactState a b
rs <- IORef (ReactState a b) -> IO (ReactState a b)
forall a. IORef a -> IO a
readIORef (ReactHandle a b -> IORef (ReactState a b)
forall a b. ReactHandle a b -> IORef (ReactState a b)
reactHandle ReactHandle a b
rh)
     let ReactState {rsActuate :: forall a b.
ReactState a b -> ReactHandle a b -> Bool -> b -> IO Bool
rsActuate = ReactHandle a b -> Bool -> b -> IO Bool
actuate, rsSF :: forall a b. ReactState a b -> SF' a b
rsSF = SF' a b
sf, rsA :: forall a b. ReactState a b -> a
rsA = a
a, rsB :: forall a b. ReactState a b -> b
rsB = b
_b } = ReactState a b
rs

     let a' :: a
a' = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
a Maybe a
ma'
         (SF' a b
sf',b
b') = (SF' a b -> DTime -> a -> (SF' a b, b)
forall a b. SF' a b -> DTime -> a -> Transition a b
sfTF' SF' a b
sf) DTime
dt a
a'
     IORef (ReactState a b) -> ReactState a b -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (ReactHandle a b -> IORef (ReactState a b)
forall a b. ReactHandle a b -> IORef (ReactState a b)
reactHandle ReactHandle a b
rh) (ReactState a b
rs {rsSF :: SF' a b
rsSF = SF' a b
sf',rsA :: a
rsA = a
a',rsB :: b
rsB = b
b'})
     Bool
done <- ReactHandle a b -> Bool -> b -> IO Bool
actuate ReactHandle a b
rh Bool
True b
b'
     Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
done


------------------------------------------------------------------------------
-- Embedding
------------------------------------------------------------------------------

-- New embed interface. We will probably have to revisit this. To run an
-- embedded signal function while retaining full control (e.g. start and
-- stop at will), one would probably need a continuation-based interface
-- (as well as a continuation based underlying implementation).
--
-- E.g. here are interesting alternative (or maybe complementary)
-- signatures:
--
--    sample :: SF a b -> SF (Event a) (Event b)
--    sample' :: SF a b -> SF (Event (DTime, a)) (Event b)
--
-- Maybe it should be called "subSample", since that's the only thing
-- that can be achieved. At least does not have the problem with missing
-- events when supersampling.
--
-- subSampleSynch :: SF a b -> SF (Event a) (Event b)
-- Time progresses at the same rate in the embedded system.
-- But it is only sampled on the events.
-- E.g.
-- repeatedly 0.1 () >>> subSampleSynch sf >>> hold
--
-- subSample :: DTime -> SF a b -> SF (Event a) (Event b)
-- Time advanced by dt for each event, not synchronized with the outer clock.

-- | Given a signal function and a pair with an initial
-- input sample for the input signal, and a list of sampling
-- times, possibly with new input samples at those times,
-- it produces a list of output samples.
--
-- This is a simplified, purely-functional version of 'reactimate'.
embed :: SF a b -> (a, [(DTime, Maybe a)]) -> [b]
embed :: SF a b -> (a, [(DTime, Maybe a)]) -> [b]
embed SF a b
sf0 (a
a0, [(DTime, Maybe a)]
dtas) = b
b0 b -> [b] -> [b]
forall a. a -> [a] -> [a]
: a -> SF' a b -> [(DTime, Maybe a)] -> [b]
forall t a. t -> SF' t a -> [(DTime, Maybe t)] -> [a]
loop a
a0 SF' a b
sf [(DTime, Maybe a)]
dtas
    where
        (SF' a b
sf, b
b0) = (SF a b -> a -> (SF' a b, b)
forall a b. SF a b -> a -> Transition a b
sfTF SF a b
sf0) a
a0

        loop :: t -> SF' t a -> [(DTime, Maybe t)] -> [a]
loop t
_ SF' t a
_ [] = []
        loop t
a_prev SF' t a
sf ((DTime
dt, Maybe t
ma) : [(DTime, Maybe t)]
dtas) =
            a
b a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (t
a t -> [a] -> [a]
`seq` a
b a -> [a] -> [a]
`seq` t -> SF' t a -> [(DTime, Maybe t)] -> [a]
loop t
a SF' t a
sf' [(DTime, Maybe t)]
dtas)
            where
                a :: t
a        = t -> Maybe t -> t
forall a. a -> Maybe a -> a
fromMaybe t
a_prev Maybe t
ma
                (SF' t a
sf', a
b) = (SF' t a -> DTime -> t -> (SF' t a, a)
forall a b. SF' a b -> DTime -> a -> Transition a b
sfTF' SF' t a
sf) DTime
dt t
a


-- | Synchronous embedding. The embedded signal function is run on the supplied
-- input and time stream at a given (but variable) ratio >= 0 to the outer time
-- flow. When the ratio is 0, the embedded signal function is paused.

-- What about running an embedded signal function at a fixed (guaranteed)
-- sampling frequency? E.g. super sampling if the outer sampling is slower,
-- subsampling otherwise. AS WELL as at a given ratio to the outer one.
--
-- Ah, but that's more or less what embedSync does.
-- So just simplify the interface. But maybe it should also be possible
-- to feed in input from the enclosing system.

-- !!! Should "dropped frames" be forced to avoid space leaks?
-- !!! It's kind of hard to se why, but "frame dropping" was a problem
-- !!! in the old robot simulator. Try to find an example!

embedSynch :: SF a b -> (a, [(DTime, Maybe a)]) -> SF Double b
embedSynch :: SF a b -> (a, [(DTime, Maybe a)]) -> SF DTime b
embedSynch SF a b
sf0 (a
a0, [(DTime, Maybe a)]
dtas) = SF :: forall a b. (a -> Transition a b) -> SF a b
SF {sfTF :: DTime -> Transition DTime b
sfTF = DTime -> Transition DTime b
tf0}
    where
        tts :: [DTime]
tts       = (DTime -> (DTime, Maybe a) -> DTime)
-> DTime -> [(DTime, Maybe a)] -> [DTime]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (\DTime
t (DTime
dt, Maybe a
_) -> DTime
t DTime -> DTime -> DTime
forall a. Num a => a -> a -> a
+ DTime
dt) DTime
0 [(DTime, Maybe a)]
dtas
        bbs :: [b]
bbs@(b
b:[b]
_) = SF a b -> (a, [(DTime, Maybe a)]) -> [b]
forall a b. SF a b -> (a, [(DTime, Maybe a)]) -> [b]
embed SF a b
sf0 (a
a0, [(DTime, Maybe a)]
dtas)

        tf0 :: DTime -> Transition DTime b
tf0 DTime
_ = (DTime -> [(DTime, b)] -> SF' DTime b
forall b. DTime -> [(DTime, b)] -> SF' DTime b
esAux DTime
0 ([DTime] -> [b] -> [(DTime, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [DTime]
tts [b]
bbs), b
b)

        esAux :: DTime -> [(DTime, b)] -> SF' DTime b
esAux DTime
_       []    = String -> String -> String -> SF' DTime b
forall a. String -> String -> String -> a
intErr String
"AFRP" String
"embedSynch" String
"Empty list!"
        -- Invarying below since esAux [] is an error.
        esAux DTime
tp_prev [(DTime, b)]
tbtbs = (DTime -> DTime -> Transition DTime b) -> SF' DTime b
forall a b. (DTime -> a -> Transition a b) -> SF' a b
SF' DTime -> DTime -> Transition DTime b
tf -- True
            where
                tf :: DTime -> DTime -> Transition DTime b
tf DTime
dt DTime
r | DTime
r DTime -> DTime -> Bool
forall a. Ord a => a -> a -> Bool
< DTime
0     = String -> String -> String -> Transition DTime b
forall a. String -> String -> String -> a
usrErr String
"AFRP" String
"embedSynch"
                                             String
"Negative ratio."
                        | Bool
otherwise = let tp :: DTime
tp = DTime
tp_prev DTime -> DTime -> DTime
forall a. Num a => a -> a -> a
+ DTime
dt DTime -> DTime -> DTime
forall a. Num a => a -> a -> a
* DTime
r
                                          (b
b, [(DTime, b)]
tbtbs') = DTime -> [(DTime, b)] -> (b, [(DTime, b)])
forall t a. Ord t => t -> [(t, a)] -> (a, [(t, a)])
advance DTime
tp [(DTime, b)]
tbtbs
                                      in
                                          (DTime -> [(DTime, b)] -> SF' DTime b
esAux DTime
tp [(DTime, b)]
tbtbs', b
b)

                -- Advance the time stamped stream to the perceived time tp.
                -- Under the assumption that the perceived time never goes
                -- backwards (non-negative ratio), advance maintains the
                -- invariant that the perceived time is always >= the first
                -- time stamp.
        advance :: t -> [(t, a)] -> (a, [(t, a)])
advance t
_  tbtbs :: [(t, a)]
tbtbs@[(t
_, a
b)] = (a
b, [(t, a)]
tbtbs)
        advance t
tp tbtbtbs :: [(t, a)]
tbtbtbs@((t
_, a
b) : tbtbs :: [(t, a)]
tbtbs@((t
t', a
_) : [(t, a)]
_))
                    | t
tp t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<  t
t' = (a
b, [(t, a)]
tbtbtbs)
                    | t
t' t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
tp = t -> [(t, a)] -> (a, [(t, a)])
advance t
tp [(t, a)]
tbtbs
        advance t
_ [(t, a)]
_ = (a, [(t, a)])
forall a. HasCallStack => a
undefined


-- Embedding and missing events.
-- Suppose a subsystem is super sampled. Then some of the output
-- samples will have to be dropped. If we are unlycky, the dropped
-- samples could be occurring events that we'd rather not miss.
-- This is a real problem.
-- Similarly, when feeding input into a super-sampled system,
-- we may need to extrapolate the input, assuming that it is
-- constant. But if (part of) the input is an occurring event, we'd
-- rather not duplicate that!!!
-- This suggests that:
--    * output samples should be merged through a user-supplied merge
--      function.
--    * input samples should be extrapolated if necessary through a
--      user-supplied extrapolation function.
--
-- Possible signature:
--
-- resample :: Time -> (c -> [a]) -> SF a b -> ([b] -> d) -> SF c d
--
-- But what do we do if the inner system runs more slowly than the
-- outer one? Then we need to extrapolate the output from the
-- inner system, and we have the same problem with events AGAIN!

-- | Spaces a list of samples by a fixed time delta, avoiding
--   unnecessary samples when the input has not changed since
--   the last sample.
deltaEncode :: Eq a => DTime -> [a] -> (a, [(DTime, Maybe a)])
deltaEncode :: DTime -> [a] -> (a, [(DTime, Maybe a)])
deltaEncode DTime
_  []        = String -> String -> String -> (a, [(DTime, Maybe a)])
forall a. String -> String -> String -> a
usrErr String
"AFRP" String
"deltaEncode" String
"Empty input list."
deltaEncode DTime
dt aas :: [a]
aas@(a
_:[a]
_) = (a -> a -> Bool) -> DTime -> [a] -> (a, [(DTime, Maybe a)])
forall a.
(a -> a -> Bool) -> DTime -> [a] -> (a, [(DTime, Maybe a)])
deltaEncodeBy a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==) DTime
dt [a]
aas


-- | 'deltaEncode' parameterized by the equality test.
deltaEncodeBy :: (a -> a -> Bool) -> DTime -> [a] -> (a, [(DTime, Maybe a)])
deltaEncodeBy :: (a -> a -> Bool) -> DTime -> [a] -> (a, [(DTime, Maybe a)])
deltaEncodeBy a -> a -> Bool
_  DTime
_  []      = String -> String -> String -> (a, [(DTime, Maybe a)])
forall a. String -> String -> String -> a
usrErr String
"AFRP" String
"deltaEncodeBy" String
"Empty input list."
deltaEncodeBy a -> a -> Bool
eq DTime
dt (a
a0:[a]
as) = (a
a0, [DTime] -> [Maybe a] -> [(DTime, Maybe a)]
forall a b. [a] -> [b] -> [(a, b)]
zip (DTime -> [DTime]
forall a. a -> [a]
repeat DTime
dt) (a -> [a] -> [Maybe a]
debAux a
a0 [a]
as))
    where
        debAux :: a -> [a] -> [Maybe a]
debAux a
_      []                     = []
        debAux a
a_prev (a
a:[a]
as) | a
a a -> a -> Bool
`eq` a
a_prev = Maybe a
forall a. Maybe a
Nothing Maybe a -> [Maybe a] -> [Maybe a]
forall a. a -> [a] -> [a]
: a -> [a] -> [Maybe a]
debAux a
a [a]
as
                             | Bool
otherwise     = a -> Maybe a
forall a. a -> Maybe a
Just a
a  Maybe a -> [Maybe a] -> [Maybe a]
forall a. a -> [a] -> [a]
: a -> [a] -> [Maybe a]
debAux a
a [a]
as


-- * Debugging / Step by step simulation

-- | A wrapper around an initialized SF (continuation), needed for testing and
-- debugging purposes.
--
newtype FutureSF a b = FutureSF { FutureSF a b -> SF' a b
unsafeSF :: SF' a b }


-- | 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 a b
           -> a                  -- ^ Input sample
           -> (b, FutureSF a b)  -- ^ Output x Continuation
evalAtZero :: SF a b -> a -> (b, FutureSF a b)
evalAtZero (SF { sfTF :: forall a b. SF a b -> a -> Transition a b
sfTF = a -> Transition a b
tf }) a
a = (b
b, SF' a b -> FutureSF a b
forall a b. SF' a b -> FutureSF a b
FutureSF SF' a b
tf' )
  where (SF' a b
tf', b
b) = a -> Transition a b
tf a
a


-- | 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 :: FutureSF a b
       -> DTime -> a         -- ^ Input sample
       -> (b, FutureSF a b)  -- ^ Output x Continuation
evalAt :: FutureSF a b -> DTime -> a -> (b, FutureSF a b)
evalAt (FutureSF { unsafeSF :: forall a b. FutureSF a b -> SF' a b
unsafeSF = SF' a b
tf }) DTime
dt a
a = (b
b, SF' a b -> FutureSF a b
forall a b. SF' a b -> FutureSF a b
FutureSF SF' a b
tf')
  where (SF' a b
tf', b
b) = (SF' a b -> DTime -> a -> (SF' a b, b)
forall a b. SF' a b -> DTime -> a -> Transition a b
sfTF' SF' a b
tf) DTime
dt a
a


-- | 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 a b -> a -> DTime -> (b, SF a b)
evalFuture :: SF a b -> a -> DTime -> (b, SF a b)
evalFuture SF a b
sf a
a DTime
dt = (b
b, DTime -> SF a b
sf' DTime
dt)
  where (b
b, DTime -> SF a b
sf') = SF a b -> a -> (b, DTime -> SF a b)
forall a b. SF a b -> a -> (b, DTime -> SF a b)
evalStep SF a b
sf a
a


-- | Steps the signal function into the future one step. It returns the current
-- output, and a signal function that expects, apart from an input, a time
-- between samples.
evalStep :: SF a b -> a -> (b, DTime -> SF a b)
evalStep :: SF a b -> a -> (b, DTime -> SF a b)
evalStep (SF a -> Transition a b
sf) a
a = (b
b, \DTime
dt -> (a -> Transition a b) -> SF a b
forall a b. (a -> Transition a b) -> SF a b
SF (SF' a b -> DTime -> a -> Transition a b
forall a b. SF' a b -> DTime -> a -> Transition a b
sfTF' SF' a b
sf' DTime
dt))
  where (SF' a b
sf', b
b) = a -> Transition a b
sf a
a

-- Vim modeline
-- vim:set tabstop=8 expandtab: