Reactimation
Basic reactimation in BearRiver Yampa
Type signatures of reactimate
reactimate
:: Monad m =>
m in -- inputInit/senseInit
-> (Bool -> m (DTime, Maybe in)) -- input/sense
-> (Bool -> out -> m Bool) -- output/actuate
-> SF Identity in out -- process/signal function
-> m ()
Note that the input and output procedure also have an Bool
parameter which is unused if you look at the implementation therefore we can just ignore it.
Here is a minimal implementation which just produces 1.0s time deltas independent of the real world time. So far it’s just a deterministic simulation like embed
and doesn’t provide any utility until we get real time deltas.
main = do
reactimate inputInit input output time
where
inputInit = pure ()
input _ = pure (1.0, Just ())
output _ o = print o >> pure False
-- > 1.0
-- > 2.0
-- > 3.0
-- > ...
-- > Interrupted.
Type signature of time
:
time :: Monad m => SF m a Time
The first question that comes to mind is: How do we quit reactimate
? Well in this case we don’t, so just press Control-c. On Windows there is an issue which messes up the console once you press Control-c within the app. So you probably have to restart ghci now otherwise you get garbeld output and strange error messages.
Here is a more complete example which implements a full game loop with real time deltas.
Note that in a real game loop you wouldn’t write it this way because you would like to have a stable frame rate, make the delay dependent of missed time and account for skipped frames.
Also I don’t know how precise Data.Time.Clock.getCurrentTime
is. But let’s keep it simple for now. On Windows, make sure you run this example without the --io-manager=native
option, otherwise threadDelay
hangs the execution.
{-# LANGUAGE Arrows #-}
import Control.Concurrent (threadDelay)
import Data.Functor.Identity
import Data.IORef
import Data.Time.Clock
import FRP.BearRiver
inputInit :: IO String
inputInit = do
pure "inputInit" -- use this if input doesn't produce anything
input :: IORef UTCTime -> UTCTime -> Bool -> IO (DTime, Maybe String)
input dtRef tInit _ = do
now <- getCurrentTime
prev <- readIORef dtRef
writeIORef dtRef now
let dt = realToFrac $ diffUTCTime now prev -- delta time
let at = realToFrac $ diffUTCTime now tInit -- absolute time
return (dt, Just (show now)) -- usually you would want to use device inputs or resource media here but let's produce some input strings from time
sf :: Monad m => SF m String String
sf = proc nowStr -> do
t <- integral -< 1.0 :: Double
returnA -< " integral: " ++ show t ++ " now: " ++ nowStr
output :: Bool -> String -> IO Bool
output _ out = do
putStrLn out
threadDelay secs -- DON'T USE IT LIKE THIS IN A REAL GAME LOOP
return False
where secs = 1000 * 1000 -- pico seconds
main = do
putStrLn "Warning: On Windows threadDelay only works without io-manager=native options!"
putStrLn "Time progress in about 1sec (+ some processor time) steps. Interrupt with [Control-C]!"
t <- getCurrentTime
dtRef <- newIORef t
reactimate inputInit (input dtRef t) output sf
putStrLn "...end"
-- > start...
-- > now: 2021-09-12 09:42:57.1321897 UTC integral: 0.0
-- > now: 2021-09-12 09:42:58.1421375 UTC integral: 1.0099473
-- > now: 2021-09-12 09:42:59.1492352 UTC integral: 2.0170455
-- > Interrupted.
>>> cabal repl reactimate # DON'T USE io-manager=native HERE!
>>> main
Press Control-c again to quit. On Windows you need to restart GHCI one more time.
Note that inputInit
is only used as fallback here if input never produces anything. You can see that if you end input with:
input dtRef tInit _ = do
...
pure (dt, if at < 3 then Nothing else Just (show now))
-- > start...
-- > now: inputInit integral: 0.0
-- > now: inputInit integral: 1.0099473
-- > now: inputInit integral: 2.0170455
-- > now: 2021-09-12 09:42:59.1492352 UTC integral: 3.0270455
-- > Interrupted.
On Windows make sure you use GHC 9 and start with --io-manager=native -RTS
option, otherwise NoBuffering
and getChar
wont work:
>>> cabal repl reactimate --ghci-options '+RTS --io-manager=native -RTS'
In this example we use a poor man’s input handling with getChar
which just reads one character from the console. Depending on how long the user waits we get the corrsponding time delta. Once you press Q the app quits.
{-# LANGUAGE Arrows #-}
import Data.Functor.Identity
import Data.IORef
import Data.Time.Clock
import FRP.BearRiver
import Numeric
import System.IO ( stdin, hSetBuffering, BufferMode(NoBuffering) )
inputInit :: IO (Char, String)
inputInit = do
pure ('\x00', "inputInit")
input :: IORef UTCTime -> UTCTime -> a -> IO (DTime, Maybe (Char, String))
input dtRef tInit _ = do
c <- getChar
now <- getCurrentTime
prev <- readIORef dtRef
writeIORef dtRef now
let dt = realToFrac $ diffUTCTime now prev -- delta time
let at = realToFrac $ diffUTCTime now tInit -- absolute time
pure (dt, Just (c, show now))
sf :: SF Identity (Char, String) (Bool, String)
sf = proc (input, nowStr) -> do
t <- integral -< 1.0 :: Double
let out = "integral: " ++ showFFloat (Just 2) t "" ++ " now: " ++ nowStr
returnA -< (input == 'q', out)
output :: a -> (Bool, String) -> IO Bool
output _ (quit, out) = do
putStrLn out
pure quit
main = do
putStrLn "Repeatedly press any key or [Q] to quit!"
hSetBuffering stdin NoBuffering
t <- getCurrentTime
dtRef <- newIORef t
reactimate inputInit (input dtRef t) output sf
putStrLn "...end"
-- > start...
-- > Repeatedly press any key or [Q] to quit!
-- > integral: 0.64 now: 2021-09-12 10:09:21.9324477 UTC
-- > integral: 1.80 now: 2021-09-12 10:09:23.0927901 UTC
-- > integral: 2.73 now: 2021-09-12 10:09:24.0177477 UTC
-- > ...end
>>> cabal repl input #--ghci-options '+RTS --io-manager=native -RTS'
>>> main
Reactimate in Dunai
type signatures of reactimate
-- BearRiver
reactimate
:: Monad m =>
m in -- inputInit/senseInit
-> (Bool -> m (DTime, Maybe in)) -- input/sense
-> (Bool -> out -> m Bool) -- output/actuate
-> SF Identity in out -- process/signal function
-> m ()
-- Dunai
reactimate :: Monad m => MSF m () () -> m ()
main = do
hSetBuffering stdin LineBuffering -- important if you work on Windows
putStrLn "Enter some words: "
Dunai.reactimate (arrM (const getLine) >>> arr reverse >>> arrM putStrLn)
-- > Enter some words:
-- > hello
-- > olleh
-- > world
-- > dlorw
Note that the functions arrM_
and liftS
mentioned on https://github.com/ivanperez-keera/dunai don’t really exist.
From the paper:
liftLM :: (Monad m, Monad n) => (forall a . m a -> n a) -> MSF m a b -> MSF n a b
liftST = liftLM . lift
From source:
-- | Lifts a monadic computation into a Stream.
constM :: Monad m => m b -> MSF m a b
constM = arrM . const
-- | Apply a monadic transformation to every element of the input stream.
-- Generalisation of 'arr' from 'Arrow' to monadic functions.
arrM :: Monad m => (a -> m b) -> MSF m a b
arrM = ...
-- | Apply trans-monadic actions (in an arbitrary way).
-- This is just a convenience function when you have a function to move across
-- monads, because the signature of 'morphGS' is a bit complex.
morphS :: (Monad m1, Monad m2)
=> (forall c . m1 c -> m2 c)
-> MSF m1 a b
-> MSF m2 a b
morphS = ...
-- | Lift inner monadic actions in monad stacks.
liftTransS :: (MonadTrans t, Monad m, Monad (t m))
=> MSF m a b
-> MSF (t m) a b
liftTransS = morphS lift
Therefore:
arrM_ => constM
liftS => arrM
liftLM => morphS
liftST => liftTransS
MyReactimate
Let’s implement our own myreactimate
{-# LANGUAGE Arrows #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE KindSignatures #-}
import Control.Monad.Trans.MSF.Reader
import Data.Functor.Identity
import Data.MonadicStreamFunction
import System.IO
type SF m = MSF (ReaderT Double m)
input :: IO (Double, Char)
input = do
i <- getChar
pure (dt, i)
where dt = 1.0
process :: SF Identity Char String
process = proc i -> do -- input is inserted as an arrow input
tStr <- constM (show <$> ask) -< () -- whereas the time deltas are provided from the reader monad
returnA -< tStr
output :: String -> IO ()
output o = putStrLn o
myreactimate :: forall a b. IO (Double, a) -> (b -> IO ()) -> SF Identity a b -> IO ()
myreactimate sense actuate sf = reactimate $ senseSF sense >>> sfIO sf >>> actuateSF actuate
where
senseSF :: forall (m :: * -> *) a. Monad m => m a -> MSF m () a
senseSF s = constM s
actuateSF :: forall (m :: * -> *) a b. Monad m => (a -> m b) -> MSF m a b
actuateSF a = arrM a
sfIO :: forall (m2 :: * -> *) r a b. Monad m2 => MSF (ReaderT r Identity) a b -> MSF m2 (r, a) b
sfIO s = morphS (pure . runIdentity) (runReaderS s)
main :: IO ()
main = do
putStrLn "Press any key to get fake delta times and [Control-C] to interrupt!"
hSetBuffering stdin NoBuffering
myreactimate input output process
>>> cabal repl myreactimate0 --ghci-options '+RTS --io-manager=native -RTS'
>>> main
Now if want to make the type signatures explicit
myreactimate :: IO (Double, a) -> (b -> IO ()) -> SF Identity a b -> IO ()
myreactimate sense actuate sf = reactimate $ senseSF >>> sfIO >>> actuateSF
where
senseSF :: MSF IO () (Double, a)
senseSF = constM sense
actuateSF :: MSF IO b ()
actuateSF = arrM actuate
sfIO :: MSF IO (Double, a) b
sfIO = morphS (pure . runIdentity) (runReaderS sf)
-- Couldn't match type ‘b1’ with ‘b’
-- Expected: MSF IO b1 ()
-- Actual: MSF IO b ()
-- ‘b1’ is a rigid type variable bound by
-- the type signature for: actuateSF :: forall b1. MSF IO b1 ()
Thats because the variable b
mentioned in the signature is different from the b
mentioned in the signature of actuateSF
(which is renamed to b1
). We would have to use ScopedTypeVariables
and forall
, which says something like: “for the following block assume the variables to be the same.”
{-# LANGUAGE ScopedTypeVariables #-}
myreactimate :: forall a b. IO (Double, a) -> (b -> IO ()) -> SF Identity a b -> IO ()
myreactimate sense actuate sf = reactimate $ senseSF >>> sfIO >>> actuateSF
where
senseSF :: MSF IO () (Double, a)
senseSF = constM sense
actuateSF :: MSF IO b ()
actuateSF = arrM actuate
sfIO :: MSF IO (Double, a) b
sfIO = morphS (pure . runIdentity) (runReaderS sf)
Here is the version that Haskell Language Server suggested
{-# LANGUAGE RankNTypes, KindSignatures #-}
myreactimate :: forall a b. IO (Double, a) -> (b -> IO ()) -> SF Identity a b -> IO ()
myreactimate sense actuate sf = reactimate $ senseSF sense >>> sfIO sf >>> actuateSF actuate
where
senseSF :: forall (m :: * -> *) a. Monad m => m a -> MSF m () a
senseSF s = constM s
actuateSF :: forall (m :: * -> *) a b. Monad m => (a -> m b) -> MSF m a b
actuateSF a = arrM a
sfIO :: forall (m2 :: * -> *) r a b. Monad m2 => MSF (ReaderT r Identity) a b -> MSF m2 (r, a) b
sfIO s = morphS (pure . runIdentity) (runReaderS s)
Can we use Yampa functions within? Turns out: yes
Yampa definitions:
type SF m = MSF (ClockInfo m)
type ClockInfo m = ReaderT DTime m
type DTime = Double
SF :: Monad m => MSF (ReaderT Double m) a b
{-# LANGUAGE Arrows, ScopedTypeVariables #-}
import Control.Monad.Trans.MSF.Reader
import Data.Functor.Identity
import Data.MonadicStreamFunction
import FRP.BearRiver hiding (reactimate)
import System.IO
input :: IO (Double, Char)
input = do
i <- getChar
pure (dt, i)
where dt = 1.0
process :: SF Identity Char String -- this is an BearRiver.SF now, not a Dunai.MSF
process = proc i -> do
t <- sumS -< 1.0 :: Double -- using BearRiver.sumS here!
returnA -< show t
output :: String -> IO ()
output o = putStrLn o
myreactimate :: forall a b. IO (Double, a) -> (b -> IO ()) -> SF Identity a b -> IO ()
myreactimate sense actuate sf = reactimate $ senseSF >>> sfIO >>> actuateSF
where
senseSF :: MSF IO () (Double, a)
senseSF = constM sense
actuateSF :: MSF IO b ()
actuateSF = arrM actuate
sfIO :: MSF IO (Double, a) b
sfIO = morphS (pure . runIdentity) (runReaderS sf)
main :: IO ()
main = do
putStrLn "Press any key to get custom process counts and [Control-C] to interrupt!"
hSetBuffering stdin NoBuffering
myreactimate input output process
>>> cabal repl myreactimate1 #--ghci-options '+RTS --io-manager=native -RTS'
>>> main
So if you disagree on how Yampa’s reactimate
is implemented, this is your chance. Let’s get back to using BearRiver.reactimate though because it already works.
Terminating myreactimate
[FrpRefac16] 4.3 Exceptions and Control Flow - MSFs can use different monads to define control structures. One common construct is switching, that is, applying a transformation until a certain time, and then applying a different transformation. We can implement an equivalent construct using monads like Either or Maybe. We could define a potentially-terminating MSF as an MSF in a MaybeT m monad. Following the same pattern as before, the associated running function would have type: runMaybeS :: Monad m => MSF (MaybeT m) a b -> MSF m a (Maybe b). Our evaluation function step, for this monad, would have type MSF Maybe a b -> a -> Maybe (b, MSF Maybe a b) indicating that it may produce no continuation. runMaybeS outputs Nothing continuously once the internal MSF produces no result.
Well, that doesn’t help us much. Fortunately Dunai provides a reactimateB
function which uses the ExceptT
internally and allows us to quit using a Bool
.
{-# LANGUAGE Arrows #-}
import Control.Monad.Trans.MSF.Except (reactimateB)
import Control.Monad.Trans.MSF.Reader
import Data.Functor.Identity
import Data.MonadicStreamFunction
import System.IO
type SF m = MSF (ReaderT Double m)
input :: IO (Double, Char)
input = do
i <- getChar
pure (dt, i)
where dt = 1.0
process :: SF Identity Char (Bool, String)
process = proc i -> do -- input is inserted as an arrow input
tStr <- constM (show <$> ask) -< () -- whereas the time deltas are provided from the reader monad
returnA -< (i == 'q', tStr)
output :: (Bool, String) -> IO Bool
output (quit, o) = do
putStrLn o
pure quit
-- we could also move the quit logic from process to output directly
myreactimate :: IO (Double, a) -> (b -> IO Bool) -> SF Identity a b -> IO ()
myreactimate sense actuate sf = reactimateB $ senseSF sense >>> sfIO sf >>> actuateSF actuate
where
senseSF :: Monad m => m a -> MSF m () a
senseSF s = constM s
actuateSF :: Monad m => (a -> m b) -> MSF m a b
actuateSF a = arrM a
sfIO :: Monad m2 => MSF (ReaderT r Identity) a b -> MSF m2 (r, a) b
sfIO s = morphS (pure . runIdentity) (runReaderS s)
main = do
putStrLn "Press any key to get fake delta times and [Q] to quit!"
hSetBuffering stdin NoBuffering
myreactimate input output process
>>> cabal repl myreactimateB # --ghci-options '+RTS --io-manager=native -RTS'
>>> main
{-# LANGUAGE Arrows #-}
import Control.Monad
import Control.Monad.Trans.MSF.Except (reactimateB)
import Control.Monad.Trans.MSF.Reader
import Data.Functor.Identity
import Data.IORef
import Data.MonadicStreamFunction
import System.IO
type SF m = MSF (ReaderT Double m)
input :: IORef Bool -> IO (Double, Char)
input quitRef = do
i <- getChar
when (i == 'q') $ writeIORef quitRef True
pure (dt, i)
where dt = 1.0
process :: SF Identity Char String
process = proc i -> do -- input is inserted as an arrow input
tStr <- constM (show <$> ask) -< () -- whereas the time deltas are provided from the reader monad
returnA -< tStr
output :: IORef Bool -> String -> IO Bool
output quitRef o = do
putStrLn o
readIORef quitRef
myreactimate :: IO (Double, a) -> (b -> IO Bool) -> SF Identity a b -> IO ()
myreactimate sense actuate sf = reactimateB $ senseSF sense >>> sfIO sf >>> actuateSF actuate
where
senseSF :: Monad m => m a -> MSF m () a
senseSF s = constM s
actuateSF :: Monad m => (a -> m b) -> MSF m a b
actuateSF a = arrM a
sfIO :: Monad m2 => MSF (ReaderT r Identity) a b -> MSF m2 (r, a) b
sfIO s = morphS (pure . runIdentity) (runReaderS s)
main = do
putStrLn "Press any key to get fake delta times and [Q] to quit!"
hSetBuffering stdin NoBuffering
quitRef <- newIORef False
myreactimate (input quitRef) (output quitRef) process
[FrpExt17] 6.4 Experience - Personally, I have found that using monad stacks with multiple transformers makes MSFs hard to work with, in spite of the multiple benefits of being able to describe switching in terms of EitherT or parallelism in terms of ListT. With this in mind, it is perhaps still convenient to add layers of abstraction on top of MSFs to describe Functional Reactive Programming or other mathematical constructs, as opposed to expressing programs directly in terms of Monadic Stream Functions (even if they are still implemented that way). Note, however, that programmers with a more mathematical background may find working with monad stacks more straightforward.
Okay…