使用foldM和可能的State编写一个简单的函数

时间:2016-05-24 16:24:45

标签: haskell

我正在尝试编写一个基本上遍历问题列表的小函数,对于每个问题,提示将等待用户的响应,如果答案是正确的,则在分数中加1,如果是,则不执行任何操作错。

我认为使用foldM应该足够了,如果我只需要跟踪分数,但我也想打印每个问题在列表中的位置,如“问题1:”等等。

使用State Monad会有助于跟踪得分和位置吗? 此外,我很想和国家一起练习..

这是当前的代码:

每个问题都是一个带字符串和答案的元组

import Control.Monad
import Control.Concurrent
import System.Exit


qs =
    [( "question"
     ,["1"]            --number of the correct answer, from 1 to 4
    ]

main =
    putStrLn "Type \"init\" to begin" >>
    getLine >>= \l -> case l of
        "init" -> act
        _      -> main

act :: IO ()
act =
    let score = foldM (
        \acc (q,a) ->
        putStrLn q >>
        getLine >>= \l ->
        if (l `elem` a)
            then putStrLn "CORRECT!"    >>
                 threadDelay (2 * 10^6) >>
                 acc >>= \a -> a + 1
            else putStrLn "WRONG!"      >>
                 threadDelay (2 * 10^6) >>
                 acc
    ) 0 qs
    in  putStrLn $ "Score: " ++ score >>
    if (score > 18)
        then putStrLn "Bravo!"    >>
        else putStrLn "Not enough!" >>
    putStrLn "Type \"1\" to restart, anything else to quit" >>
    getLine >> \l -> case l of
        "1" -> act
        _   -> exitSuccess

2 个答案:

答案 0 :(得分:2)

以下是使用StateT同时允许StateIO的示例。

module Main where

import Control.Monad.State

type Question = (String,String)
type Questions = [Question]
type Score = Int
type Game = StateT Score IO ()  -- combine State and IO effects

play :: Question -> Game
play (question,answer) = do
  liftIO $ putStrLn question  -- IO requires using the liftIO function explicitly
  input <- liftIO $ getLine
  if answer == input
    then do
      liftIO $ putStrLn "correct!"
      modify (+1) -- add 1 to score
    else
      liftIO $ putStrLn "wrong!"
  score <- get
  liftIO $ putStrLn $ "Your score is: " ++ (show score)

questions :: Questions
questions = [("1+1=", "2"), ("What is the best programming language?", "haskell")]

main :: IO ()
main = do
  runStateT (traverse play questions) 0  -- no need for foldM since we're using State to handle the score
  putStrLn "game over"

答案 1 :(得分:1)

如果您自己提取迭代函数,则可以简化操作:

import Control.Monad

go score (question,answer) = do
  putStr $ question ++ "? "
  response <- getLine
  if response /= answer
    then do putStrLn "Wrong!"
            return score
    else do putStrLn "Right!"
            return (score+1)

questions = [ ("1+1=", "2"), ("2+2","4"), ("What is your favorite color", "\n") ]

doit = foldM go 0 questions

如果你想跟踪更多的状态 - 比如问题的数量:

go (score,n) (question,answer) = do
  putStr $ "#" ++ show n ++ ": " ++ question ++ "? "
  response <- getLine
  if response /= answer
    then do putStrLn "Wrong!"
            return (score,n+1)
    else do putStrLn "Right!"
            return (score+1,n+1)