Add remaining haskell book exercises

1 files changed, 69 insertions, 0 deletions

diff --git a/Haskell-book/26/Morra/app/Main.hs b/Haskell-book/26/Morra/app/Main.hs
new file mode 100644
index 0000000..0b0d28a
--- /dev/null
+++ b/Haskell-book/26/Morra/app/Main.hs
@@ -0,0 +1,69 @@
+module Main where
+
+import Control.Monad
+import Control.Monad.Trans.State
+import System.Random
+import System.Console.ANSI (clearScreen)
+
+type Score = StateT (Integer, Integer) IO (Integer, Integer)
+
+yourTurn :: IO (Integer, Integer)
+yourTurn = do
+    putStrLn "Wie viele Finger zeigen Sie?"
+    shown <- liftM read getLine
+
+    putStrLn "Wie viele Finger wird der Gegner zeigen?"
+    guessed <- liftM read getLine
+
+    clearScreen
+
+    return (shown, guessed)
+
+
+aiTurn :: IO (Integer, Integer)
+aiTurn = do
+    gen1 <- getStdGen
+
+    let (shown, gen2) = randomR (1, 5) gen1
+    putStrLn $ "Der Gegner zeigt: " ++ (show shown)
+
+    let (guessed, gen3) = randomR (1, 5) gen2
+    putStrLn $ "Der Gegner hat " ++ (show guessed) ++ " geraten."
+
+    setStdGen gen3
+    return (shown, guessed)
+
+
+score :: IO (Integer, Integer) -> Score
+score partnerTurn = StateT $ \(s1, s2) -> do
+    you <- yourTurn
+    partner <- partnerTurn
+    let sum = (fst you) + (snd partner)
+
+    let yourScore = if (snd you) == sum then 1 else 0
+    let partnerScore = if (snd partner) == sum then 1 else 0
+    return ((yourScore, partnerScore), (s1 + yourScore, s2 + partnerScore))
+
+
+loopGame :: IO (Integer, Integer)
+         -> (Integer, Integer)
+         -> IO (Either (Integer, Integer) (Integer, Integer))
+loopGame partnerTurn currentScore = do
+    (result, s) <- runStateT (score partnerTurn) currentScore
+    putStrLn $ show $ result
+
+    case s of
+      (16, _) -> return $ Left result
+      (_, 16) -> return $ Right result
+      _       -> loopGame partnerTurn s
+
+
+main :: IO ()
+main = do
+    winner <- loopGame aiTurn (0, 0)
+
+    case winner of
+      Left x ->  putStrLn $ "You've won! Score: " ++ (show x)
+      Right x -> putStrLn $ "You've lost! Score: " ++ (show x)
+
+    return ()