Skip to content

Instantly share code, notes, and snippets.

@cleichner

cleichner/LICENSE

Last active December 20, 2015 06:29
Show Gist options

  • Select an option

    Learn more about clone URLs
  • Save cleichner/6086604 to your computer and use it in GitHub Desktop.

Select an option

Learn more about clone URLs
Save cleichner/6086604 to your computer and use it in GitHub Desktop.
Download ZIP
I re-wrote a toy Java program in Haskell and messed with the style ... a lot.
Raw
RandomProblem.java
// Java code that started it all
import java.util.Random;
import java.util.Scanner;
public class RandomProblem {
public static void main(String[] args) {
int right = 0;
int rounds = 0;
Scanner keyboard = new Scanner(System.in);
Random rand = new Random();
while (keepPlaying(keyboard)) {
int x = rand.nextInt(100) + 1;
int y = rand.nextInt(100) + 1;
int solution = 0;
if (rand.nextBoolean()) {
solution = x + y;
printQuestion(x, '+', y);
} else {
solution = x - y;
printQuestion(x, '-', y);
}
rounds++;
if (solution == keyboard.nextInt()) {
System.out.println("Correct!");
right++;
} else {
System.out.println("Sorry! the correct answer is: " + solution);
}
System.out.println("You have solved " + right + " out of " +
rounds + " problems correctly.");
}
}
public static boolean keepPlaying(Scanner keyboard) {
System.out.print("Would you like to play? y/n: ");
return keyboard.next().toLowerCase().equals("y");
}
public static void printQuestion(int x, char op, int y) {
System.out.print("What is " + x + " " + op + " " + y + "? ");
}
}
Raw
RandomProblem1.hs
-- First Haskell version, nothing tricky
import Control.Monad
import Data.Char
import System.IO
import System.Random
gameLoop :: [Int] -> Int -> Int -> IO ()
gameLoop (x:y:values) right rounds = do
flushPut "Would you like to play? y/n: "
keepPlaying <- getLine
when (map toLower keepPlaying == "y") $ do
let (op, opStr) = [((+), "+") , ((-), "-")] !! (x `mod` 2)
flushPut $ unwords ["What is", show x, opStr, show y, "? "]
let solution = x `op` y
response <- readLn
let (total, message) = if solution == response
then (right + 1, "Correct!")
else (right, unwords ["Sorry! the correct answer is:", show solution])
putStr $ unwords
[message, "\nYou have solved", show total, "out of", show (rounds + 1), "\n"]
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
Raw
RandomProblem2.hs
-- Introduced applicative and pointfree style
import Control.Applicative
import Control.Monad
import Data.Char
import System.IO
import System.Random
gameLoop :: [Int] -> Int -> Int -> IO ()
gameLoop (x:y:values) right rounds = do
flushPut "Would you like to play? y/n: "
keepPlaying <- ("y" ==) . map toLower <$> getLine
when keepPlaying $ do
let (op, opStr) = [((+), "+") , ((-), "-")] !! (x `mod` 2)
flushPut $ unwords ["What is", show x, opStr, show y, "? "]
let solution = x `op` y
correct <- (solution ==) <$> liftIO readLn
let (total, message) = if correct
then (right + 1, "Correct!")
else (right, unwords ["Sorry! the correct answer is:", show solution])
putStr $ unwords
[message, "\nYou have solved", show total, "out of", show (rounds + 1), "\n"]
gameLoop values total (rounds + 1)
where
flushPut = (>> hFlush stdout) . putStr
main :: IO ()
main = do
randomValues <- randomRs (1,100) <$> getStdGen
gameLoop randomValues 0 0
Raw
RandomProblem3.hs
-- Made state-passing explicit with StateT and record
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:_) <- gets values
let (op, opStr) = [((+), "+") , ((-), "-")] !! (x `mod` 2)
flushPut $ unwords ["What is", show x, opStr, show y, "? "]
let solution = x `op` y
correct <- (solution ==) <$> liftIO readLn
game <- modify (updateGame correct) >> get
liftIO . putStrLn $ if solution == response
then "Correct!"
else unwords ["Sorry! the correct answer is:", show solution]
liftIO . putStr $ unwords
["You have solved", show $ right game, "out of", show $ rounds game, "\n"]
gameLoop
where
flushPut = liftIO . (>> hFlush stdout) . putStr
main :: IO ()
main = do
randomValues <- randomRs (1,100) <$> getStdGen
evalStateT gameLoop Game { values = randomValues, right = 0, rounds = 0 }
Raw
RandomProblem4.hs
-- Factored message into a function
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
, rounds = total + 1
, right = if correct then score + 1 else score }
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:_) <- gets values
let (op, opStr) = [((+),"+"), ((-),"-")] !! (x `mod` 2)
flushPut $ unwords ["What is", show x, opStr, show y, "? "]
let solution = x `op` 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)
Raw
RandomProblem5.hs
-- Introduced Control.Lens
{-# LANGUAGE TemplateHaskell #-}
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 2) .
(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:_) <- use values
let (op, opStr) = [((+),"+"), ((-),"-")] !! (x `mod` 2)
flushPut $ unwords ["What is", show x, opStr, show y, "? "]
let solution = x `op` 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)
Raw
RandomProblem6.hs
-- Integrated updateGame into gameLoop using state update operators.
{-# LANGUAGE TemplateHaskell #-}
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:_) <- values <<%= drop 2
numRounds <- rounds <+= 1
let (op, opStr) = [((+), "+") , ((-), "-")] !! (x `mod` 2)
flushPut $ unwords ["What is", show x, opStr, show y, "? "]
let solution = x `op` 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 soln _ = unwords ["Sorry! the correct answer is:", show soln]
main :: IO ()
main = do
randomValues <- randomRs (1,100) <$> getStdGen
evalStateT gameLoop (Game randomValues 0 0)
Raw
RandomProblem7.hs
-- Went golfing. Applied all of the above refactorings, but only to shrink code.
import Control.Applicative
import Control.Monad
import Data.Char
import System.IO
import System.Random
main :: IO ()
main = getStdGen >>= gameLoop 0 0 . randomRs (1, 100) where
gameLoop right rounds (x:y:values) = do
putStr "Would you like to play? y/n: " >> hFlush stdout
("y" ==) . map toLower <$> getLine >>= flip when (do
let (op, opStr) = [((+), "+") , ((-), "-")] !! (x `mod` 2)
putStr (unwords ["What is", show x, opStr, show y, "? "]) >> hFlush stdout
(total, message) <- ap ((.) . updateGame right) (==) (x `op` y) <$> readLn
putStr $ unwords [message, "\nYou have solved", show total, "out of", show (rounds + 1), "\n"]
gameLoop total (rounds + 1) values)
updateGame total _ True = (total + 1, "Correct!")
updateGame total solution _ = (total, unwords ["Sorry! the correct answer is:", show solution])
Raw
RandomProblem8.hs
-- Added historical data for every problem asked.
{-# LANGUAGE TemplateHaskell #-}
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 History = History { _lhs :: Int, _rhs :: Int, _operator :: String,
_correct :: Bool} deriving (Show)
makeLenses ''History
data Game = Game { _values :: [Int], _right :: Int, _rounds :: Int,
_history :: [History] }
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:_) <- values <<%= drop 2
numRounds <- rounds <+= 1
let (op, opStr) = [((+), "+") , ((-), "-")] !! (x `mod` 2)
flushPut $ unwords ["What is", show x, opStr, show y, "? "]
let solution = x `op` y
correctSolution <- (solution ==) <$> liftIO readLn
past <- history <%= (History x y opStr correctSolution :)
numRight <- right <+= if correctSolution then 1 else 0
liftIO . putStrLn $ unwords [message solution correctSolution,
"\nYou have solved", show numRight, "out of", show numRounds,
show (past ^.. traverse.correct)]
gameLoop
where
flushPut = liftIO . (>> hFlush stdout) . putStr
message _ True = "Correct!"
message soln _ = unwords ["Sorry! the correct answer is:", show soln]
main :: IO ()
main = do
randomValues <- randomRs (1,100) <$> getStdGen
evalStateT gameLoop (Game randomValues 0 0 [])
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment