有没有办法使用reactimate在Yampa中的getLine之外创建信号函数

如何解决有没有办法使用reactimate在Yampa中的getLine之外创建信号函数

我正在尝试编写一个简单的基于命令行的反射游戏，它将提示用户在随机时间后按 Enter 键，然后输出反应时间。我正在使用基于此示例的 reactimate：https://wiki.haskell.org/Yampa/reactimate 我的代码完全按照我的意愿运行：

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 ())

但是对于我在代码中标记的按下输入部分，它根本没有使用 FRP。由于程序只是等待 getLine 终止，然后立即结束反应循环。所以它几乎只是使用 IO Monad 而不是 FRP。有什么方法可以重构信号函数 enterpressed 使其以“FRPish”方式工作？或者这在使用reactimate时根本不可能？

解决方法

这是一个似乎可以做您想做的事情的程序：

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)

为了稍微分解一下，我添加了一种感知键盘输入的方法：

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

重要的是感知函数是非阻塞的，因为它也是决定反应程序“采样率”的东西。如果它会阻塞，例如使用 readLine，那么计时器将永远不会达到提示显示所需的时间。

第二个重要变化是使用更丰富的输出事件类型：

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

我确定的操作是在特定时间显示提示并按 Enter 键。这些足以实现所需的行为。

最后需要指定信号函数：

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)

这分为两部分。第一部分等待程序开始时确定的随机时间。第二部分启动一个新的计时器（使用 time 信号函数）并等待换行符事件。如果发生这种情况，它会返回一个 enter 事件，其中包含用户按下 Enter 所需的时间。

语法有点复杂，如果我使用{-# LANGUAGE Arrows #-}语法可能更容易阅读：

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