-- We use a language extensions so we can put signatures in instance declarations.
{-# LANGUAGE InstanceSigs #-}
module LectureIOGame where
import Data.List (delete, minimumBy)
import Text.Read (readMaybe)

-- | Produce an IO () representing showing the (showable) state argument.
showState :: Show a => a -> IO ()
showState state = putStrLn ("The state of the game looks like: " ++ show state)

-- | Given a Bool indicating whether it is the player's move (or the computer's),
-- return a string suitable for prefixing onto a displayed move.
whoseMove :: Bool -> String
whoseMove True = "Your move: "
whoseMove False = "The computer player's move: "

-- | Produce an IO () representing showing the move string in a Move,
-- indicating whose move it is (based on the initial Bool argument, True
-- for the player's move and False for the computer's).
showMove :: Bool -> Move a -> IO ()
showMove yourMove (name,_) = putStrLn (whoseMove yourMove ++ name) >> putStrLn ""

-- | Use the given function to transform each element of the given list to
-- a String and produce an IO () representing showing all of those elements
-- on lines of their own, prefixed by their (1-based) number in the list.
showAll :: (a -> String) -> [a] -> IO ()
showAll showA as = helper 1 as 
  where helper _ [] = return ()
        helper n (a:as) = putStrLn (show n ++ ". " ++ showA a) >>
                          helper (n+1) as 

-- | Given a function to transform elements to Strings, a String prompt, 
-- and a list of elements, produce an IO (Maybe a) representing getting
-- the result of prompting the user to select one of the choices and the 
-- choice the user selected. On failure (e.g., because the user's 
-- response couldn't be matched with a choice, including for the empty 
-- list, where this will annoyingly prompt the user with no choices),
-- the Maybe a will be Nothing.
selectVal :: (a -> String) -> String -> [a] -> IO (Maybe a)
selectVal showA prompt as = putStrLn prompt >> putStrLn "" >>
                            showAll showA as >> putStrLn "" >>
                            putStrLn "Enter the number of the option you want on a line of its own." >>
                            getLine >>= processAnswer
    where -- processAnswer :: String -> IO (Maybe a)
          processAnswer answerStr = case readMaybe answerStr of
            Nothing -> putStrLn "Unable to process your answer." >> return Nothing
            Just n | n <= 0 || n > length as -> putStrLn "Your answer was out of range." >> return Nothing
                   | otherwise -> return (Just (as !! (n-1)))

-- | As with selectVal except this IO a represents repeatedly prompting
-- the user until they successfully select a value (which they never can
-- if the list is empty).
insistSelectVal :: (a -> String) -> String -> [a] -> IO a
insistSelectVal showA prompt as = selectVal showA prompt as >>= \maybeA ->
  case maybeA of
    Just a -> return a
    Nothing -> insistSelectVal showA prompt as


