Skip to content

Instantly share code, notes, and snippets.

@MgaMPKAy
Last active August 29, 2015 13:57
Show Gist options
  • Save MgaMPKAy/9908241 to your computer and use it in GitHub Desktop.
Save MgaMPKAy/9908241 to your computer and use it in GitHub Desktop.
{-# LANGUAGE RecordWildCards #-}
-- 1. Without lenses (and state monad), even a simple flat record becomes clumsy
import System.Random
import System.IO
import Control.Applicative ((<$>))
import Control.Monad (when)
import Text.Read (readMaybe)
import Data.Char (toLower)
data Op = Plus | Minus
instance Show Op where
show Plus = "+"
show Minus = "-"
data Game = Game { xs :: [Int]
, ys :: [Int]
, ops :: [Op]
, correct :: Int
, rounds :: Int
, solutions :: [Int] -- ^ Pre-generated solutions
}
main :: IO ()
main = initGame >>= gameLoop
initGame = do
gen <- getStdGen
let (g1, g2) = split gen
(g3, g4) = split g1
let ops = (\b -> if b then Plus else Minus) <$> randoms g2
ops' = (\b -> if b then (+) else (-)) <$> randoms g2
xs = randomRs (0, 10) g3 :: [Int]
ys = randomRs (0, 10) g4 :: [Int]
solutions = zipWith (uncurry) ops' (zip xs ys)
let correct = 0; rounds = 0
return Game{..}
gameLoop g@(Game{..}) = do
continute <- keepPlaying
when continute $ do
putStrLn $ unwords ["What is ", show (head xs), show (head ops), show (head ys), "? "]
ans <- getAnswer
let (new_correct, message) =
if ans == head solutions
then (correct + 1, "Correct!")
else (correct, unwords ["Sorry! the correct answer is:", show (head solutions)])
putStr $ unwords
[message, "\nYou have solved", show new_correct, "out of", show (rounds + 1), "\n"]
gameLoop $ Game { xs = tail xs
, ys = tail ys
, ops = tail ops
, rounds = rounds + 1
, correct = new_correct
, solutions = tail solutions
}
where
keepPlaying :: IO Bool
keepPlaying = do
flushPut "Would you like to play? y/n: "
getLine >>= return . (== "y") . map toLower
getAnswer :: IO Int
getAnswer = do
line <- getLine
case readMaybe line of
Nothing -> do
flushPut $ unwords ["Error:", line, "is not a valid number", "\n"]
getAnswer
Just x -> return x
flushPut s = putStr s >> hFlush stdout
import System.Random
import System.IO
import Control.Applicative ((<$>))
import Control.Monad (when)
import Text.Read (readMaybe)
import Data.Char (toLower)
data Op = Plus | Minus
main :: IO ()
main = do
(ops, xs, ys) <- initGame
gameLoop ops xs ys 0 0
instance Show Op where
show Plus = "+"
show Minus = "-"
toFunc Plus = (+)
toFunc Minus = (-)
initGame = do
gen <- getStdGen
let (g1, g2) = split gen
(g3, g4) = split g1
let ops = (\b -> if b then Plus else Minus) <$> randoms g2
xs = randomRs (0, 10) g3
ys = randomRs (0, 10) g4
return (ops, xs, ys)
gameLoop (op:ops) (x:xs) (y:ys) correct rounds = do
continute <- keepPlaying
let solution = toFunc op x y
when continute $ do
putStrLn $ unwords ["What is ", show x, show op, show y, "? "]
ans <- getAnswer
let (new_correct, message) =
if ans == solution
then (correct + 1, "Correct!")
else (correct, unwords ["Sorry! the correct answer is:", show solution])
putStr $ unwords
[message, "\nYou have solved", show new_correct, "out of", show (rounds + 1), "\n"]
gameLoop ops xs ys new_correct (rounds + 1)
where
keepPlaying = do
flushPut "Would you like to play? y/n: "
getLine >>= return . (== "y") . map toLower
getAnswer = do
line <- getLine
case readMaybe line of
Nothing -> do
flushPut $ unwords ["Error:", line, "is not a valid number", "\n"]
getAnswer
Just x -> return x
flushPut s = putStr s >> hFlush stdout
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment