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

module Waterdeep.Actions
   ( noAction
   , scorePoints
   , takeResources
   , returnResources
   , chooseQuest
   , replaceQuests
   , drawQuest
   , drawNamedQuestType
   , distributeQuests
   , completeQuest
   , chooseAndCompleteQuest
   , discardUncompletedQuest
   , buyBuilding
   , chooseFreeBuilding
   , drawFreeBuilding
   , discardUnoccupiedBuilding
   , drawIntrigue
   , playIntrigue
   , returnAgent
   , returnAgentFromHarbor
   , assignAgent
   , assignAgentToBuildersHall
   , assignAgentToOpponentsSpace
   , useOpponentsSpace
   , gainLieutenant
   , gainAmbassador
   , assignMandatoryQuest
   , becomeFirstPlayer
   , forOneOpponent
   , forEachOpponent
   , forCurrentPlayer
   , restockCliffwatchInn
   , restockBuildersHall
   , getOpponents
   , getNumberOfBuildings
   , getNumberOfControlledBuildings
   ) where

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

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

noAction :: GameAction
noAction = return ()

scorePoints :: Int -> GameAction
scorePoints n = do
   activePlayerState . playerScore += n
   name <- use activePlayerName
   broadcast $ printf "%s scored %d points." name n

takeResources :: Int -> [Resource] -> GameAction
takeResources n rs = do
   received <- map (head &&& length) . group . sort <$$> replicateM n $ do
      r <- solicitChoice "Take one item:" $ map (show &&& id) rs
      activePlayerState . playerTavern <>= MS.singleton r
      return r
   let items = joinStrings $ map (\(r,n) -> show n ++ " " ++ show r) received
   name <- use $ activePlayerName
   broadcast $ printf "%s received %s." name items

returnResources :: Int -> [Resource] -> GameAction
returnResources n rs = do
   returned <- replicateM n $ do
      r <- solicitChoice "Return one item:" $ map (show &&& id) rs
      guard . (r `MS.member`) =<< use (activePlayerState . playerTavern)
      activePlayerState . playerTavern %= (`MS.difference` MS.singleton r)
      return r
   let groups = map (head &&& length) $ group returned
   let items = joinStrings $ map (\(r,n) -> show n ++ " " ++ show r) groups
   name <- use $ activePlayerName
   broadcast $ name ++ " returned " ++ items ++ " to the supply."

chooseQuest' :: Waterdeep Quest
chooseQuest' = do
   choices <- zipWith (\i q -> (q ^. questTitle, (i, q))) [0..] <$> use gameCliffwatchInn
   (i, quest) <- solicitChoice "Choose one quest:" $ nubOn fst choices
   gameCliffwatchInn %= deleteAt i
   name <- use $ activePlayerName
   broadcast $ name ++ " chose " ++ (quest ^. questTitle) ++ " from Cliffwatch Inn."
   restockCliffwatchInn
   return quest

chooseQuest :: GameAction
chooseQuest = do
   quest <- chooseQuest'
   activePlayerState . playerIncompleteQuests <>= [quest]
   return ()

replaceQuests :: GameAction
replaceQuests = do
   quests <- gameCliffwatchInn <<.= []
   gameQuestDiscard <>= quests
   restockCliffwatchInn

drawQuest :: GameAction
drawQuest = do
   Just q <- drawQuest'
   name <- use $ activePlayerName
   activePlayerState . playerIncompleteQuests <>= [q]
   broadcast $ printf "%s drew %s from the quest deck." name (q ^. questTitle)

drawNamedQuestType :: GameAction
drawNamedQuestType = do
   let qtypes = [Piety, Warfare, Skullduggery, Arcana, Commerce]
   qtype <- solicitChoice "Choose a quest type:" $ map (show &&& id) qtypes
   name <- use $ activePlayerName
   broadcast $ name ++ " chose the " ++ (show qtype) ++ " quest type."
   flip fix [] $ \loop discards -> do
      mq <- drawQuest'
      case mq of
         Nothing -> do
            broadcast $ "There were no " ++ show qtype ++ " quests available."
            gameQuestDiscard <>= discards
            return ()
         Just q -> do
            broadcast $ printf "%s drew the %s quest %s."
               name (show (q ^. questType)) (q ^. questTitle)
            if (q ^. questType /= qtype)
               then loop (q : discards)
               else do
                  gameQuestDiscard <>= discards
                  activePlayerState . playerIncompleteQuests <>= [q]
                  return ()

