Skip to content

Instantly share code, notes, and snippets.

@programatt
Created January 8, 2014 05:10
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save programatt/8312120 to your computer and use it in GitHub Desktop.
Save programatt/8312120 to your computer and use it in GitHub Desktop.
rock paper scissors in haskell using StateT
import System.Random
import Control.Monad.State
data Hand = Rock | Scissors | Paper deriving(Show,Eq)
data Result = Win | Lose | Tie deriving(Show)
type Score = (Int,Int)
fight :: Hand -> Hand -> Result
fight h1 h2 | h1 == h2 = Tie
| h1 == Rock && h2 == Scissors = Win
| h1 == Paper && h2 == Rock = Win
| h1 == Scissors && h2 == Paper = Win
| otherwise = Lose
updateScore :: Result -> StateT Score IO Result
updateScore r = do
(h,c) <- get
case r of
Win -> put (h+1,c)
Lose -> put (h,c+1)
Tie -> put (h,c)
return r
playR :: StateT Score IO ()
playR = do
liftIO $ putStrLn "(r)ock, (p)aper, or (s)cissors"
r <- liftIO $ liftM2 fight getHand genHand
liftIO $ print r
updateScore r
s <- get
liftIO $ putStrLn ((show . fst) s ++ " - " ++ (show . snd )s)
if isGameOver s then endGame s else playR
endGame :: Score -> StateT Score IO ()
endGame (3,_) = io $ putStrLn "You Win!"
endGame (_,3) = io $ putStrLn "Sorry You Lost"
isGameOver :: Score -> Bool
isGameOver (x,y) = x == 3 || y == 3
io :: IO a -> StateT Score IO a
io = liftIO
genHand :: IO Hand
genHand = fmap rps rand
where rps 1 = Rock
rps 2 = Paper
rps _ = Scissors
rand = randomRIO (1,3) :: IO Int
getHand :: IO Hand
getHand = fmap rps getLine
where rps "r" = Rock
rps "p" = Paper
rps "s" = Scissors
rps _ = error "invalid choice"
main :: IO ()
main = void $ runStateT playR (0,0)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment