module Dominion.Internal (

  -- | Note: You shouldn't need to import this module...the
  -- interesting functions are re-exported by the Dominion module.
  --
  -- Use any other functions in here at your own risk.
  module Dominion.Internal
) where
import           Control.Applicative
import           Control.Arrow
import           Control.Lens        hiding (has, indices)
import           Control.Monad       (liftM)
import           Control.Monad.State hiding (state)
import           Data.List
import           Data.Map.Lazy       ((!))
import qualified Data.Map.Lazy       as M
import           Data.Maybe
import           Data.Ord
import qualified Dominion.Cards      as CA
import qualified Dominion.Types      as T
import           Dominion.Utils
import           Prelude             hiding (log)
import           System.IO.Unsafe
import           Text.Printf

-- | see all of the cards in a player's hand.
--
-- > cards <- currentHand playerId
currentHand :: T.PlayerId -> T.Dominion [T.Card]
currentHand playerId = (^. T.hand) <$> getPlayer playerId

-- | see if a player has a card in his hand.
--
-- > hasCard <- playerId `has` chapel
has :: T.PlayerId -> T.Card -> T.Dominion Bool
has playerId card = do
    player <- getPlayer playerId
    return $ card `elem` (player ^. T.hand)

-- | see how many of this card a player has.
--
-- > numMarkets <- countNum playerId market
countNum :: T.PlayerId -> T.Card -> T.Dominion Int
countNum playerId card = do
    player <- getPlayer playerId
    let allCards = player ^. T.deck ++ player ^. T.discard ++ player ^. T.hand
    return $ count card allCards

-- | What this card is worth in money.
coinValue :: T.Card -> Int
coinValue card = sum $ map effect (card ^. T.effects)
          where effect (T.CoinValue num) = num
                effect _ = 0

-- | Get the current round number.
getRound :: T.Dominion Int
getRound = T._round <$> get

-- | How much money this player's hand is worth (also counts any money you
-- get from action cards, like +1 from market).
handValue :: T.PlayerId -> T.Dominion Int
handValue playerId = do
    player <- getPlayer playerId
    return $ sum (map coinValue (player ^. T.hand)) + (player ^. T.extraMoney)

-- | Check if this card's pile is empty. Returns True is the card is not in play.
pileEmpty :: T.Card -> T.Dominion Bool
pileEmpty card = do
    state <- get
    return $ case M.lookup card (state ^. T.cards) of
      Nothing -> True
      Just x -> x == 0

-- | Returns the card, or Nothing if that pile is empty.
-- Useful because it automatically checks whether the pile is empty, and
-- modifies state to subtract a card from the pile correctly.
getCard :: T.Card -> T.Dominion (Maybe T.Card)
getCard card = do
    empty <- pileEmpty card
    if empty
      then return Nothing
      else do
        modify $ over T.cards (decrement card)
        return $ Just card

-- | Convenience function. Prints out a line if verbose, AND prints out
-- info about the related player...name, money, # of buys, # of actions.
log :: T.PlayerId -> String -> T.Dominion ()
log playerId str = do
    player <- getPlayer playerId
    money <- handValue playerId
    let name = player ^. T.playerName
        buys = player ^. T.buys
        actions = player ^. T.actions
        statusLine = printf "[player %s, name: %s, money: %s, buys: %s, actions: %s]" (yellow . show $ playerId) (yellow name) (green . show $ money) (green . show $ buys) (red . show $ actions)
    log_ $ statusLine ++ ": " ++ green str

-- | Like `log` but doesn't print out info about a player
log_ :: String -> T.Dominion ()
log_ str = do
    state <- get
    when (state ^. T.verbose) $ liftIO . putStrLn $ str

gameOver :: M.Map T.Card Int -> Bool
gameOver cards
    | cards ! CA.province == 0 = True
    | M.size (M.filter (== 0) cards) >= 3 = True
    | otherwise = False

