morra.hs

import Control.Monad
import Control.Monad.Trans
import Control.Monad.Trans.State
import Safe (readMay)
import System.Exit
import System.Random


-------------
--- Types ---
-------------

type Fingers = Integer
type Guesses = (Integer, Integer)

data Mode = OnePlayer | TwoPlayer deriving (Show, Eq)
data GameState = 
    GameState { getScoreP1 :: Integer
              , getScoreP2 :: Integer 
              , getMode :: Mode
              , getHistory :: [Integer]
              } deriving Show

---------------
--- Helpers ---
---------------

randomFingers :: IO Integer
randomFingers = randomRIO (1, 5)

randomGuess :: IO Integer
randomGuess = randomRIO (1, 10)

randomChoice :: [a] -> IO a
randomChoice xs = do
    index <- randomRIO (0, length xs - 1)
    return $ xs !! index

setMode :: IO Mode
setMode = do
    putStrLn "Enter 1 for 1 player or 2 for two player"
    mode <- getLine
    case mode of
        "1" -> return OnePlayer
        "2" -> return TwoPlayer
        otherwise -> putStrLn "Please enter a valid voice" >> setMode

setFingers :: IO Integer
setFingers = do
    integer <- getLine
    case readMay integer of
        Just i | 0 <= i, i <= 5 -> return i
        Just i -> putStrLn "Please enter a valid number" >> setInteger
        Nothing -> putStrLn "Please enter a valid number" >> setInteger

setInteger :: IO Integer
setInteger = do
    integer <- getLine
    case (readMay integer :: Maybe Integer) of
        (Just i) -> return i
        Nothing -> putStrLn "Please enter a valid number" >> setInteger

playerAction :: IO (Integer, Integer)
playerAction = do
    putStrLn "How many fingers?"
    fingers <- setFingers
    putStrLn "Make a guess"
    guess <- setInteger
    return (fingers, guess)

robotAction :: [Integer] -> IO (Integer, Integer)
robotAction history = do
    fingers <- randomFingers
    guess <- randomGuess
    let educatedGuesses = findEducatedGuesses history
    if educatedGuesses == []
    then return (fingers, guess)
    else do
        educatedGuess <- randomChoice educatedGuesses 
        return (fingers, educatedGuess + fingers)

updateHistory :: Integer -> [Integer] -> [Integer]
updateHistory x ys = (x:ys)

findEducatedGuesses :: [Integer] -> [Integer]
findEducatedGuesses xs =
    let pattern = take 2 xs
        seqs = subsequences (drop 2 xs)
        f subseq = if tail subseq == pattern then True else False
    in head <$> filter f seqs

subsequences :: [a] -> [[a]]
subsequences xs = if length xs < 3 then [] else (take 3 xs):(subsequences $ tail xs)

printGameResult :: Mode -> Integer -> Integer -> Integer -> IO ()
printGameResult mode fingers human robot = do
    putStrLn $ p1 ++ " Guesses: " ++ show human
    putStrLn $ p2 ++ " Guesses: " ++ show robot
    putStrLn $ "Fingers: " ++ show fingers
    where (p1, p2) = if mode == OnePlayer
                     then ("Hooman", "robot")
                     else ("Player 1", "Player 2")

checkGuesses :: GameState -> Integer -> Integer -> Integer -> IO GameState
checkGuesses (GameState p1Score p2Score mode history) fingers p1 p2 = do
    if p1 == fingers
    then printWinner p1Name >> return (GameState (p1Score+1) p2Score mode history)
    else if p2 == fingers
         then printWinner p2Name >> return (GameState p1Score (p2Score+1) mode history)
         else return (GameState p1Score p2Score mode history)
    where (p1Name, p2Name) = if mode == OnePlayer
                     then ("Hooman", "robot")
                     else ("Player 1", "Player 2")
          printWinner x = putStrLn $ show x ++ " won the round"

printScore :: Mode -> Integer -> Integer -> IO ()
printScore m p1Score p2Score =
    let (p1, p2) = if m == OnePlayer then ("Hooman", "Robot") else ("Player 1", "Player 2")
    in do
        putStrLn $ p1 ++ " Score: " ++ show p1Score
        putStrLn $ p2 ++ " Score: " ++ show p2Score

clearScreen :: IO ()
clearScreen = putStr "\ESC[2J"
    
------------
--- Main ---
------------

runGame :: GameState -> IO GameState
runGame state@(GameState _ _ mode history) = do
    (humanFingers, humanGuess) <- playerAction
    (robotFingers, robotGuess) <- robotAction history
    putStrLn "" 
    printGameResult mode (robotFingers + humanFingers) humanGuess robotGuess
    (GameState p1 p2 m h) <- checkGuesses state (robotFingers + humanFingers) humanGuess robotGuess
    putStrLn "" 
    return (GameState p1 p2 m (updateHistory humanFingers history))

runGameTwoPlayer :: GameState -> IO GameState
runGameTwoPlayer state@(GameState _ _ mode _) = do
    (p1Fingers, p1Guess) <- playerAction
    clearScreen
    (p2Fingers, p2Guess) <- playerAction
    clearScreen
    putStrLn "" 
    printGameResult mode (p1Fingers + p2Fingers) p1Guess p2Guess
    putStrLn "" 
    newState <- checkGuesses state (p1Fingers + p2Fingers) p1Guess p2Guess
    putStrLn "" 
    return newState

game :: StateT GameState IO ()
game = forever $ do
    human <- gets getScoreP1
    robot <- gets getScoreP2
    mode <- gets getMode
    let (p1, p2) = if mode == OnePlayer then ("Hooman Won", "Robot Won") else ("Player 1 Won", "Player 2 Won")
    liftIO $ printScore mode human robot
    case (human == 3, robot == 3) of
        (True, False) -> liftIO $ putStrLn p1 >> exitSuccess
        (False, True) -> liftIO $ putStrLn p2 >> exitSuccess
        otherwise -> do
                state <- get
                case mode of
                    OnePlayer -> (lift $ runGame state) >>= \newState -> put newState
                    TwoPlayer -> (lift $ runGameTwoPlayer state) >>= \newState -> put newState

start :: IO ()
start = do
    mode <- setMode
    runStateT game (GameState 0 0 mode [])
    return ()