Morra.hs

{-# LANGUAGE ScopedTypeVariables #-}
module Main where
import System.IO
import System.Random
import Data.Char
import Text.Read
import Control.Monad.IO.Class
import Control.Monad
import Data.Maybe
import Control.Monad.Trans.State as S
import Control.Monad.Trans.State
import Data.Functor.Identity


data PlayerP = Odd String| Even String |Invalid deriving Show
type Player = PlayerP
type Computer = PlayerP

main :: IO ()
main = do
  hSetBuffering stdin NoBuffering
  sep
  putStrLn "Welcome to Morra!!!"
  putStr "Enter your name : "
  name <- getLine
  putStrLn "Press 1 for playing as odd, 2 for playing as even:"
  parInp <- getChar
  putStr "\n"
  sep
  let playerParity = case (subtract 48) . ord $ parInp of
                      1 -> Just $ Odd name
                      2 -> Just $ Even name
                      _ -> Nothing
  case playerParity of
            Nothing -> main
            Just p -> putStrLn (show p ++ "\n" ++ case p of
                                           Odd _ -> show $ Even "Computer"
                                           _ -> show $ Odd "Computer")
  (a:b:c:[]) <- replicateM 3 $ game (fromMaybe Invalid playerParity) name
  (pl, co) <- return (evalState (oneGame a b c) (0,0))
  case compare pl co of
    GT -> putStrLn $ "\n----------------" ++ name ++ " is the Winner!!!--------------------------"
    _ -> putStrLn "\n----------------Computer is the Winner!!!---------------------"
  return ()


game :: Player -> String -> IO Int
game pl name = do
  hSetBuffering stdin NoBuffering
  sep
  putStrLn "Choose 1 or 2 : "
  -- (plInp :: Int) <- readIO  =<< getLine
  plInpc <- getChar
  putStr "\n"
  let plInp = case (subtract 48) . ord $ plInpc of
                1 -> 1
                2 -> 2
                _ -> (-1)
  if (plInp == (-1))
  then do
    sep
    putStrLn "Invalid"
    main
    return 0
  else do
    sep
    putStrLn $ name ++ ": " ++ show plInp
    a <- shoot
    putStrLn $ "Computer : " ++ show a
    let win = case pl of
          Even s | even (plInp + a) -> disp s
                 | odd (plInp + a) -> disp "Computer"

          Odd  s | even (plInp + a) -> disp "Computer"
                 | odd (plInp + a) -> disp s
    sep
    win <- win
    case win of
      "Computer" -> return 2
      name -> return 1

shoot :: IO Int
shoot = randomRIO (1, 2)

disp :: String -> IO String
disp s = do
  putStrLn $ s ++ " wins this round!"
  return s

sep :: IO ()
sep = putStrLn "--------------------------------------------------------------"

type PScore = Int
type CScore = Int
type GameState = (PScore, CScore)

valFromGameState :: GameState -> (Int, Int)
valFromGameState = id

-- 1 for player's point, 2 for computer's point
nextGameState :: Int -> GameState -> GameState
nextGameState ind s = case ind of
                     1 -> (fst s + 1, snd s)
                     2 -> (fst s, snd s + 1)
                     _ -> s

type GameStateMonad = StateT GameState Identity

getNextGameState :: Int -> GameStateMonad (Int, Int)
getNextGameState ind = state $ \st -> let st' = nextGameState ind st in (valFromGameState st', st')

-- In this instance of the game, player scores two points and computer scores one point
oneGame :: Int -> Int -> Int -> GameStateMonad (Int, Int)
oneGame a b c = do
  x <- getNextGameState a
  y <- getNextGameState b
  return =<< getNextGameState c

-- main = do
--   -- Final state should be (2, 1)
--   print (evalState oneGame (0,0))