-- | Given a player id and a number of cards to draw, draws that many cards
-- from the deck, shuffling if necessary.
drawFromDeck :: T.PlayerId -> Int -> T.Dominion [T.Card]
drawFromDeck playerId numCards = do
    player <- getPlayer playerId
    let deck = player ^. T.deck
    if length deck >= numCards
      then draw numCards
      else do
        let inDeck = length deck
        lastCards <- draw inDeck
        shuffleDeck playerId
        liftM (++ lastCards) $ draw (numCards - inDeck)
 where
   draw numCards = do
       player <- getPlayer playerId
       let drawnCards = take numCards (player ^. T.deck)
       modifyPlayer playerId $ over T.deck (drop numCards) . over T.hand (++ drawnCards)
       return drawnCards

-- | Like `modify` for the `State` monad, but works on players.
-- Takes a player id and a function that modifies the player.
modifyPlayer :: T.PlayerId -> (T.Player -> T.Player) -> T.Dominion ()
modifyPlayer playerId func = modify $ over (T.players . element playerId) func

-- | Like `modifyPlayer`, but modifies every player *except* the one specified with the player id.
modifyOtherPlayers :: T.PlayerId -> (T.Player -> T.Player) -> T.Dominion ()
modifyOtherPlayers playerId func = do
    state <- get
    let players = indices (state ^. T.players) \\ [playerId]
    forM_ players $ \pid -> modify $ over (T.players . element pid) func

setupForTurn :: T.PlayerId -> T.Dominion ()
setupForTurn playerId = do
    drawFromDeck playerId 5
    modifyPlayer playerId $ set T.actions 1 . set T.buys 1 . set T.extraMoney 0

playTurn :: T.PlayerId -> T.Strategy -> T.Dominion ()
playTurn playerId strategy = do
    roundNum <- getRound
    when (roundNum == 1) $ setupForTurn playerId
    player <- getPlayer playerId
    log playerId $ "player's hand has: " ++ (show . map T._name $ player ^. T.hand)
    strategy playerId
    discardHand playerId
    -- we draw from deck *after* to set up the next hand NOW,
    -- instead of calling this at the beginning of the function.
    -- The reason is, if someone else plays a militia, or a council room,
    -- these players need to be able to modify their deck accordingly
    -- even if its not their turn.
    setupForTurn playerId

makeGameState :: [T.Option] -> [T.Player] -> IO T.GameState
makeGameState options players = do
    actionCards_ <- deckShuffle CA.allActionCards
    let requiredCards = take 10 $ fromMaybe [] (findCards options)
        verbose       = fromMaybe False (findLog options)
        actionCards   = take (10 - length requiredCards) actionCards_ ++ requiredCards
        cards         = M.fromList ([(CA.copper, 60), (CA.silver, 40), (CA.gold, 30),
                                    (CA.estate, 12), (CA.duchy, 12), (CA.province, 12)]
                                    ++ [(c, 10) | c <- actionCards])
    return $ T.GameState players cards 1 verbose

game :: [T.Strategy] -> T.Dominion ()
game strategies = do
   state <- get
   let ids = indices $ state ^. T.players
   forM_ (zip ids strategies) (uncurry playTurn)

run :: T.GameState -> [T.Strategy] -> IO T.Result
run state strategies = do
  (_, newState) <- runStateT (game strategies) state
  let cards = newState ^. T.cards
  if gameOver cards
    then returnResults newState
    else run (over T.round (+1) newState) strategies

returnResults :: T.GameState -> IO T.Result
returnResults state = do
    let results = map (id &&& countPoints) (state ^. T.players)
        winner  = view (_1 . T.playerName) $ maximumBy (comparing snd) results
    when (state ^. T.verbose) $ do
      putStrLn "Game Over!"
      forM_ results $ \(player, points) -> putStrLn $
        printf "player %s got %d points" (player ^. T.playerName) points
    return $ T.Result results winner

isAction card = T.Action `elem` (card ^. T.cardType)
isAttack card = T.Attack `elem` (card ^. T.cardType)
isReaction card = T.Reaction `elem` (card ^. T.cardType)
isTreasure card = T.Treasure `elem` (card ^. T.cardType)
isVictory card = T.Victory `elem` (card ^. T.cardType)

countPoints :: T.Player -> Int
countPoints player = sum $ map countValue effects
    where cards        = player ^. T.deck ++ player ^. T.discard ++ player ^. T.hand
          victoryCards = filter isVictory cards
          effects      = concatMap T._effects victoryCards
          countValue (T.VPValue x) = x
          countValue (T.GardensEffect) = length cards `div` 10
          countValue _ = 0