distributeQuests :: GameAction
distributeQuests = do
   let distribute remQuests = unless (null remQuests) $ do
         let choices = zipWith (\i q -> (q ^. questTitle, (i, q))) [0..] remQuests
         (i, quest) <- solicitChoice "Choose a quest:" $ nubOn fst choices
         activePlayerState . playerIncompleteQuests <>= [quest]
         name <- use $ activePlayerName
         broadcast $ printf "%s chose the %s quest." name (quest ^. questTitle)
         p' <- getNextPlayer =<< use gameActivePlayer
         withActivePlayer p' $ distribute (deleteAt i remQuests)
   distribute =<< catMaybes <$> (flip replicateM drawQuest' =<< use gameNumberOfPlayers)

completeQuest :: GameAction
completeQuest = do
   quests <- zip [0..] <$> use (activePlayerState . playerIncompleteQuests)
   let mandatoryQuests = filter ((== Mandatory) . view questType . snd) quests
   let availQuests = if null mandatoryQuests then quests else mandatoryQuests
   let choices = map (\(i,q) -> (q ^. questTitle, (i, q))) availQuests
   (i, quest) <- solicitChoice "Complete one quest:" $ nubOn fst choices
   activePlayerState . playerIncompleteQuests %= deleteAt i
   quest ^. questAction
   if null (quest ^. questPlotActions)
      then activePlayerState . playerCompletedQuests  <>= [quest]
      else activePlayerState . playerActivePlotQuests <>= [quest]
   name <- use $ activePlayerName
   broadcast $ name ++ " completed the " ++ (quest ^. questTitle) ++ " quest."

chooseAndCompleteQuest :: GameAction -> GameAction
chooseAndCompleteQuest bonusAction = do
   quest <- chooseQuest'
   doQuest <- solicitChoice "Complete this quest immediately?"
                              [("Yes", True), ("No", False)]
   case doQuest of
      True -> do
         incompleteQuests <- use (activePlayerState . playerIncompleteQuests)
         guard . not . or $ map ((== Mandatory) . view questType) incompleteQuests
         quest ^. questAction
         if null (quest ^. questPlotActions)
            then activePlayerState . playerCompletedQuests  <>= [quest]
            else activePlayerState . playerActivePlotQuests <>= [quest]
         name <- use $ activePlayerName
         broadcast $ name ++ " completed the " ++ (quest ^. questTitle) ++ " quest."
         bonusAction
      False -> do
         activePlayerState . playerIncompleteQuests <>= [quest]
         return ()

discardUncompletedQuest :: GameAction
discardUncompletedQuest = do
   choices <- zipWith (\i q -> (q ^. questTitle, (i, q))) [0..] <$>
                  use (activePlayerState . playerIncompleteQuests)
   (i, quest) <- solicitChoice "Choose a quest to discard:" $ nubOn fst choices
   activePlayerState . playerIncompleteQuests %= deleteAt i
   gameQuestDiscard <>= [quest]
   name <- use $ activePlayerName
   broadcast $ name ++ " discarded the " ++ (quest ^. questTitle) ++ " quest."

buyBuilding :: GameAction
buyBuilding = do
   let label b = printf "%s (%d Gold, %d Points)"
         (b ^. building . buildingTitle)
         (b ^. building . buildingCost)
         (b ^. buildingAccumulation)
   choices <- zipWith (\i b -> (label b, (i, b))) [0..] <$> use gameBuildersHall
   (i, b) <- solicitChoice "Choose a building from Builder's Hall:" $ nubOn fst choices
   let cost = b ^. building . buildingCost
   returnResources cost [Gold]
   scorePoints (b ^. buildingAccumulation)
   gameBuildersHall %= deleteAt i
   p <- use gameActivePlayer
   gameBuildings <>= [b & buildingOwner .~ p & buildingAccumulation .~ 0]
   name <- use $ activePlayerName
   broadcast $ name ++ " built the " ++ (b ^. building . buildingTitle) ++ "."
   restockBuildersHall

chooseFreeBuilding :: GameAction
chooseFreeBuilding = do
   let label b = printf "%s (%d Points)"
         (b ^. building . buildingTitle)
         (b ^. buildingAccumulation)
   choices <- zipWith (\i b -> (label b, (i, b))) [0..] <$> use gameBuildersHall
   (i, b) <- solicitChoice "Choose a building from Builder's Hall:" $ nubOn fst choices
   scorePoints (b ^. buildingAccumulation)
   gameBuildersHall %= deleteAt i
   p <- use gameActivePlayer
   gameBuildings <>= [b & buildingOwner .~ p & buildingAccumulation .~ 0]
   name <- use $ activePlayerName
   broadcast $ name ++ " built the " ++ (b ^. building . buildingTitle) ++ " for free."
   restockBuildersHall

drawFreeBuilding :: GameAction
drawFreeBuilding = do
   Just b <- drawBuilding'
   p <- use gameActivePlayer
   gameBuildings <>= [newBuildingState p b]
   name <- use $ activePlayerName
   broadcast $ name ++ " built the " ++ (b ^. buildingTitle) ++ " for free."

discardUnoccupiedBuilding :: GameAction
discardUnoccupiedBuilding = do
   allBuildings <- zip [0..] <$> use gameBuildings
   p <- use gameActivePlayer
   let ownedBuildings = filter ((== p) . view buildingOwner . snd) allBuildings
   let emptyBuildings = filter (null . view buildingAgents . snd) ownedBuildings
   let choices = map (\(i,b) -> (b ^. building . buildingTitle, (i, b))) emptyBuildings
   (i, b) <- solicitChoice "Choose a building to discard:" $ nubOn fst choices
   gameBuildings %= deleteAt i
   gameBuildingDiscard <>= [b ^. building]
   name <- use $ activePlayerName
   broadcast $ name ++ " discarded the " ++ (b ^. building . buildingTitle) ++ "."

drawIntrigue :: GameAction
drawIntrigue = do
   Just ic <- drawIntrigue'
   activePlayerState . playerIntrigueCards <>= [ic]
   name <- use $ activePlayerName
   broadcast $ name ++ " drew an Intrigue card."

playIntrigue :: GameAction
playIntrigue = do
   choices <- zipWith (\i ic -> (ic ^. intrigueTitle, (i, ic))) [0..] <$>
                  use (activePlayerState . playerIntrigueCards)
   (i, intrigue) <- solicitChoice "Play one intrigue card:" $ nubOn fst choices
   activePlayerState . playerIntrigueCards %= deleteAt i
   name <- use $ activePlayerName
   broadcast $ name ++ " played the " ++ (intrigue ^. intrigueTitle) ++ " Intrigue card."
   intrigue ^. intrigueAction
   gameIntrigueDiscard <>= [intrigue]
   return ()

returnAgent :: GameAction
returnAgent = return () -- TODO

returnAgentFromHarbor :: GameAction
returnAgentFromHarbor = return () -- TODO

assignAgentToBuilding :: Lens' WaterdeepState BuildingState -> Waterdeep ()
assignAgentToBuilding bl = do
   activePlayerState . playerAgentsInPool -= 1
   p <- use gameActivePlayer
   bl . buildingAgents <>= [p]
   name  <- use $ activePlayerName
   bName <- use (bl . building . buildingTitle)
   broadcast $ name ++ " assigned an agent to " ++ bName ++ "."
   owner <- use (bl . buildingOwner)
   when (owner `notElem` [noPlayerID, p]) $
      withActivePlayer owner =<< use (bl . building . buildingOwnerAction)
   join $ use (bl . building . buildingAction)

assignAgentToHarbor :: Lens' ([PlayerID], [PlayerID], [PlayerID]) [PlayerID] -> Waterdeep ()
assignAgentToHarbor l = do
   activePlayerState . playerAgentsInPool -= 1
   p <- use gameActivePlayer
   gameWaterdeepHarbor . l <>= [p]
   name <- use $ activePlayerName
   broadcast $ name ++ " assigned an agent to Waterdeep Harbor."
   playIntrigue

assignAgent :: GameAction
assignAgent = do
   agents <- use (activePlayerState . playerAgentsInPool)
   guard (agents > 0)
   w <- get
   let buildings = execWriter $ do
         forM_ [0 .. length (w ^. gameBuildings) - 1] $ \i -> do
            let l :: Lens' WaterdeepState BuildingState
                l = gameBuildings . singular (ix i)
            when (null (w ^. l . buildingAgents)) $ do
               tell [(w ^. l . building . buildingTitle, assignAgentToBuilding l)]
         case w ^. gameWaterdeepHarbor of
            ([], _, _) -> tell [("Waterdeep Harbor", assignAgentToHarbor _1)]
            (_, [], _) -> tell [("Waterdeep Harbor", assignAgentToHarbor _2)]
            (_, _, []) -> tell [("Waterdeep Harbor", assignAgentToHarbor _3)]
            _          -> return ()
   join $ solicitChoice "Assign one agent to:" $ nubOn fst buildings

assignAgentToBuildersHall :: GameAction
assignAgentToBuildersHall = return () -- TODO

assignAgentToOpponentsSpace :: GameAction
assignAgentToOpponentsSpace = return () -- TODO

useOpponentsSpace :: GameAction
useOpponentsSpace = return () -- TODO

gainLieutenant :: GameAction
gainLieutenant = do
   activePlayerState . playerHasLieutenant .= True
   activePlayerState . playerAgentsInPool += 1
   name <- use $ activePlayerName
   broadcast $ name ++ " gained the Lieutenant."
   return ()

gainAmbassador :: GameAction
gainAmbassador = do
   guard . not . or . toListOf (traverse . playerHasAmbassador) =<< use gamePlayerStates
   gameBuildings . each . buildingAgents %= (\\ [noPlayerID])
   gameWaterdeepHarbor . each %= (\\ [noPlayerID])
   activePlayerState . playerHasAmbassador .= True
   name <- use $ activePlayerName
   broadcast $ name ++ " gained the Ambassador."

assignMandatoryQuest :: Quest -> GameAction
assignMandatoryQuest quest = do
   name <- use $ activePlayerName
   opponents <- getOpponents
   let choices = map (view playerName &&& (view playerNumber &&& view playerName)) opponents
   (opID, opName) <- solicitChoice "Choose one opponent:" choices
   gamePlayerState opID . playerIncompleteQuests <>= [quest]
   broadcast $ name ++ " assigned " ++ opName ++ " a mandatory quest."

becomeFirstPlayer :: GameAction
becomeFirstPlayer = do
   gameFirstPlayer <~ use gameActivePlayer
   name <- use $ activePlayerName
   broadcast $ name ++ " is now the first player."

forOneOpponent :: GameAction -> GameAction
forOneOpponent a1 = do
   opponents <- getOpponents
   let choices = map (view playerName &&& (view playerNumber &&& view playerName)) opponents
   (opID, opName) <- solicitChoice "Choose one opponent:" choices
   name <- use $ activePlayerName
   broadcast $ name ++ " chose " ++ opName ++ "."
   withActivePlayer opID a1

forEachOpponent :: GameAction -> GameAction
forEachOpponent a1 = do
   opponents <- getOpponents
   forM_ opponents $ \op -> withActivePlayer (op ^. playerNumber) a1

forCurrentPlayer :: GameAction -> GameAction
forCurrentPlayer a1 = do
   p <- use gameCurrentPlayer
   withActivePlayer p a1

-- Like (<$>), but with the same fixity and precedence as ($)
(<$$>) :: Applicative f => (a -> b) -> f a -> f b
(<$$>) = (<$>)
infixr 0 <$$>

joinStrings :: [String] -> String
joinStrings []      = "nothing"
joinStrings [x]     = x
joinStrings [x,y]   = x ++ " and " ++ y
joinStrings [x,y,z] = x ++ ", " ++ y ++ ", and " ++ z
joinStrings (x:xs)  = x ++ ", " ++ joinStrings xs

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


getOpponents :: Waterdeep [PlayerState]
getOpponents = do
   p <- use gameActivePlayer
   filter (\p1 -> (p1 ^. playerNumber) /= p) . toListOf traverse <$> use gamePlayerStates

getNumberOfBuildings :: Waterdeep Int
getNumberOfBuildings =
   length . filter (\b -> b ^. buildingOwner /= noPlayerID) <$> use gameBuildings

getNumberOfControlledBuildings :: Waterdeep Int
getNumberOfControlledBuildings = do
   p <- use gameActivePlayer
   length . filter (\b -> b ^. buildingOwner == p) <$> use gameBuildings