-- | Given a Bool representing if it's the player's turn (or the 
-- computer's) and the current game state, returns an IO (Move a)
-- representing the result of prompting for (if needed) and selecting
-- the next move. (On the computer's turn, this is side-effect free
-- but on the player's, it requires I/O.)
getMove :: GameState a => Bool -> a -> IO (Move a)
getMove False a = return (pickBestMove' a)
getMove True a = insistSelectVal fst "Your possible moves:" (nextGameStates a)

-- | Given a Bool indicating whose turn it is and a game state,
-- returns an IO () representing displaying the end game status
-- to the player. Win/loss/tie is determined by the result of
-- getGameState (where a Just 0 or Nothing result is taken to 
-- be a tie, a positive result a win for the current player, and
-- a negative result a loss for the current player).
showEndGame :: GameState a => Bool -> a -> IO ()
showEndGame yourMove state = putStrLn (message yourVal)
  where phasingVal = maybe 0 id (getGameStateValue state)
        yourVal = (if yourMove then 1 else (-1)) * phasingVal
        message n | n < 0 = "You lose."
                  | n == 0 = "It's a tie."
                  | otherwise = "You win"

-- | Returns an IO () representing playing one round of a game
-- beginning at the given game state and with the player moving
-- first if the Bool argument is True and the computer otherwise.
playRound :: (GameState a, Show a) => Bool -> a -> IO ()
playRound yourMove state = 
  showState state >>
  case getGameStateValue state of
    -- Not the game end:
    Nothing -> getMove yourMove state >>= \move -> 
       showMove yourMove move >>
       playRound (not yourMove) (snd move)

    -- Game over:
    _ -> showEndGame yourMove state

-- | Returns an IO () representing playing a game repeatedly
-- from the given initial state, with the player first if the
-- Bool argument is True and starting over with the other player
-- first each time the game ends and a new game begins. (Always
-- starts from the same initial state.) This continues for at
-- least one round and until the player chooses not to continue.
playGame :: (GameState a, Show a) => Bool -> a -> IO ()
playGame playerFirst initState = 
  undefined -- you know what would make a great exercise here?

type Move a = (String, a)

data GameTree a = GameTree a [GameTree a]
  deriving (Eq, Ord, Show, Read)

class GameState a where
  -- | Produces 1 for a win, -1 for a loss, 0 for a tie,
  -- and Nothing for a not-yet-complete game.
  getGameStateValue :: a -> Maybe Double 

  initGameState :: a

  -- | Produces a list of the next game states after the current one.
  -- If the game is complete, the list is empty.
  nextGameStates :: a -> [Move a]

constructGameTree :: GameState a => a -> GameTree a
constructGameTree state = 
  GameTree state (map (constructGameTree . snd) (nextGameStates state))

-- | Not actually key, but really fun:
gameTree :: GameState a => GameTree a
gameTree = constructGameTree initGameState

getGameTreeValue :: GameState a => GameTree a -> Double
getGameTreeValue (GameTree state []) =
  case getGameStateValue state of
    Just v  -> v
    Nothing -> 0
getGameTreeValue (GameTree _ nexts) =
  negate (minimum (map getGameTreeValue nexts))

pickBestMove :: GameState a => a -> Maybe (Move a)
pickBestMove state = case nextGameStates state of
  [] -> Nothing
  moves -> Just (argmin getMoveValue moves)
    where getMoveValue move = 
            getGameTreeValue (constructGameTree (snd move))

pickBestMove' :: GameState a => a -> Move a 
pickBestMove' state = 
  maybe undefined id (pickBestMove state)

-- | argmin f vals produces the value in vals for which f produces
-- the smallest result. vals MUST NOT BE EMPTY.
argmin :: Ord b => (a -> b) -> [a] -> a
argmin f as = fst minTuple
  where
    -- Get tuples of the as and their values computed by f 
    -- We put these in a variable so that Haskell will cache
    -- them for us (call f just once per value in as), since
    -- our f is potentially very expensive!
    tuples = zip as (map f as)

    -- Compare tuples by their f values
    compareSnds t1 t2 = compare (snd t1) (snd t2)

    -- Find the smallest tuple
    minTuple = minimumBy compareSnds tuples

-- | The state of the magic sum game, with the
-- list of available numbers to take, the list of
-- numbers I have taken, and the list of numbers
-- you have taken.
data MSState = MSState [Int] [Int] [Int]
  deriving (Eq, Ord, Read, Show)

-- | Produce all sublists of exactly the given length
allSubLists :: Int -> [a] -> [[a]]
allSubLists 0 _ = [[]]
allSubLists _ [] = []
allSubLists n (a:as)
  | n < 0 = []
  | otherwise = map (a:) (allSubLists (n-1) as) ++
                allSubLists n as

all3Lists :: [a] -> [[a]]
all3Lists = allSubLists 3

hasMSWin :: [Int] -> Bool
hasMSWin = not . null . filter (== 15) . map sum . all3Lists

isMSWin, isMSLoss, isMSTie :: MSState -> Bool 
isMSWin (MSState _ ns _) = hasMSWin ns
isMSLoss (MSState _ _ ns) = hasMSWin ns

isMSTie (MSState [] _ _) = True
isMSTie _ = False

getMSValue :: MSState -> Maybe Double
getMSValue ms | isMSWin ms = Just 1
              | isMSLoss ms = Just (-1)
              | isMSTie ms = Just 0
              | otherwise = Nothing

initMSState :: MSState 
initMSState = MSState [1..9] [] []

nextMSStates :: MSState -> [Move MSState]
nextMSStates (MSState pool me you) = 
  map (\choice -> ("Take " ++ show choice, MSState (delete choice pool) you (choice:me))) pool

getGTMSValue :: GameTree MSState -> Double
getGTMSValue (GameTree state []) =
  case getMSValue state of
    Just v  -> v
    Nothing -> 0
getGTMSValue (GameTree _ nexts) =
  negate (minimum (map getGTMSValue nexts))


instance GameState MSState where
  getGameStateValue :: MSState -> Maybe Double
  getGameStateValue = getMSValue

  initGameState :: MSState
  initGameState = initMSState

  nextGameStates :: MSState -> [Move MSState]
  nextGameStates = nextMSStates