数あてゲームのバグをつぶす

Hiroaki's blog: Haskellで数あてゲームを書いてみる
にはバグがある。
当てる数を0以上9999以下の乱数で求めているのだが、この数字を文字列にする際、頭の0が失われるのだ。
だから、求める数字が４つにならないことがある。また、数が100未満の場合、0が複数回使われていることをチェックできないのだ。
というわけで、ゲームのルールに従っている数字かどうかをチェックする前に、4桁になるような処理を追加してみた。

import System.Random
import Control.Monad(when)

isUsedNum :: Char->String->Int
isUsedNum _ [] = 0
isUsedNum a (x:xs)
             | a == x    = 1 + isUsedNum a xs
             | otherwise = isUsedNum a xs

countUsedNum :: String->String->Int
countUsedNum [] _ = 0
countUsedNum (x:xs) ys = isUsedNum x ys + countUsedNum xs ys

countBlow :: String->String->Int
countBlow [] _ = 0
countBlow _ [] = 0
countBlow (x:xs) (y:ys)
          | x == y    = 1 + countBlow xs ys
          | otherwise = countBlow xs ys

resultString :: String->String->(Bool, String)
resultString xs ys =
             (endFlag, show hit ++ " hit(s) " ++ show blow ++ " blow(es).")
             where blow = countBlow xs ys
                   hit = countUsedNum xs ys - blow
                   endFlag = blow == 4

isSuitableNum :: String->Bool
isSuitableNum [] = True
isSuitableNum (x:xs) = isUsedNum x xs == 0 && isSuitableNum xs

checkNum :: String->IO ()
checkNum compNum = do
         putStrLn "Number ? "
         guessNum <- getLine
         when (not $ null guessNum) $ do
              let (flag, msg) = resultString compNum guessNum
              putStrLn msg
              when (not flag) $ checkNum compNum
         return ()

normNum :: String->String
normNum xs
        | (l < 4)       = normNum $ "0" ++ xs
        | otherwise     = xs
        where l = length xs

targetNum :: [Int]->String
targetNum (x:xs)
          | (isSuitableNum strX) = strX
          | otherwise            = targetNum xs
          where strX = normNum $ show x

main = do
     r <- getStdRandom $ randomR (0, 99)
     let t = targetNum $ randomRs (0,9999) (mkStdGen r)
     checkNum t
     putStrLn t