module State.XML where

import Control.Concurrent.MVar
import Control.Lens
import Control.Monad.State
import Data.Functor.Identity (runIdentity)
import Network.HTTP.Base (urlEncode)
import State.Operations
import State.Types

wrapTag :: String -> String -> String
wrapTag tag val = "<" ++ tag ++ ">" ++ val ++ "</" ++ tag ++ ">"

wrapTagAttributes :: String -> [(String,String)] -> String -> String
wrapTagAttributes tag attributes val =
  "<" ++ tag ++ foldl (\s attrib -> s ++ " " ++ formatAttrib attrib) "" attributes ++
  ">" ++ val ++ "</" ++ tag ++ ">"
  where formatAttrib :: (String,String) -> String
        formatAttrib (x,y) = x ++ "='" ++ y ++ "'"

playerToXML :: GameState -> Player -> String
playerToXML state player = wrapTagAttributes "player" [("id",show (player^.playerID))] $
                           wrapTag "name" (player^.name) ++
                           wrapTag "handSize" (show . length $ player^.hand) ++
                           wrapTag "deckSize" (show . length $ player^.deck) ++
                           wrapTag "health" (show $ player^.hp) ++
                           wrapTag "creatures" creatures ++
                           wrapTag "lands" lands ++
                           handTag
  where
    creatureCards = filter (\c -> Land `notElem` (state^.card c.cardType)) (player^.field)
    landCards = filter (\c -> Land `elem` (state^.card c.cardType)) (player^.field)
    creatures = foldl (\s c -> s ++ cardToXML (state^.card c) state) "" creatureCards
    lands = foldl (\s c -> s ++ cardToXML (state^.card c) state) "" landCards
    handTag = wrapTag "hand" (concatMap (\x -> cardToXML (state^.card x) state) $ player^.hand)

imageForCard cardName = "/static/" ++ urlEncode cardName ++ ".full.jpg"

abilityToXML (Activated descr _ _) = "<ability>" ++ descr ++ "</ability>"
abilityToXML other = "<ability>" ++ show other ++ "</ability>"

cardToXML card state = wrapTag "card" $
                 wrapTag "id" (show $ card^.cardID) ++
                 wrapTag "name" (card^.cardName) ++
                 wrapTag "image" (imageForCard (card^.cardName)) ++
                 wrapTag "tapped" (show $ card^.tapped) ++
                 wrapTag "attacking" (show $ card^.cardID `elem` state^.attackers) ++
                 wrapTag "blocking" (show $ card^.cardID `elem` state^..blockers.traversed._1) ++
                 wrapTag "abilities" (concatMap abilityToXML
                                      (filter abilityIsActivated $ card^.abilities))

actionToXML state (PlayCard pID cID) =
  cardToXML (state^.card cID) state
actionToXML state action = wrapTag "gameAction" (show action)

toXML :: GameState -> IO String
toXML state = do
  (_, ioreq) <- readMVar (state^.ioreqChannel)
  let ioreqXML = wrapTag "ioreq" $ show ioreq
  return $ wrapTag "game" (playerXMLs ++ phaseXML ++
                           ioreqXML ++
                           wrapTag "currentPlayerID"
                           (show $ state^.currentPlayerID) ++
                           wrapTag "stack" stackXML ++
                           wrapTag "gg" winner
                          )
  where
    playerXMLs = concatMap (playerToXML state) $ state^.players
    phaseXML = wrapTag "phase" $ show (state^.currentStep)
    stackXML = concatMap (actionToXML state) (state^.stack)
    maybeVictory :: Maybe PlayerID
    maybeVictory = runIdentity $ evalStateT checkVictory state
    winner :: String
    winner = case maybeVictory of
      Nothing -> ""
      Just pID -> state^.playerWithID pID.name
