Game.hs http://reduction.io/essays/rosetta-haskell.html

Game.hs

{-# LANGUAGE TemplateHaskell #-}
module Main where

import Control.Applicative
import Control.Lens hiding (op)
import Control.Monad
import Control.Monad.State
import Data.Char
import System.IO
import System.Random

data Game = Game { _values :: [Int], _right :: Int, _rounds :: Int }
makeLenses ''Game

gameLoop :: StateT Game IO ()
gameLoop = do
  flushPut "Would you like to play? y/n: "
  keepPlaying <- ("y" ==) . map toLower <$> liftIO getLine
  when keepPlaying $ do
    (x:y:r:_) <- values <<%= drop 3
    numRounds <- rounds <+= 1

    let (solution, opStr) = [(x + y, "+"), (x - y, "-")] !! (r `mod` 2)
    flushPut $ unwords ["What is", show x, opStr, show y, "? "]
    correct <- (solution ==) <$> liftIO readLn
    numRight <- right <+= if correct then 1 else 0

    liftIO . putStrLn $
      unwords [message solution correct,
               "\nYou have solved", show numRight, "out of", show numRounds]
    gameLoop
  where
    flushPut = liftIO . (>> hFlush stdout) . putStr
    message _ True = "Correct!"
    message solution _ = unwords ["Sorry! the correct answer is:", show solution]

main :: IO ()
main = do
  randomValues <- randomRs (1, 100) <$> getStdGen
  evalStateT gameLoop (Game randomValues 0 0)

{-
import Control.Applicative
import Control.Lens hiding (op)
import Control.Monad
import Control.Monad.State
import Data.Char
import System.IO
import System.Random

data Game = Game { _values :: [Int], _right :: Int, _rounds :: Int }
makeLenses ''Game

updateGame :: Bool -> Game -> Game
updateGame correct =
  (values %~ drop 3) .
  (rounds +~ 1) .
  (right +~ if correct then 1 else 0)

gameLoop :: StateT Game IO ()
gameLoop = do
  flushPut "Would you like to play? y/n: "
  keepPlaying <- ("y" ==) . map toLower <$> liftIO getLine
  when keepPlaying $ do
    (x:y:r:_) <- use values
    let (solution, opStr) = [(x + y, "+"), (x - y, "-")] !! (r `mod` 2)
    flushPut $ unwords ["What is", show x, opStr, show y, "? "]

    correct <- (solution ==) <$> liftIO readLn
    game <- modify (updateGame correct) >> get
    liftIO . putStrLn $
      unwords [message solution correct,
               "\nYou have solved", show $ game ^. right, "out of", show $ game ^. rounds]
    gameLoop
  where
    flushPut = liftIO . (>> hFlush stdout) . putStr
    message _ True = "Correct!"
    message solution _ = unwords ["Sorry! the correct answer is:", show solution]

main :: IO ()
main = do
  randomValues <- randomRs (1, 100) <$> getStdGen
  evalStateT gameLoop (Game randomValues 0 0)
-}

{-
import Control.Applicative
import Control.Monad
import Control.Monad.State
import Data.Char
import System.IO
import System.Random

data Game = Game { values :: [Int], right :: Int, rounds :: Int }

updateGame :: Bool -> Game -> Game
updateGame correct Game { values = (_:_:_:remaining)
                        , right = score
                        , rounds = total } =
  Game { values = remaining
       , right = if correct then score + 1 else score
       , rounds = total + 1 }

gameLoop :: StateT Game IO ()
gameLoop = do
  flushPut "Would you like to play? y/n: "
  keepPlaying <- ("y" ==) . map toLower <$> liftIO getLine
  when keepPlaying $ do
    (x:y:r:_) <- gets values
    let (solution, opStr) = [(x + y, "+"), (x - y, "-")] !! (r `mod` 2)
    flushPut $ unwords ["What is", show x, opStr, show y, "? "]

    correct <- (solution ==) <$> liftIO readLn
    game <- modify (updateGame correct) >> get
    liftIO . putStrLn $
      unwords [message solution correct,
               "\nYou have solved", show $ right game, "out of", show $ rounds game]
    gameLoop
  where
    flushPut = liftIO . (>> hFlush stdout) . putStr
    message _ True = "Correct!"
    message solution _ = unwords ["Sorry! the correct answer is:", show solution]

main :: IO ()
main = do
  randomValues <- randomRs (1, 100) <$> getStdGen
  evalStateT gameLoop (Game randomValues 0 0)
-}

{-
import Control.Applicative
import Control.Monad
import Control.Monad.State
import Data.Char
import System.IO
import System.Random

data Game = Game { values :: [Int], right :: Int, rounds :: Int }

updateGame :: Bool -> Game -> Game
updateGame correct Game { values = (_:_:_:remaining)
                        , right = score
                        , rounds = total } =
  Game { values = remaining
       , right = if correct then score + 1 else score
       , rounds = total + 1 }

gameLoop :: StateT Game IO ()
gameLoop = do
  flushPut "Would you like to play? y/n: "
  keepPlaying <- ("y" ==) . map toLower <$> liftIO getLine
  when keepPlaying $ do
    (x:y:r:_) <- gets values
    let (solution, opStr) = [(x + y, "+"), (x - y, "-")] !! (r `mod` 2)
    flushPut $ unwords ["What is", show x, opStr, show y, "? "]

    correct <- (solution ==) <$> liftIO readLn
    modify (updateGame correct)
    gameState' <- get
    liftIO . putStrLn $ if correct
          then "Correct!"
          else unwords ["Sorry! the correct answer is:", show solution]
    liftIO . putStrLn $ unwords
      [ "You have solved"
      , show $ right gameState', "out of"
      , show $ rounds gameState', "\n"
      ]
    gameLoop
  where
    flushPut = liftIO . (>> hFlush stdout) . putStr

main :: IO ()
main = do
  randomValues <- randomRs (1, 100) <$> getStdGen
  evalStateT gameLoop (Game randomValues 0 0)
-}

{-
import Control.Applicative
import Control.Monad
import Data.Char
import System.IO
import System.Random

data Game = Game { values :: [Int], right :: Int, rounds :: Int }

updateGame :: Bool -> Game -> Game
updateGame correct Game { values = (_:_:_:remaining)
                        , right = score
                        , rounds = total } =
  Game { values = remaining
       , right = if correct then score + 1 else score
       , rounds = total + 1 }

gameLoop :: Game -> IO ()
gameLoop gameState = do
  flushPut "Would you like to play? y/n: "
  keepPlaying <- ("y" ==) . map toLower <$> getLine
  when keepPlaying $ do
    let (x:y:r:_) = values gameState
    let (solution, opStr) = [(x + y, "+"), (x - y, "-")] !! (r `mod` 2)
    flushPut $ unwords ["What is", show x, opStr, show y, "? "]

    correct <- (solution ==) <$> readLn
    let gameState' = updateGame correct gameState
    putStrLn $ if correct
          then "Correct!"
          else unwords ["Sorry! the correct answer is:", show solution]
    putStrLn $ unwords
      [ "You have solved"
      , show $ right gameState', "out of"
      , show $ rounds gameState', "\n"
      ]
    gameLoop gameState'
  where
    flushPut = (>> hFlush stdout) . putStr

main :: IO ()
main = do
  randomValues <- randomRs (1, 100) <$> getStdGen
  gameLoop Game { values = randomValues, right = 0, rounds = 0 }
-}

{-
gameLoop :: [Int] -> Int -> Int -> IO ()
gameLoop (x:y:r:values) right rounds = do
  flushPut "Would you like to play? y/n: "
  keepPlaying <- ("y" ==) . map toLower <$> getLine
  when keepPlaying $ do
    let (solution, opStr) = [(x + y, "+"), (x - y, "-")] !! (r `mod` 2)
    flushPut $ unwords ["What is", show x, opStr, show y, "? "]

    correct <- (solution ==) <$> readLn
    let (total, message) = if correct
          then (right + 1, "Correct!")
          else (right, unwords ["Sorry! the correct answer is:", show solution])
    putStrLn $ unwords
      [message, "\nYou have solved", show total, "out of", show (rounds + 1)]
    gameLoop values total (rounds + 1)
  where
    flushPut = (>> hFlush stdout) . putStr

main :: IO ()
main = do
  randomValues <- randomRs (1, 100) <$> getStdGen
  gameLoop randomValues 0 0
-}

{-
gameLoop :: [Int] -> Int -> Int -> IO ()
gameLoop (x:y:r:values) right rounds = do
  flushPut "Would you like to play? y/n: "
  keepPlaying <- getLine
  when (map toLower keepPlaying == "y") $ do
    let (solution, opStr) = [(x + y, "+"), (x - y, "-")] !! (r `mod` 2)
    flushPut $ unwords ["What is", show x, opStr, show y, "? "]

    response <- readLn
    let (total, message) = if solution == response
          then (right + 1, "Correct!")
          else (right, unwords ["Sorry! the correct answer is:", show solution])
    putStrLn $ unwords
      [message, "\nYou have solved", show total, "out of", show (rounds + 1)]
    gameLoop values total (rounds + 1)
  where
    flushPut s = putStr s >> hFlush stdout

main :: IO ()
main = do
  gen <- getStdGen
  gameLoop (randomRs (1, 100) gen) 0 0
-}