プログラミングHaskell 9章練習問題６の他人の解答を自分なりに変更してみた

以下の記事を見たので、自分なりに書き直してみた。
http://d.hatena.ne.jp/morning_reading/20110415/p1

変更した部分については以下に説明を載せて、最後に全文を載せます。

解説

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

seqnは、sequence_という名前で同じ機能のアクションが用意されているので、こちらを使います。
このようなよくありがちなパターンはすでに用意されていることが多いので、hoogleで確認すると良いと思います。
今回の場合、IOアクションのリストを順番に実行するアクションが欲しいので、'[IO a] -> IO ()'というクエリでhoogleで検索すれば、該当するものが見つかるはずです。
http://www.haskell.org/hoogle/

showboard :: Board -> IO ()
showboard b = goto (1,1) >> mapM_ showLine (zip [1..] b)
  where
    showLine (id,num) = putStrLn $ show id ++ ": " ++ replicate num '*'

showboardはガッツリ変更。もとはseqnが使われてましたが、意味的にはmapM_のほうが素直に思えたので変更。
また、行の出力は直接書くと見づらいのでwhereで別途定義しました。
takeとrepeatを使用しているところは、同様の関数であるreplicateがあるので、こちらを使用します。
showLineについては、括弧の数を減らしました。関数適用が一番優先順位高いことと、$を使えば括弧がなくてもそれなりにわかりやすいかなと思います。

checkLimit :: Int -> Int -> Maybe Int
checkLimit limit n
  | 1 <= n && n <= limit = Just n
  | otherwise = Nothing

getNat :: Int -> MaybeT IO Int
getNat limit = liftIO readLn >>= MaybeT . return . checkLimit limit

もとはgetNatというひとつのアクションとして定義されていたものを、checkLimitとして一部分離しました。
これは、そもそもIOに依存していないところを分けておくと、副作用に影響されない範囲が明確になりますし、テストもしやすくなります。
getNatはのちに出てくるnextgenアクションのために'MaybeT Io Int'という型になってます。
getLineとreadの代わりに、Preludeで定義されてるこれと同じ機能をもつreadLnに変更しています。MaybeT . returnというのが「pureな値をMaybeT IOにするもの」というふうに見ると、getNatの処理は、
readLnで値を読み込んで、
その値をcheckLimitで検査して
その結果をMaybeT IOとして返す
ものになります。

nextboard :: Board -> Int -> Int -> Board
nextboard b s n = let (xs, (y:ys)) = splitAt s b in xs ++ [y-n] ++ ys

nextboardは、ユーザが選択した行のコマを指定の数だけ取る処理です。getNatのところで引数チェックをしているので、ここでは意図的にvalidationは省かれています。
ここではもとのコードでは再帰処理で実装してますが、splitAt関数を使って分割したあと、リストを再構成する方がわかり易い気がしたのでそうしています。

nextgen :: Board -> IO Board
nextgen b = do
  r <- runMaybeT $ nextgenM b
  case r of
    Nothing -> nextgen b
    Just r' -> return r'

nextgenM :: Board -> MaybeT IO Board
nextgenM b = do
  liftIO $ putStr "Enter slot number: "
  s <- getNat $ length b
  liftIO $ putStr "Enter take number: "
  x <- getNat $ b !! (s-1)
  return $ nextboard b (s-1) x

nextgenは大きく変更しています。プログラミングHaskellでここまでに登場していないMaybeTというモナド変換子を使っています。
本にはない範囲ですが、以下の記述があったので、なんとかできないものかと思って変更して見ました。

ただ2回入力を受け取るのに Maybe 型のパターンマッチをそれぞれ書かないといけなくて、これはまとめて書けるようにできないかと試行錯誤したのですが思いつきませんでした。

nextgen :: Board -> IO Board
nextgen b = do
  r <- runMaybeT $ nextgenM b
  case r of
    Nothing -> nextgen b
    Just r' -> return r'

nextgenは実装をMaybeTを使用したものに分離して、ここでは単純なものになっています。
runMaybeTは'MaybeT IO a'な処理を実行して、IO (Maybe a)を返します。
つまり、ここの処理は、Nothingが返ってくるかもしれないIO処理、つまり入力値の検証機能つきのユーザ入力処理を実行して、正しくなければ再度nextgen, そうでなければその値を返しています。

nextgenM :: Board -> MaybeT IO Board
nextgenM b = do
  liftIO $ putStr "Enter slot number: "
  s <- getNat $ length b
  liftIO $ putStr "Enter take number: "
  x <- getNat $ b !! (s-1)
  return $ nextboard b (s-1) x

今回一番変更したのはこの部分です。おこなっていることは、
slotの入力を促すメッセージを出力して、
ユーザからの入力を受け取って
コマをいくつ取るか入力を促すメッセージを出力して、
コマの数を受け取って、
最後に受け取った値を反映したboardの値を返す
処理です。コードそのままですね。

'MaybeT IO Board' という型は、IOとMaybeの両方の特徴をもったものになっています。 maybeはモナドでもあるので、モナド変換子によってIOと組み合わせることができます。
それぞれの処理において、どこか途中でNothingが返ってきた場合、nextgenM全体がNothingになります。
そのため、最初のslotの値を入力する時点でNothingが返された場合、次のgetNatに行かず、nextgenM全体がNothingとなります。
全ての処理でJustが返された場合、無事最後のreturnまで到達し、Justが返ります。

Maybeモナドについては、以下にある羊さんの例が参考になると思います。
http://www.sampou.org/haskell/a-a-monads/html/meet.html

nimmt :: Board -> IO ()
nimmt b = do
  cls
  showboard b
  b <- nextgen b
  when (any (/=0) b) (nimmt b)

nimmtアクションでは、もとはifを使用していたところをControl.Monadで定義されているwhenに変更しています。
また、条件部分はセクションを使い、余計な変数を省いています。
allをanyに変更したのは、’全てが0であるか’を調べるよりも、’ひとつでも0でないものが含まれている’ことを調べるほうが走査回数がすくなりますし、whenを使用した関係上、ゲーム続行の条件として条件が示されているほうが素直だと思ったからです。

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

全文

参考：一から自分で書いたもの

若干の仕様変更はありますが、概ね元ネタと同じような動作をします。