Data commit

Task/Penneys-game/Haskell/penneys-game.hs

@@ -0,0 +1,91 @@
+import qualified Data.List as L
+import System.IO
+import System.Random
+
+data CoinToss = H | T deriving (Read, Show, Eq)
+
+parseToss :: String -> [CoinToss]
+parseToss [] = []
+parseToss (s:sx)
+  | s == 'h' || s == 'H' = H : parseToss sx
+  | s == 't' || s == 'T' = T : parseToss sx
+  | otherwise = parseToss sx
+
+notToss :: CoinToss -> CoinToss
+notToss H = T
+notToss T = H
+
+instance Random CoinToss where
+  random g = let (b, gb) = random g in (if b then H else T, gb)
+  randomR = undefined
+
+prompt :: (Read a) => String -> String -> (String -> Maybe a) -> IO a
+prompt msg err parse = do
+  putStrLn msg
+  line <- getLine
+  let ans = parse line
+  case ans of
+    Nothing   -> do
+      putStrLn err
+      prompt msg err parse
+    Just ansB -> return ansB
+
+showCat :: (Show a) => [a] -> String
+showCat = concatMap show
+
+data Winner = Player | CPU
+
+-- This may never terminate.
+runToss :: (RandomGen g) => [CoinToss] -> [CoinToss] -> g -> ([CoinToss], Winner)
+runToss player cpu gen =
+  let stream = randoms gen
+      run ss@(s:sx)
+        | L.isPrefixOf player ss = player
+        | L.isPrefixOf cpu ss    = cpu
+        | otherwise              = s : run sx
+      winner = run stream
+  in if L.isSuffixOf player winner
+     then (winner, Player)
+     else (winner, CPU)
+
+game :: (RandomGen g, Num a, Show a) => Bool -> a -> a -> g -> IO ()
+game cpuTurn playerScore cpuScore gen = do
+  putStrLn $ "\nThe current score is CPU: " ++ show cpuScore
+    ++ ", You: " ++ show playerScore
+
+  let (genA, genB) = split gen
+      promptPlayer check =
+        prompt "Pick 3 coin sides: " "Invalid input." $ \s ->
+          let tosses = parseToss s in
+          if check tosses then Just tosses else Nothing
+      promptCpu x  = putStrLn $ "I have chosen: " ++ showCat x
+
+  (tosses, winner) <-
+    if cpuTurn
+    then do
+      let cpuChoice = take 3 $ randoms gen
+      promptCpu cpuChoice
+      playerChoice <- promptPlayer $ \n -> n /= cpuChoice && 3 == length n
+      return $ runToss playerChoice cpuChoice genA
+    else do
+      playerChoice <- promptPlayer $ \n -> 3 == length n
+      let cpuChoice = case playerChoice of [a,b,_] -> [notToss b, a, b]
+      promptCpu cpuChoice
+      return $ runToss playerChoice cpuChoice genA
+
+  putStrLn $ "The sequence tossed was: " ++ showCat tosses
+
+  case winner of
+    Player -> do
+      putStrLn "You win!"
+      game (not cpuTurn) (playerScore + 1) cpuScore genB
+    CPU -> do
+      putStrLn "I win!"
+      game (not cpuTurn) playerScore (cpuScore + 1) genB
+
+main :: IO ()
+main = do
+  hSetBuffering stdin LineBuffering
+  stdgen <- getStdGen
+  let (cpuFirst, genA) = random stdgen
+  game cpuFirst 0 0 genA