プログラミング Haskell 第9章 対話プログラム 練習問題その3

練習問題 6. の ニム というゲームを実装する問題をやりました。ニムは Nimmt というつづりでしょうか。

コマを取る場所と取る数はプロンプトを出して入力してもらうようにしています。また文字を数値に変換するところは手抜きして read を使ったので、数値でない入力をするとエラーになってしまいます。
数値が入力されればその範囲のチェックはするようにしていて、その為に IO (Maybe Int) という型を利用したのが自分なりに工夫したつもりです。ただ2回入力を受け取るのに Maybe 型のパターンマッチをそれぞれ書かないといけなくて、これはまとめて書けるようにできないかと試行錯誤したのですが思いつきませんでした。

module Nimmt where

cls :: IO ()
cls = putStr "\ESC[2J"

type Pos = (Int, Int)
type Board = [Int]

goto :: Pos -> IO ()
goto (x, y) = putStr ("\ESC[" ++ show y ++ ";" ++ show x ++ "H")

seqn :: [IO a] -> IO ()
seqn []     = return ()
seqn (a:as) = do a
                 seqn as

-- 1: *****
-- 2: ****
-- ...
-- のように現在の駒の数を表示
showboard :: Board -> IO ()
showboard b = do goto (1,1)
                 seqn [putStrLn ((show id) ++ ": " ++ take num (repeat '*')) | (id, num) <- zip [1..] b]

-- 1 < n <= limit の範囲の自然数を端末から受け取る
getNat :: Int -> IO (Maybe Int)
getNat limit = do n <- getLine
                  if (read n) <= 0 || (read n) > limit
                    then return Nothing
                    else return (Just (read n))

nextboard :: Board -> Int -> Int -> Board
nextboard b 0 n = [(head b) - n] ++ tail b
nextboard b s n = [head b] ++ nextboard (tail b) (s - 1) n

nextgen :: Board -> IO Board
nextgen b = do putStr "Enter slot number: "
               slot <- getNat (length b)
               case slot of
                 Nothing -> nextgen b
                 Just s -> do putStr "Enter take number: "
                              num <- getNat (b !! (s - 1))
                              case num of
                                Nothing -> nextgen b
                                Just x  -> return (nextboard b (s-1) x)

nimmt :: Board -> IO ()
nimmt b = do cls
             showboard b
             b <- nextgen b
             if all (\x -> x == 0) b
               then return ()
               else nimmt b

run_nimmt :: IO ()
run_nimmt = nimmt [5,4,3,2,1]

これで第9章は終えて第10章に進みます。