I re-wrote a toy Java program in Haskell and messed with the style ... a lot.

LICENSE

Copyright 2014 Chas Leichner

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

    http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.

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 + "? ");
    }
}

RandomProblem1-desugared.hs

-- First Haskell version, nothing tricky, no syntactic sugar around monad
-- operations.
import Control.Monad
import Data.Char
import System.IO
import System.Random

-- >>  :: IO a -> IO b -> IO b
-- >>= :: IO a -> (a -> IO b) -> IO b
-- putStrLn :: String -> IO ()

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

      readLn >>= \response ->
      let (total, message) = if solution == response
          then (right + 1, "Correct!")
          else (right, unwords ["Sorry! the correct answer is:", show solution]) in
        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 =
  getStdGen >>= \gen ->
  gameLoop (randomRs (1, 100) gen) 0 0

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 (solution, opStr) = [(x + y, "+") , (x - y, "-")] !! (x `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

RandomProblem2-5.hs

-- Collected the game state into a Game record
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:_) = values gameState
    let (solution, opStr) = [(x + y, "+") , (x - y, "-")] !! (x `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]
    putStr $ 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 }

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 (solution, opStr) = [(x + y, "+") , (x - y, "-")] !! (x `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

RandomProblem3.hs

-- Made state passing implicit with StateT
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 (solution, opStr) = [(x + y, "+") , (x - y, "-")] !! (x `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']
    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 }

RandomProblem4-desugared.hs

-- Removed syntactic sugar around monad operations.
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 }

-- >>  :: StateT Game IO a -> StateT Game IO b -> StateT Game IO b
-- >>= :: StateT Game IO a -> (a -> StateT Game IO b) -> StateT Game IO b
-- liftIO :: IO a -> StateT Game IO a
-- liftIO . putStrLn :: String -> StateT Game IO ()

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

      (solution ==) <$> liftIO readLn >>= \correct ->
      modify (updateGame correct) >> get >>= \game ->
      (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 =
  randomRs (1,100) <$> getStdGen >>= \randomValues ->
  evalStateT gameLoop (Game randomValues 0 0)

RandomProblem4.hs

-- Factored message into a function, collapsed modification and state update
-- using >>
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 (solution, opStr) = [(x + y, "+"), (x - y, "-")] !! (x `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)

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 (solution, opStr) = [(x + y, "+") , (x - y, "-")] !! (x `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)

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 (solution, opStr) = [(x + y, "+") , (x - y, "-")] !! (x `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 soln _ = unwords ["Sorry! the correct answer is:", show soln]

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

RandomProblem7.hs

-- Added historical data for every problem asked to show flexibility of
-- StateT with 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 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 (solution, opStr) = [(x + y, "+") , (x - y, "-")] !! (x `mod` 2)
    flushPut $ unwords ["What is", show x, opStr, show 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 [])

RandomProblem8.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 (soln, opStr) = [(x + y, "+") , (x - y, "-")] !! (x `mod` 2)
      putStr (unwords ["What is", show x, opStr, show y, "? "]) >> hFlush stdout
      (total, message) <- ap ((.) . updateGame right) (==) soln <$> readLn
      putStrLn $ unwords [message, "\nYou have solved", show total, "out of", show (rounds + 1)]
      gameLoop total (rounds + 1) values)
  updateGame total _ True = (total + 1, "Correct!")
  updateGame total solution _ = (total, unwords ["Sorry! the correct answer is:", show solution])

RandomProblem9.hs

-- Used the `Safe` library to be more robust when given invalid input
{-# LANGUAGE TemplateHaskell #-}
import Control.Applicative
import Control.Lens hiding (op)
import Control.Monad
import Control.Monad.State
import Data.Char
import Safe
import System.IO
import System.Random

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

flushPut :: String -> StateT Game IO ()
flushPut = liftIO . (>> hFlush stdout) . putStr

getUserInput :: String -> StateT Game IO Int
getUserInput prompt = do
  flushPut prompt
  line <- liftIO getLine
  case readMay line of
    Just value -> return value
    Nothing -> do
      liftIO . putStrLn $ unwords ["Error:", show line, "is not a valid number"]
      getUserInput prompt

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 (solution, opStr) = [(x + y, "+") , (x - y, "-")] !! (x `mod` 2)
    correct <- liftM (solution ==) (getUserInput $ unwords
        ["What is", show x, opStr, show y ++ "? "])
    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
    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)