-- | Get player from game state specified by this id.
-- This is useful sometimes:
--
-- > import qualified Dominion.Types as T
-- > import Control.Lens
-- >
-- > player <- getPlayer playerId
-- >
-- > -- How many buys does this player have?
-- > player ^. T.buys
-- >
-- > -- How many actions does this player have?
-- > player ^. T.actions
getPlayer :: T.PlayerId -> T.Dominion T.Player
getPlayer playerId = do
    state <- get
    return $ (state ^. T.players) !! playerId

-- | Convenience function. @ 4 \`cardsOf\` estate @ is the same as @ take 4 . repeat $ estate @
cardsOf = replicate 

eitherToBool :: Either String () -> Bool
eitherToBool (Left _) = False
eitherToBool (Right _) = True

-- | Move this players discards + hand into his deck and shuffle the deck.
shuffleDeck :: T.PlayerId -> T.Dominion ()
shuffleDeck playerId = modifyPlayer playerId shuffleDeck_

shuffleDeck_ :: T.Player -> T.Player
shuffleDeck_ player = set T.discard [] $ set T.deck newDeck player
          where discard = player ^. T.discard
                deck    = player ^. T.deck
                hand    = player ^. T.hand
                newDeck = unsafePerformIO $ deckShuffle (deck ++ discard ++ hand)

-- | Check that this player is able to purchase this card. Returns
-- a `Right` if they can purchase the card, otherwise returns a `Left` with
-- the reason why they can't purchase it.
validateBuy :: T.PlayerId -> T.Card -> T.Dominion (T.PlayResult ())
validateBuy playerId card = do
    money <- handValue playerId
    state <- get
    player <- getPlayer playerId
    cardGone <- pileEmpty card
    return $ do
      failIf (money < (card ^. T.cost)) $ printf "Not enough money. You have %d but this card costs %d" money (card ^. T.cost)
      failIf cardGone $ printf "We've run out of that card (%s)" (card ^. T.name)
      failIf ((player ^. T.buys) < 1) "You don't have any buys remaining!"

-- | Check that this player is able to play this card. Returns
-- a `Right` if they can play the card, otherwise returns a `Left` with
-- the reason why they can't play it.
validatePlay :: T.PlayerId -> T.Card -> T.Dominion (T.PlayResult ())
validatePlay playerId card = do
    player <- getPlayer playerId
    return $ do
      failIf (not (isAction card)) $ printf "%s is not an action card" (card ^. T.name)
      failIf ((player ^. T.actions) < 1) "You don't have any actions remaining!"
      failIf (card `notElem` (player ^. T.hand)) $ printf
        "You can't play a %s because you don't have it in your hand!" (card ^. T.name)

-- Discard this player's hand.
discardHand :: T.PlayerId -> T.Dominion ()
discardHand playerId = modifyPlayer playerId $ \player -> set T.hand [] $ over T.discard (++ (player ^. T.hand)) player

-- for parsing options
findIteration :: [T.Option] -> Maybe Int
findIteration [] = Nothing
findIteration (T.Iterations x : xs) = Just x
findIteration (_:xs) = findIteration xs

-- for parsing options
findLog :: [T.Option] -> Maybe Bool
findLog [] = Nothing
findLog (T.Log x : xs) = Just x
findLog (_:xs) = findLog xs

-- for parsing options
findCards :: [T.Option] -> Maybe [T.Card]
findCards [] = Nothing
findCards (T.Cards x : xs) = Just x
findCards (_:xs) = findCards xs

-- | Keep drawing a card until the provided function returns true.
-- The function gets a list of the cards drawn so far,
-- most recent first. Returns a list of all the cards drawn (these cards
-- are also placed into the player's hand)
drawsUntil :: T.PlayerId -> ([T.Card] -> T.Dominion Bool) -> T.Dominion [T.Card]
drawsUntil = drawsUntil_ []

-- internal use for drawsUntil
drawsUntil_ :: [T.Card] -> T.PlayerId -> ([T.Card] -> T.Dominion Bool) -> T.Dominion [T.Card]
drawsUntil_ alreadyDrawn playerId func = do
    drawnCards <- drawFromDeck playerId 1
    let cards = drawnCards ++ alreadyDrawn
    stopDrawing <- func cards
    if stopDrawing
      then return cards
      else drawsUntil_ cards playerId func

-- Does this card say you trash it when you play it?
trashThisCard :: T.Card -> Bool
trashThisCard card = T.TrashThisCard `elem` (card ^. T.effects)

-- | Player trashes the given card.
trashesCard :: T.PlayerId -> T.Card -> T.Dominion ()
playerId `trashesCard` card = do
  hasCard <- playerId `has` card
  when hasCard $ modifyPlayer playerId (over T.hand (delete card))

-- | Player discards the given card.
discardsCard :: T.PlayerId -> T.Card -> T.Dominion ()
playerId `discardsCard` card = do
  hasCard <- playerId `has` card
  when hasCard $ modifyPlayer playerId $ over T.hand (delete card) . over T.discard (card:)

-- Player returns the given card to the top of their deck.
returnsCard :: T.PlayerId -> T.Card -> T.Dominion ()
playerId `returnsCard` card = do
  hasCard <- playerId `has` card
  when hasCard $ modifyPlayer playerId $ over T.hand (delete card) . over T.deck (card:)

-- If the top card in the player's deck is one of the cards
-- listed in the provided array, then discard that card (used with spy).
discardTopCard :: [T.Card] -> T.Player -> T.Player
discardTopCard cards player = if topCard `elem` cards
                                then set T.deck (tail deck) . over T.discard (topCard:) $ player
                                else player
    where topCard = head $ player ^. T.deck
          deck = player ^. T.deck

-- If this player has a victory card in his/her hand,
-- it is put on top of their deck *unless* they have a moat in their hand.
-- Used with militia.
returnVPCard :: T.Player -> T.Player
returnVPCard player = let hand = player ^. T.hand
                          victoryCards = filter isVictory hand
                          card = head victoryCards
                      in if CA.moat `elem` hand || null victoryCards
                          then player
                          else over T.hand (delete card) $ over T.deck (card:) player

-- TODO how do they choose what to discard??
-- Right now I'm just choosing to discard the least expensive.
-- | Player discards down to x cards.
discardsTo :: T.Player -> Int -> T.Player
player `discardsTo` x = set T.hand toKeep . over T.discard (++ toDiscard) $ player
    where hand = sortBy (comparing T._cost) $ player ^. T.hand
          toDiscard = take (length hand - x) hand
          toKeep = hand \\ toDiscard

-- | Used internally by the `plays` function. Each card has a list of
-- effects (like smithy has `PlusCard 3`). This function applies the given
-- effect. It returns `Nothing` if the effect doesn't need a `Followup`,
-- or it returns a `Just Followup`.
usesEffect :: T.PlayerId -> T.CardEffect -> T.Dominion (Maybe T.Followup)
playerId `usesEffect` (T.PlusAction x) = do
    log playerId ("+ " ++ show x ++ " actions")
    modifyPlayer playerId $ over T.actions (+x)
    return Nothing

playerId `usesEffect` (T.PlusCoin x) = do
    log playerId ("+ " ++ show x ++ " coin")
    modifyPlayer playerId $ over T.extraMoney (+x)
    return Nothing

playerId `usesEffect` (T.PlusBuy x) = do
    log playerId ("+ " ++ show x ++ " buys")
    modifyPlayer playerId $ over T.buys (+x)
    return Nothing

playerId `usesEffect` (T.PlusCard x) = do
    log playerId ("+ " ++ show x ++ " cards")
    drawFromDeck playerId x
    return Nothing

playerId `usesEffect` effect@(T.PlayActionCard x) = return $ Just (playerId, effect)

playerId `usesEffect` (T.AdventurerEffect) = do
    log playerId "finding the next two treasures from your deck..."
    drawnCards <- playerId `drawsUntil` (\cards -> return $ countBy isTreasure cards == 2)
    -- the cards that weren't treasures need to be discarded
    forM_ (filter (not . isTreasure) drawnCards) $ \card -> playerId `discardsCard` card
    return Nothing

playerId `usesEffect` (T.BureaucratEffect) = do
    card_ <- getCard CA.silver
    case card_ of
      Nothing -> return ()
      Just card -> do
        log playerId "+ silver"
        modifyPlayer playerId $ over T.deck (card:)
    modifyOtherPlayers playerId returnVPCard
    return Nothing

playerId `usesEffect` T.CellarEffect = return $ Just (playerId, T.CellarEffect)

playerId `usesEffect` T.ChancellorEffect = return $ Just (playerId, T.ChancellorEffect)

playerId `usesEffect` effect@(T.TrashCards x) = do
    log playerId ("Trash up to " ++ show x ++ " cards from your hand.")
    return $ Just (playerId, effect)

playerId `usesEffect` effect@(T.OthersPlusCard x) = do
    log playerId ("Every other player draws " ++ show x ++ " card.")
    state <- get
    let players = indices (state ^. T.players) \\ [playerId]
    forM_ players $ \pid -> drawFromDeck pid 1
    return Nothing

playerId `usesEffect` effect@(T.GainCardUpto x) = do
    log playerId ("Gain a card costing up to " ++ show x ++ " coins.")
    return $ Just (playerId, effect)

-- TODO this doesn't set aside any action cards.
-- How do I implement the logic for choosing that?
-- Basically it allows the player to go through
-- and choose the action card they want?
playerId `usesEffect` effect@T.LibraryEffect = do
    log playerId "Drawing to 7 cards..."
    drawsUntil playerId $ \_ -> do
                 player <- getPlayer playerId
                 return $ length (player ^. T.hand) == 7
    return Nothing

-- NOTE: one side effect of this + council room is:
-- every player needs to draw their next hand immediately
-- after they finish playing, instead of at the start of when
-- they play. Otherwise suppose someone plays a council room
-- followed by a militia. I need to codify that properly.
playerId `usesEffect` effect@(T.OthersDiscardTo x) = do
    log playerId ("Every other player discards down to " ++ show x ++ " cards.")
    modifyOtherPlayers playerId (`discardsTo` x)
    return Nothing

playerId `usesEffect` T.MineEffect = return $ Just (playerId, T.MineEffect)

playerId `usesEffect` T.MoneylenderEffect = do
    hasCard <- playerId `has` CA.copper
    when hasCard $ do
      log playerId "Trashing a copper. +3 coin"
      playerId `trashesCard` CA.copper
      modifyPlayer playerId $ over T.extraMoney (+3)
    return Nothing

playerId `usesEffect` T.RemodelEffect = return $ Just (playerId, T.RemodelEffect)

playerId `usesEffect` T.SpyEffect = return $ Just (playerId, T.SpyEffect)

playerId `usesEffect` T.ThiefEffect = return $ Just (playerId, T.ThiefEffect)

playerId `usesEffect` (T.OthersGainCurse x) = do
    log playerId ("All other players gain " ++ show x ++ " curses.")
    let card = CA.curse
    empty <- pileEmpty card
    if empty
      then return Nothing
      else do
        modifyOtherPlayers playerId (over T.discard (card:))
        state <- get
        times (length (state ^. T.players) - 1) $ do
          modify $ over T.cards (decrement card)
          return ()
        return Nothing

-- only counted at the end of the game.
playerId `usesEffect` T.GardensEffect = return Nothing
playerId `usesEffect` _ = return Nothing

-- | Given a name, creates a player with that name.
makePlayer :: String -> T.Player
makePlayer name = T.Player name [] (7 `cardsOf` CA.copper ++ 3 `cardsOf` CA.estate) [] 1 1 0

-- Checks that the player can gain the given card, then adds it to his/her
-- discard pile.
gainCardUpTo :: T.PlayerId -> Int -> T.Card -> T.Dominion (T.PlayResult (Maybe [T.Followup]))
gainCardUpTo playerId value card =
  if (card ^. T.cost) > value
    then return . Left $ printf "Card is too expensive. You can gain a card costing up to %d but this card costs %d" value (card ^. T.cost)
    else do
      result <- getCard card
      case result of
        Nothing -> return . Left $ printf "We've run out of that card (%s)" (card ^. T.name)
        (Just card_) -> do
          modifyPlayer playerId $ over T.discard (card_:)
          return $ Right Nothing