haskell - 有没有办法使用reactimate在Yampa的getLine中创建一个信号函数

Question

我正在尝试编写一个简单的基于命令行的反射游戏，它会提示用户在随机时间后按回车键，然后输出反应时间。我正在使用基于此示例的 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时这根本不可能？

标签： haskellfrpyampa

Answer 1

这是一个似乎可以执行您想要的程序的程序：

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