猜我的号码，一元性头痛

Question

为了测试我在 Haskell 中的技能，我决定实现您在 Land of Lisp / Realm of Racket 中找到的第一款游戏。 “猜我的号码”游戏。游戏依赖于可变状态来运行，因为它必须不断更新程序的上限和下限，以了解用户正在考虑的值。

有点像这样：

> (guess)
50
> (smaller)
25
> (bigger)
37

现在，这种事情（据我所知）在 Haskell 中并不完全可能，从 REPL 中调用一些修改全局可变状态的函数，然后立即打印结果，因为它违反了不变性原则。因此，所有交互都必须存在于 IO 和/或 State monad 中。这就是我卡住的地方。

我似乎无法将IO monad 和State monad 组合在一起，所以我可以在同一个函数中获取输入、打印结果和修改状态。

这是我目前得到的：

type Bound = (Int, Int) -- left is the lower bound, right is the upper

initial :: Bound
initial = (1, 100)

guess :: Bound -> Int
guess (l, u) = (l + u) `div` 2

smaller :: State Bound ()
smaller = do
  bd@(l, _) <- get
  let newUpper = max l $ pred $ guess bd
  put $ (l, newUpper)

bigger :: State Bound ()
bigger = do
  bd@(_, u) <- get
  let newLower = min u $ succ $ guess bd
  put $ (newLower, u)

我现在需要做的就是想出一种方法来

• 打印初始猜测
• 接收需要更小/更大数字的命令
• 相应地修改状态
• 递归调用函数，让它再次猜测

我如何以一种优雅的方式结合IO 和State 来实现这一点？

注意：我知道这可能完全不用状态就可以实现；但我想让它保持原汁原味

Answer 1

您可以使用 monad 转换器组合不同的 monad - 在本例中为 StateT。您可以通过将类型签名更改为使用 StateT 来使用现有代码：

bigger, smaller :: Monad m => StateT Bound m ()

那么你可以写一个函数来运行给定状态参数的游戏：

game :: StateT Bound IO ()
game = do
  s <- get
  liftIO $ print (guess s)
  verdict <- (liftIO getLine)
  case verdict of
    "smaller" -> smaller >> game
    "bigger" -> bigger >> game
    "ok" -> return ()
    _ -> (liftIO $ putStrLn $ "Unknown verdict " ++ verdict) >> game

您使用liftIO 将IO 操作提升到StateT Bound IO monad，允许您提示输入并阅读下一行。

终于可以使用runStateT运行游戏了：

runStateT game initial

Answer 2

你问的有点可能......

import Data.IORef

makeGame :: IO (IO (), IO (), IO ())
makeGame = do
    bound <- newIORef (1, 100)
    let guess = do
            (min, max) <- readIORef bound
            print $ (min + max) `div` 2

        smaller = do
            (min, max) <- readIORef bound
            let mid = (min + max) `div` 2
            writeIORef bound (min, mid)
            guess

        bigger = do
            (min, max) <- readIORef bound
            let mid = (min + max) `div` 2
            writeIORef bound (mid, max)
            guess

    return (guess, smaller, bigger)

不管该代码中有多少冗余，这只是概念的快速证明。这是一个示例会话：

$ ghci guess.hs 
GHCi, version 7.9.20141202: http://www.haskell.org/ghc/  :? for help
[1 of 1] Compiling Main             ( guess.hs, interpreted )
Ok, modules loaded: Main.
*Main> (guess, smaller, bigger) <- makeGame 
*Main> guess
50
*Main> smaller
25
*Main> bigger
37
*Main> 

嵌套的IO 类型既有趣又有用。

Answer 3

在此示例中，您根本不必使用 State monad。这是一个将状态作为参数传递的示例：

loop :: Bound -> IO ()
loop bd@(l,u) = do
  putStr "> "
  line <- getLine
  case line of
   "(guess)" -> print (guess bd) >> loop bd
   "(smaller)" -> do
     let newUpper = max l $ dec $ guess bd
     print $ guess (l, newUpper)
     loop (l, newUpper)
   "(bigger)" -> do
     let newLower = min u $ inc $ guess bd
     print $ guess (newLower, u)
     loop (newLower, u)
   "" -> return ()
   _ -> putStrLn "Can't parse input" >> loop bd

main :: IO ()
main = loop initial

否则，您正在寻找的概念是 monad 转换器。例如使用 StateT：

smaller :: StateT Bound IO ()
smaller = do
  bd@(l, _) <- get
  let newUpper = max l $ dec $ guess bd
  put $ (l, newUpper)

bigger :: StateT Bound IO ()
bigger = do
  bd@(_, u) <- get
  let newLower = min u $ inc $ guess bd
  put $ (newLower, u)

guessM :: StateT Bound IO ()
guessM = get >>= lift . print . guess

loop :: StateT Bound IO ()
loop = do
  lift $ putStr "> "
  line <- lift getLine
  case line of
   "(guess)" -> guessM >> loop
   "(smaller)" -> do
     smaller
     guessM
     loop
   "(bigger)" -> do
     bigger
     guessM
     loop
   "" -> return ()
   _ -> lift (putStrLn "Can't parse input") >> loop

main :: IO ()
main = evalStateT loop initial

请参阅chapter of Real World Haskell 获取有关 monad 转换器主题的教程。

Answer 4

这是使用StateT 转换器的解决方案。值得注意的点：

1. 它使用 getLine 而不是使用 REPL 读取用户输入。
2. 它读起来很像命令式程序，只是您必须将liftIO 添加到任何 IO 操作中。
3. 您使用runStateT 运行循环，并在其中提供初始状态。

程序：

import Control.Monad.State

loop :: StateT (Int,Int) IO ()
loop = do
  (lo,hi) <- get
  let g = div (lo+hi) 2
  liftIO $ putStrLn $ "I guess " ++ show g
  ans <- liftIO getLine
  case ans of
    "lower"  -> do put (lo,g); loop
    "higher" -> do put (g,hi); loop
    "exact"  -> return ()
    _        -> do liftIO $ putStrLn "huh?"; loop

main = runStateT loop (0,50)