설날 D-3! 윷놀이용 난수 발생기

module Main where
 
import Random
import IO
 
generatePae :: Int -> IO [Int]
generatePae 0 = return []
generatePae n = do
                  p <- randomIO
                  l <- generatePae (n-1)
                  if p >= ((2::Double)/5)
                    then return (1:l)  -- Flat up
                    else return (0:l)  -- Curved up
 
throwYut = do
              pae <- generatePae 4
              let n = foldr (+) 0 pae
              case n of
                0 -> putStrLn "You win Mo. Throw one more time."
                1 -> if (head pae) == 1
                       then putStrLn "You win Back-Do."
                       else putStrLn "You win Do."
                2 -> putStrLn "You win Gae."
                3 -> putStrLn "You win Geol."
                4 -> putStrLn "You win Yut. Throw one more time."
                _ -> putStrLn "What the hell!"
              return n
 
playYut count d ga ge yu mo = do
  putStrLn "Press Enter to throw yut.. (Enter q to quit)"
  c <- getLine
  if c == "q"
    then return [count,d,ga,ge,yu,mo]
    else do
        r <- throwYut
        case r of
          0 -> playYut (count+1) d ga ge yu (mo+1)
          1 -> playYut (count+1) (d+1) ga ge yu mo
          2 -> playYut (count+1) d (ga+1) ge yu mo
          3 -> playYut (count+1) d ga (ge+1) yu mo
          4 -> playYut (count+1) d ga ge (yu+1) mo
          _ -> playYut (count+1) d ga ge yu mo
 
main = do
   [count,d,ga,ge,yu,mo] <- playYut 0 0 0 0 0 0
   let [co1,do1,ga1,ge1,yu1,mo1] = map fromIntegral [count,d,ga,ge,yu,mo]
   if count == 0
      then putStrLn "No play"
      else do
        putStrLn "------------------------------------------"
        putStrLn "Statistics"
        putStrLn "------------------------------------------"
        putStrLn ("Total : "++(show count))
        putStrLn ("Do    : "++(show d) ++" "++(show (do1/co1)))
        putStrLn ("Gae   : "++(show ga)++" "++(show (ga1/co1))) 
        putStrLn ("Geol  : "++(show ge)++" "++(show (ge1/co1)))
        putStrLn ("Yut   : "++(show yu)++" "++(show (yu1/co1)))
        putStrLn ("Mo    : "++(show mo)++" "++(show (mo1/co1)))
        putStrLn "------------------------------------------"