{-# LANGUAGE GADTs                     #-}
{-# LANGUAGE FlexibleContexts          #-}
{-# LANGUAGE RankNTypes                #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

module Waterdeep.Logic
   ( newGame
   , waterdeepGame
   ) where

import Control.Applicative
import Control.Arrow ((&&&))
import Control.Lens
import Control.Monad
import Control.Monad.Random
import Control.Monad.State
import Data.List
import Data.Maybe
import Data.Monoid
import System.Random.Shuffle
import Text.Printf
import Waterdeep.Types
import Waterdeep.Monad

import qualified Data.IntMap as IM
import qualified Data.Map    as M

newGame :: [(String,Faction,Lord)]
        -> [Quest]
        -> [IntrigueCard]
        -> [Building]
        -> StdGen
        -> WaterdeepState
newGame players quests intrigues buildings rndgen
   | length players < 2 || length players > 5 =
      error "This game requires 2-5 players."
   | otherwise =
      WaterdeepState
         { _gamePlayers           = IM.fromAscList playerStates
         , _gameFirstPlayer       = 1
         , _gameCurrentRound      = 0
         , _gameCurrentPlayer     = noPlayerID
         , _gameConsecutivePasses = 0
         , _gameQuestDeck         = []
         , _gameQuestDiscard      = quests
         , _gameCliffwatchInn     = []
         , _gameIntrigueDeck      = []
         , _gameIntrigueDiscard   = intrigues
         , _gameBuildingDeck      = []
         , _gameBuildingDiscard   = buildings
         , _gameBasicBuildings    = map (newBuildingState noPlayerID) basicBuildings
         , _gameBuildersHall      = []
         , _gameAdvancedBuildings = []
         , _gameWaterdeepHarbor   = ([], [], [])
         , _gameStdGen            = rndgen
         }
   where
      playerStates = [ (i, newPlayerState i p) | (i, p) <- zip [1..] players ]

newPlayerState :: PlayerID -> (String, Faction, Lord) -> PlayerState
newPlayerState i (name, faction, lord) =
   PlayerState
      { _playerNumber           = i
      , _playerName             = name
      , _playerFaction          = faction
      , _playerLord             = lord
      , _playerScore            = 0
      , _playerTavern           = M.empty
      , _playerIncompleteQuests = []
      , _playerCompletedQuests  = []
      , _playerActivePlotQuests = []
      , _playerUsedPlotQuests   = []
      , _playerIntrigueCards    = []
      , _playerAgentsInPool     = 0
      , _playerHasLieutenant    = False
      , _playerHasAmbassador    = False
      }

newBuildingState :: PlayerID -> Building -> BuildingState
newBuildingState p b =
   BuildingState
      { _building             = b
      , _buildingOwner        = p
      , _buildingAgents       = []
      , _buildingAccumulation = 0
      }

basicBuildings :: [Building]
basicBuildings = []

waterdeepGame :: Waterdeep [PlayerID]
waterdeepGame = do
   ps <- sort . IM.keys <$> use gamePlayers
   restockBuildersHall
   restockCliffwatchInn
   forM_ ps $ \p -> do
      replicateM_ 2 $ performAction p DrawQuest
      replicateM_ 2 $ performAction p DrawIntrigue
      replicateM_ (3 + p) $ performAction p $ TakeResource [Gold]
   forM_ [1..8] $ \round -> do
      beginRound round
      fix $ \loop -> do
         p <- use gameCurrentPlayer
         success <- filterChoices $ performAction p AssignAgent
         case success of
            True -> do
               filterChoices $ performAction p CompleteQuest
               gameCurrentPlayer .= (p `mod` length ps) + 1
               gameConsecutivePasses .= 0
               loop
            False -> do
               passes <- gameConsecutivePasses <+= 1
               when (passes < length ps) loop
      performAction 1 $ TakeResource [Cleric, Fighter, Rogue, Wizard, Gold]
      filterChoices $ performAction 1 $
            ReturnResource [Wizard]
         <> ReturnResource [Cleric, Fighter, Gold]
         <> ReturnResource [Cleric, Fighter]
         <> (ReturnResource [Cleric] `OrElse` TakeResource [Cleric])
      -- performAction 2 $ ChooseQuest
   scoreFinalPoints
   notifyState
   determineWinners

beginRound :: Int -> Waterdeep ()
beginRound round = do
   gameCurrentRound .= round
   gameCurrentPlayer <~ use gameFirstPlayer
   gameBasicBuildings . traverse . buildingAgents .= []
   gameAdvancedBuildings . traverse . buildingAgents .= []
   gameBuildersHall . traverse . buildingAgents .= []
   gameBuildersHall . traverse . buildingAccumulation += 1
   players <- IM.size <$> use gamePlayers
   forM_ [1..players] $ \p -> do
      qs <- gamePlayer p . playerUsedPlotQuests <<.= []
      gamePlayer p . playerActivePlotQuests %= (++ qs)
      gamePlayer p . playerAgentsInPool .= initialAgents players round
   notifyState
   return ()

initialAgents :: Int -> Int -> Int
initialAgents players round =
   if round >= 5 then startingAgents + 1 else startingAgents
   where startingAgents = 6 - players

data ContWD a where
   Done :: (a, WaterdeepState) -> ContWD a
   Cont :: WaterdeepPrompt b -> (b -> ContWD a) -> ContWD a

-- |Permit only choices which lead to a True result.
-- Returns False if and only if no such choice exists.
-- If result is False, state remains unchanged.
filterChoices :: Waterdeep Bool -> Waterdeep Bool
filterChoices m = do
   mw' <- filteredChoice [] =<< (runWaterdeepC Done Cont m <$> get)
   case mw' of
      Just (ps,w') -> forM_ ps forwardPrompt >> put w' >> return True
      Nothing      -> return False
   where
      tryChoice :: ContWD Bool -> Bool
      tryChoice (Done a) = fst a
      tryChoice (Cont (NotifyState w) cont) = tryChoice $ cont ()
      tryChoice (Cont (Broadcast s)   cont) = tryChoice $ cont ()
      tryChoice (Cont (SolicitChoice p t cs) cont) =
         or $ map (tryChoice . cont . snd) cs
      filteredChoice :: [WaterdeepPrompt ()] -> ContWD Bool
                     -> Waterdeep (Maybe ([WaterdeepPrompt ()], WaterdeepState))
      filteredChoice ps (Done (a,w)) = if a then return (Just (ps,w)) else return Nothing
      filteredChoice ps (Cont p@(NotifyState w) cont) = filteredChoice (ps++[p]) $ cont ()
      filteredChoice ps (Cont p@(Broadcast s)   cont) = filteredChoice (ps++[p]) $ cont ()
      filteredChoice ps (Cont (SolicitChoice p t cs) cont) = do
         let cs' = filter (tryChoice . cont . snd) cs
         if null cs'
            then return Nothing
            else do
               forM_ ps forwardPrompt
               filteredChoice [] =<< (cont <$> solicitChoice p t cs')
      forwardPrompt :: WaterdeepPrompt () -> Waterdeep ()
      forwardPrompt (NotifyState w) = get >>= \w0 -> put w >> notifyState >> put w0
      forwardPrompt (Broadcast s)   = broadcast' s

performAction :: PlayerID -> GameAction -> Waterdeep Bool
performAction p a = do
   name <- use $ gamePlayer p . playerName
   case a of
      NoAction -> return True
      ScorePoints n -> do
         gamePlayer p . playerScore += n
         broadcast $ name ++ " scored " ++ show n ++ "points."
         return True
      TakeResource rs -> do
         r <- solicitChoice p "Take one item:" $ map (show &&& id) rs
         gamePlayer p . playerTavern %= flip (M.unionWith (+)) (M.fromList [(r, 1)])
         broadcast $ name ++ " received one " ++ show r ++ "."
         return True
      ReturnResource rs -> do
         tavern <- use $ gamePlayer p . playerTavern
         let rs' = filter ((> 0) . maybe 0 id . flip M.lookup tavern) rs
         if null rs'
            then return False
            else do
               r <- solicitChoice p "Return one item:" $ map (show &&& id) rs'
               let removeOne x = if x > 1 then Just (x-1) else Nothing
               gamePlayer p . playerTavern %= M.update removeOne r
               broadcast $ name ++ " returned one " ++ show r ++ " to the supply."
               return True
      ChooseQuest -> do
         qs <- use gameCliffwatchInn
         if null qs
            then return False
            else do
               let names = qs ^.. traverse . questTitle
               q <- solicitChoice p "Please choose a quest:" $ zip names qs
               gameCliffwatchInn %= (\\ [q])
               gamePlayer p . playerIncompleteQuests %= (++ [q])
               broadcast $ name ++ " chose " ++ (q ^. questTitle) ++ " from Cliffwatch Inn."
               restockCliffwatchInn
               return True
      DrawQuest -> do
         mq <- drawQuest
         case mq of
            Nothing -> return False
            Just q  -> do
               gamePlayer p . playerIncompleteQuests %= (++[q])
               broadcast $ name ++ " drew " ++ (q ^. questTitle) ++ " from the quest deck."
               return True
      DrawIntrigue -> do
         mi <- drawIntrigue
         case mi of
            Nothing -> return False
            Just i  -> do
               gamePlayer p . playerIntrigueCards %= (++[i])
               return True
      a1 `Then` a2 -> do
         (&&) <$> performAction p a1 <*> performAction p a2
      a1 `OrElse` a2 -> do
         r1 <- filterChoices (performAction p a1)
         case r1 of
            True -> return True
            False -> performAction p a2
      _ -> return False

scoreFinalPoints :: Waterdeep ()
scoreFinalPoints = do
   ps <- toListOf traverse <$> use gamePlayers
   forM_ ps $ \p -> do
      let rs = p ^. playerTavern . to M.toAscList
      forM_ rs $ \(r, n) -> do
         let pts = case r of { Gold -> n `div` 2; _ -> n; }
         gamePlayer (p ^. playerNumber) . playerScore += pts
         broadcast $ printf "%s scored %d points for having %d %ss."
                            (p ^. playerName) pts n (show r)
      case p ^. playerLord . lordBonus of
         QuestBonus types pts -> do
            let (cqs, apqs, upqs) = (p ^. playerCompletedQuests, p ^. playerActivePlotQuests, p ^. playerUsedPlotQuests)
            let matches = length $ filter ((`elem` types) . (view questType)) (cqs ++ apqs ++ upqs)
            gamePlayer (p ^. playerNumber) . playerScore += matches * pts
            when (matches > 0) $
               broadcast $ printf "%s scored %d points for completing %d %s and/or %s quests."
                                  (p ^. playerName) (matches * pts) matches
                                  (show (types !! 0)) (show (types !! 1))
         BuildingBonus pts -> do
            ownedBuildings <- length <$> filter ((== (p ^. playerNumber)) . (view buildingOwner)) <$> use gameAdvancedBuildings
            gamePlayer (p ^. playerNumber) . playerScore += ownedBuildings * pts
            when (ownedBuildings > 0) $
               broadcast $ printf "%s scored %d points for controlling %d buildings."
                                  (p ^. playerName) (ownedBuildings * pts) ownedBuildings

determineWinners :: Waterdeep [PlayerID]
determineWinners = do
   -- TODO: Implement tie-breaker(s)
   let compareScores a b = (b^.playerScore) `compare` (a^.playerScore)
   ps <- sortBy compareScores <$> toListOf traverse <$> use gamePlayers
   let bestScore = (head ps) ^. playerScore
   return $ map (^.playerNumber) $ takeWhile (\x -> (x^.playerScore) == bestScore) ps

shufflePiles :: Lens WaterdeepState WaterdeepState [a] [a]
             -> Lens WaterdeepState WaterdeepState [a] [a]
             -> Waterdeep ()
shufflePiles deck discard = do
   xs  <- (++) <$> use discard <*> use deck
   xs' <- shuffleM xs
   deck    .= xs'
   discard .= []
   return ()

shuffleQuests    = shufflePiles gameQuestDeck    gameQuestDiscard
shuffleIntrigues = shufflePiles gameIntrigueDeck gameIntrigueDiscard
shuffleBuildings = shufflePiles gameBuildingDeck gameBuildingDiscard

draw :: Lens WaterdeepState WaterdeepState [a] [a]
     -> Lens WaterdeepState WaterdeepState [a] [a]
     -> Waterdeep (Maybe a)
draw deck discard = do
   out <- null <$> use deck
   when out $ shufflePiles deck discard
   listToMaybe <$> (deck %%= splitAt 1)

drawQuest    = draw gameQuestDeck    gameQuestDiscard
drawIntrigue = draw gameIntrigueDeck gameIntrigueDiscard
drawBuilding = draw gameBuildingDeck gameBuildingDiscard

restockCliffwatchInn :: Waterdeep ()
restockCliffwatchInn = do
   num <- length <$> use gameCliffwatchInn
   when (num < 4) $ do
      mq <- drawQuest
      case mq of
         Nothing -> return ()
         Just q  -> do
            gameCliffwatchInn %= (++ [q])
            broadcast $ "Added " ++ (q ^. questTitle) ++ " to Cliffwatch Inn."
            restockCliffwatchInn

restockBuildersHall :: Waterdeep ()
restockBuildersHall = do
   num <- length <$> use gameBuildersHall
   when (num < 3) $ do
      mb <- drawBuilding
      case mb of
         Nothing -> return ()
         Just b  -> do
            gameBuildersHall %= (++ [newBuildingState noPlayerID b])
            broadcast $ "Added " ++ (b ^. buildingTitle) ++ " to Builder's Hall."
            restockBuildersHall