Is there a way to create a Signal Function out of getLine in Yampa using reactimate

Question

I'm trying to write a simple command line based reflex game which will prompt the user to hit enter after a random amount of time and then output the reaction time. I'm using reactimate based on this example: https://wiki.haskell.org/Yampa/reactimate My code works perfectly fine in the way I intend it to:

module Main where

import Control.Monad
import Data.IORef
import Data.Time.Clock
import System.Random
import FRP.Yampa
  
main :: IO ()
main = do
    startTime <- getCurrentTime
    startTimeRef <- newIORef startTime
    randomTime <- randomRIO (0, 10)
    reactimate helloMessage (sense startTimeRef) sayNow (randomTimePassed randomTime)
    playerTime <- getCurrentTime
    playerTimeRef <- newIORef playerTime
    s <- getLine --programm will wait here
    reactimate doNothing (sense playerTimeRef) endMessage (enterPressed s)
    now <- getCurrentTime
    let reactionTime =  now `diffUTCTime` playerTime in putStr (show reactionTime)

helloMessage :: IO ()
helloMessage = putStrLn "Press Enter as quickly as possible when I say so..." 

randomTimePassed :: Double -> SF () Bool
randomTimePassed r = time >>> arr (>r)

sayNow :: Bool -> Bool -> IO Bool
sayNow _ x = when x (putStrLn "NOW!") >> return x

doNothing :: IO ()
doNothing = return ()

enterPressed :: String -> SF () Bool --this is not how I want it to be
enterPressed s = arr (\_ -> s == "")

endMessage :: Bool -> Bool -> IO Bool
endMessage _ x = when x (putStr "You reacted in: ") >> return x

sense :: IORef UTCTime -> Bool -> IO (Double, Maybe ())
sense timeRef _ = do
    now      <- getCurrentTime
    lastTime <- readIORef timeRef
    writeIORef timeRef now
    let dt = now `diffUTCTime` lastTime
    return (realToFrac dt, Just ())

But it doesn't realy make use of FRP at all for the pressing enter part I marked in the code. As the programm just waits for getLine to terminate and then instantly ends the reactimate loop. So it's pretty much just using the IO Monad instead of FRP. Is there any way to refactor the signal function enterPressed so that it works in a "FRPish" way? Or is this simply not possible when using reactimate?

Answer 1

Here's a program that seems to do what you want:

module Main where

import Control.Monad
import Data.IORef
import Data.Time.Clock
import FRP.Yampa
import FRP.Yampa.EventS
import System.IO
import System.Random

main :: IO ()
main = do
  t <- getCurrentTime
  timeRef <- newIORef t
  randomTime <- randomRIO (0, 10)
  reactimate initialize (sense timeRef) actuate (signal randomTime)

signal :: Double -> SF (Event Char) (Event Out)
signal randomTime = after randomTime Prompt `andThen` waitForUser

waitForUser :: SF (Event Char) (Event Out)
waitForUser = arr id &&& time
  >>> arr (\(e,t) -> mapFilterE (\c -> do guard (c == '\n'); pure (Enter t)) e)

data Out = Prompt | Enter Time

initialize :: IO (Event a)
initialize = do
  putStrLn "Wait..."
  pure NoEvent

actuate :: Bool -> Event Out -> IO Bool
actuate _ (Event Prompt) = putStrLn "Press now!" >> return False
actuate _ (Event (Enter t)) = True <$ putStrLn ("You responded in " ++ show t ++ " seconds")
actuate _ NoEvent = return False

sense :: IORef UTCTime -> Bool -> IO (Double, Maybe (Event Char))
sense timeRef _ = do
  rdy <- hReady stdin
  c <- if rdy
    then Event <$> hGetChar stdin
    else pure NoEvent
  now      <- getCurrentTime
  lastTime <- readIORef timeRef
  writeIORef timeRef now
  let dt = now `diffUTCTime` lastTime
  return (realToFrac dt, Just c)

To break it down a little, I added a way to sense the keyboard inputs:

sense timeRef _ = do
  rdy <- hReady stdin
  c <- if rdy
    then Event <$> hGetChar stdin
    else pure NoEvent
  ...

It is important that the sensing function is non-blocking, because it is also the thing that dictates the "sampling rate" of the reactive program. If it would block, for example with readLine, here then the timer would never reach the required time for the prompt to show up.

The second important change is to use a richer output event type:

data Out = Prompt | Enter Time


actuate :: Bool -> Event Out -> IO Bool
actuate _ (Event Prompt) = putStrLn "Press now!" >> return False
actuate _ (Event (Enter t)) = True <$ putStrLn ("You responded in " ++ show t ++ " seconds")
actuate _ NoEvent = return False

The actions I have identified are showing the prompt and pressing enter at a specific time. These are enough to implement the required behavior.

And finally the signal function needs to be specified:

signal :: Double -> SF (Event Char) (Event Out)
signal randomTime = after randomTime Prompt `andThen` waitForUser

waitForUser :: SF (Event Char) (Event Out)
waitForUser = arr id &&& time
  >>> arr (\(e,t) -> mapFilterE (\c -> do guard (c == '\n'); pure (Enter t)) e)

This is split in two parts. The first part waits for the random time determined at the beginning of the program. And the second part starts a new timer (with the time signal function) and waits for a newline character event. If that happens then it returns an enter event which contains the time it took for the user to press enter.

The syntax is a bit complicated, maybe it is easier to read if I use the {-# LANGUAGE Arrows #-} syntax:

waitForUser :: SF (Event Char) (Event Out)
waitForUser = proc c -> do
  t <- time -< ()
  returnA -< case c of
    Event '\n' -> Event (Enter t)
    _ -> NoEvent