{-# 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 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]
      -- 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 w' -> 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 (SolicitChoice w p t cs) cont) =
         or $ map (tryChoice . cont . snd) cs
      filteredChoice :: ContWD Bool -> Waterdeep (Maybe WaterdeepState)
      filteredChoice (Done (a,w)) = if a then return (Just w) else return Nothing
      filteredChoice (Cont (NotifyState w) cont) = filteredChoice $ cont ()
      filteredChoice (Cont (SolicitChoice w p t cs) cont) = do
         let cs' = filter (tryChoice . cont . snd) cs
         if null cs'
            then return Nothing
            else filteredChoice =<< (cont <$> (put w >> solicitChoice p t cs'))

performAction :: PlayerID -> GameAction -> Waterdeep Bool
performAction p a = case a of
   NoAction -> return True
   ScorePoints n -> do
      gamePlayer p . playerScore += n
      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)])
      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
            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])
            restockCliffwatchInn
            return True
   DrawQuest -> do
      mq <- drawQuest
      case mq of
         Nothing -> return False
         Just q  -> do
            gamePlayer p . playerIncompleteQuests %= (++[q])
            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
   _ -> 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
      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
         BuildingBonus pts -> do
            ownedBuildings <- length <$> filter ((== (p ^. playerNumber)) . (view buildingOwner)) <$> use gameAdvancedBuildings
            gamePlayer (p ^. playerNumber) . playerScore += ownedBuildings * pts

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])
            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])
            restockBuildersHall