Haskellでじゃんけんゲームを作る

stack new janken-app

cd janken-app && stack build

stack run

module Lib
  ( playJanken,
    Hand (..),
    Result (..),
    handToStr,
    strToHand,
    judgeJanken,
  )
where

import Control.Monad (when)
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import qualified System.IO as IO
import System.Random (randomRIO)

-- じゃんけんの手を表す型
data Hand = Rock | Scissors | Paper
  deriving (Eq, Show, Read)

-- 勝敗の結果を表す型
data Result = Draw | Win | Lose
  deriving (Eq, Show)

-- 日本語表記への変換
handToStr :: Hand -> String
handToStr Rock = "グー"
handToStr Scissors = "チョキ"
handToStr Paper = "パー"

-- 結果の日本語表記への変換
resultToStr :: Result -> String
resultToStr Draw = "あいこです"
resultToStr Win = "あなたの勝ちです"
resultToStr Lose = "あなたの負けです"

-- 日本語入力からHandへの変換
strToHand :: String -> Maybe Hand
strToHand "グー" = Just Rock
strToHand "チョキ" = Just Scissors
strToHand "パー" = Just Paper
strToHand _ = Nothing

-- ランダムな手を生成
randomHand :: IO Hand
randomHand = do
  n <- randomRIO (0, 2) :: IO Int
  return $ case n of
    0 -> Rock
    1 -> Scissors
    _ -> Paper

-- 勝敗判定
judgeJanken :: Hand -> Hand -> Result
judgeJanken player computer
  | player == computer = Draw
  | (player == Rock && computer == Scissors)
      || (player == Scissors && computer == Paper)
      || (player == Paper && computer == Rock) =
      Win
  | otherwise = Lose

-- じゃんけんゲームを実行
playJanken :: IO ()
playJanken = do
  IO.hSetEncoding IO.stdin IO.utf8
  IO.hSetEncoding IO.stdout IO.utf8

  putStrLn "じゃんけんをしましょう！"
  putStrLn "「グー」、「チョキ」、「パー」のいずれかを入力してください："

  input <- TIO.getLine
  case strToHand (T.unpack input) of
    Nothing -> do
      putStrLn "入力が正しくありません。「グー」、「チョキ」、「パー」のいずれかを入力してください。"
      playJanken
    Just playerHand -> do
      computerHand <- randomHand

      putStrLn $ "あなた: " ++ handToStr playerHand
      putStrLn $ "コンピュータ: " ++ handToStr computerHand

      let result = judgeJanken playerHand computerHand
      putStrLn $ resultToStr result

      when (result == Draw) $ do
        putStrLn "もう一度じゃんけんをしましょう！"
        playJanken

module Main (main) where

import Lib

main :: IO ()
main = playJanken

stack run

module LibUnitTest (unitTests) where

import Test.HUnit
import Lib

unitTests :: Test
unitTests = TestList
  [ "handToStr tests" ~: TestList
    [ "グー" ~: "グー" ~=? handToStr Rock
    , "チョキ" ~: "チョキ" ~=? handToStr Scissors
    , "パー" ~: "パー" ~=? handToStr Paper
    ]
  , "strToHand tests" ~: TestList
    [ "グー" ~: Just Rock ~=? strToHand "グー"
    , "チョキ" ~: Just Scissors ~=? strToHand "チョキ"
    , "パー" ~: Just Paper ~=? strToHand "パー"
    , "不正な入力" ~: Nothing ~=? strToHand "不正な入力"
    ]
  , "judgeJanken tests" ~: TestList
    [ "同じ手はあいこ" ~: Draw ~=? judgeJanken Rock Rock
    , "グーはチョキに勝つ" ~: Win ~=? judgeJanken Rock Scissors
    , "チョキはパーに勝つ" ~: Win ~=? judgeJanken Scissors Paper
    , "パーはグーに勝つ" ~: Win ~=? judgeJanken Paper Rock
    , "グーはパーに負ける" ~: Lose ~=? judgeJanken Rock Paper
    , "チョキはグーに負ける" ~: Lose ~=? judgeJanken Scissors Rock
    , "パーはチョキに負ける" ~: Lose ~=? judgeJanken Paper Scissors
    ]
  ]

module LibPropertyTest (main, prop_sameHandIsDraw, prop_strToHandInverse, prop_judgeJankenSymmetric) where

import Test.QuickCheck
import Lib

newtype TestHand = TestHand { unTestHand :: Hand }
  deriving (Show)

instance Arbitrary TestHand where
  arbitrary = TestHand <$> elements [Rock, Scissors, Paper]

-- 同じ手を出したら必ず引き分けになる
prop_sameHandIsDraw :: TestHand -> Bool
prop_sameHandIsDraw (TestHand h) = judgeJanken h h == Draw

-- strToHandとhandToStrは互いに逆関数
prop_strToHandInverse :: TestHand -> Bool
prop_strToHandInverse (TestHand h) = strToHand (handToStr h) == Just h

-- じゃんけんの判定は対称的
prop_judgeJankenSymmetric :: TestHand -> TestHand -> Bool
prop_judgeJankenSymmetric (TestHand h1) (TestHand h2) =
  case judgeJanken h1 h2 of
    Draw -> judgeJanken h2 h1 == Draw
    Win -> judgeJanken h2 h1 == Lose
    Lose -> judgeJanken h2 h1 == Win

main :: IO ()
main = do
  putStrLn "\nRunning QuickCheck tests..."
  quickCheck prop_sameHandIsDraw
  quickCheck prop_strToHandInverse
  quickCheck prop_judgeJankenSymmetric