content: {-# LANGUAGE OverloadedStrings #-}
  
  module Chess where
  
  import           Control.Monad.IO.Class    (liftIO)
  import           Data.IORef                (IORef, newIORef, readIORef,
                                              writeIORef)
  import           Data.List
  import           Data.List.Split
  import           Data.Map                  (Map)
  import qualified Data.Map                  as Map
  import           Data.Maybe                (fromMaybe)
  import           Data.Monoid               ((<>))
  import           Data.Text.Lazy            (Text, unpack)
  import           Data.Text.Lazy            (pack)
  import           Data.Text.Lazy            (replace)
  import qualified Data.Text.Lazy            as LazyText
  import           GHC.Generics
  import           System.IO.Streams.Process (system)
  import           Text.RawString.QQ
  
  --Server
  import           Web.Scotty
  import           Web.Scotty                (ActionM, ScottyM, get, scotty, text)
  import           Web.Scotty.Internal.Types (ActionT, File, Options, Param,
                                              RoutePattern, ScottyT)
  --Board
  import           ChessBoard
  
  servicePort = 3700 :: Int
  
  chessBoardPath = "src/programs/chess/table/table.html" :: String
  
  playersTag = "#Players" :: Text
  
  {-| ----------------------------------------------}
  {-|                    SERVER                    -}
  {-| ----------------------------------------------}
  {-| Using [scotty] passing [port] and [routes] we define the http server.
      We also keep the state of the player using [IORef] so we can move that state [AdventureInfo] around the program-}
  chessServer :: IO ()
  chessServer = do
    print ("Starting Adventure Server at port " ++ show servicePort)
    chessInfo <- newIORef $ ChessInfo Map.empty initBoardGame
    scotty servicePort (routes chessInfo)
  
  routes :: IORef ChessInfo -> ScottyM ()
  routes chessInfoRef = do
    get "/service" responseService
    get "/chess/register/:playerName" $ registerPlayer chessInfoRef
    get "/chess/players" $ getPlayersInGame chessInfoRef
    get "/chess/:player/:from/:to" $ makeMoveInGame chessInfoRef
  
  {-| We use [text] operator from scotty we render the response in text/plain-}
  responseService :: ActionM ()
  responseService = do
    let version = "1.0"
    html $ mconcat ["<h1>Chess Haskell server ", version, "</h1>"]
  
  {-| Function to register the new PlayerInfo in case we not reach the max number of players already-}
  registerPlayer :: IORef ChessInfo -> ActionM ()
  registerPlayer chessInfoRef = do
    playerName <- extractUriParam "playerName"
    chessInfo <- liftIO $ readIORef chessInfoRef
    page <- toActionM $ readFile chessBoardPath
    page <- toActionM $ prepareBoard chessInfo
    let playersMap = players chessInfo
    if length playersMap == 2
      then do
        let replacePage = replace playersTag "Max number of users reach" page
        html $ mconcat ["", replacePage, ""]
      else do
        let playerPieces = getPlayerPieces (Map.elems playersMap)
        let playerInfoList = Map.insert playerName (PlayerInfo playerName playerPieces) playersMap
        newChessInfo <- toActionM $ writeChessInfoInIORef chessInfoRef playerInfoList initBoardGame
        let replacePage = replaceNameInPage page playerName
        html $ mconcat ["", replacePage, ""]
  
  {-| Function to return the board chess page with the number of users that are playing-}
  getPlayersInGame :: IORef ChessInfo -> ActionM ()
  getPlayersInGame chessInfoRef = do
    chessInfo <- liftIO $ readIORef chessInfoRef
    prepareBoardPage chessInfo
  
  {-| Function to make the move of the player, once we extract the name and from to movements-}
  makeMoveInGame :: IORef ChessInfo -> ActionM ()
  makeMoveInGame chessInfoRef = do
    playerName <- extractUriParam "player"
    from <- extractUriParam "from"
    to <- extractUriParam "to"
    chessInfo <- toActionM $ changeBoardPieces chessInfoRef playerName from to
    prepareBoardPage chessInfo
  
  prepareBoardPage :: ChessInfo -> ActionM ()
  prepareBoardPage chessInfo = do
    page <- toActionM $ prepareBoard chessInfo
    page <- toActionM $ replacePlayersInChessBoard page (Map.elems $ players chessInfo)
    html $ mconcat ["", page, ""]
  
  
  {-| ----------------------------------------------}
  {-|                    GAME UTILS                -}
  {-| ----------------------------------------------}
  {-| Function that receive the [chessInfo] [playerName] and movements [from][to] which we use to change in the
     player movement map the new pieces and set those new in the board. Here in order to be pure FP we have to recreate
     the chessInfo with the new info of the movements of the player that just move.-}
  changeBoardPieces :: IORef ChessInfo -> String -> String -> String -> IO ChessInfo
  changeBoardPieces chessInfoRef playerName from to = do
    chessInfo <- liftIO $ readIORef chessInfoRef
    let player = fromMaybe (PlayerInfo "" Map.empty) $ Map.lookup playerName (players chessInfo)
    newPlayerMovements <- replacePlayerMovements (movements player) from to
    let playerInfo = PlayerInfo (name player) newPlayerMovements
    let playersWithoutMe = filter (\entry -> fst entry /= playerName) (Map.toList $ players chessInfo)
    let newChessInfo = ChessInfo (Map.fromList $ playersWithoutMe ++ [(playerName, playerInfo)]) (boardGame chessInfo)
    writeIORef chessInfoRef newChessInfo
    return newChessInfo
  
  {-| Function to create a new Map of movements of the player with the new movements. Here we have to use [filter]
     function to just get the movements of my player, filter by old [from] to the new [to] -}
  replacePlayerMovements :: Map String String -> String -> String -> IO (Map String String)
  replacePlayerMovements playerMovements from to = do
    let fromPiece = fromMaybe "" $ Map.lookup from playerMovements
    let mapNewValue = Map.filter (/= from) $ Map.filter (/= to) playerMovements
    let newPlayerMovement = Map.insert from "" $ Map.insert to fromPiece mapNewValue
    return newPlayerMovement
  
  {-| Function which having the chessInfo data type with the current game, we get the chess board page and
      we do the replacements of the pieces in the board-}
  prepareBoard :: ChessInfo -> IO Text
  prepareBoard chessInfo = do
    page <- readFile chessBoardPath
    boardGameWithMovements <- replaceMovementsInBoard chessInfo
    return $ replacePiecesInPhysicalBoard (pack page) (Map.toList boardGameWithMovements)
  
  {-| Function that receive the [ChessInfo] and we extract the players info to replace the movements of player into the map board
      To achieve this we use [foldl] to iterate over the tuple of board movements and extract the player movements and set into
      a new Map-}
  replaceMovementsInBoard :: ChessInfo -> IO (Map String String)
  replaceMovementsInBoard chessInfo = do
    let player1Pieces =
          if null (players chessInfo)
            then initPlayerPieces1
            else movements (head (Map.elems $ players chessInfo))
    let player2Pieces =
          if isNullOrHasOnePlayer chessInfo
            then initPlayerPieces2
            else movements (last (Map.elems $ players chessInfo))
    let playersMovementsInBoard =
          foldl
            (\previousMap tuple ->
               Map.insert (fst tuple) (replacePlayerPiecesInBoard tuple player1Pieces player2Pieces) previousMap)
            Map.empty
            (Map.toList (boardGame chessInfo))
    return playersMovementsInBoard
  
  {-| Function to replace the memory board [#movement] by the Player-}
  replacePlayerPiecesInBoard :: (String, String) -> Map String String -> Map String String -> String
  replacePlayerPiecesInBoard (key, boardPosition) player1Pieces player2Pieces =
    unpack $
    replace
      "#movement"
      (pack (fromMaybe (fromMaybe "" $ Map.lookup key player2Pieces) $ Map.lookup key player1Pieces))
      (pack boardPosition)
  
  {-| Using [foldl] foldLeft function we can do the tail recursive calls just, together with eta reduce we can receive in
      any invocation of the function the page which is propagated in every recursive call together with the next iteration of
       the list of tuples.
      Also to get the first element of the tuple we use [fst] function and to get the second just [snd]-}
  replacePiecesInPhysicalBoard :: Text -> [(String, String)] -> Text
  replacePiecesInPhysicalBoard = foldl (\page tuple -> replace (pack ("#" ++ fst tuple)) (pack (snd tuple)) page)
  
  {-| Classic no sugar syntax to do a fold over the list of tuples and propagate the applied changes over the page-}
  --replacePage page (tuple:listOfTuples) = replacePage (replace (pack ("#" ++ fst tuple)) (pack (snd tuple)) page) listOfTuples
  --replacePage page [] = page
  writeChessInfoInIORef :: IORef ChessInfo -> Map String PlayerInfo -> Map String String -> IO ()
  writeChessInfoInIORef chessInfoRef playerInfoList initBoardGame =
    writeIORef chessInfoRef $ ChessInfo playerInfoList initBoardGame
  
  replaceNameInPage :: Text -> String -> Text
  replaceNameInPage page name = replace playersTag (pack name) page
  
  {-| Function to read the html page and transform in Text, also we use fmap name players to iterate the players collection
      and return a new one with only the attribute specify, in here it would be a list of names::String.
      We use the unwords function to extract the String in the list and concatenate.
      We also use [fromMaybe] sugar syntax function to extract the value of the maybe or else return default value.|-}
  replacePlayersInChessBoard :: Text -> [PlayerInfo] -> IO Text
  replacePlayersInChessBoard page players = do
    let playerNamesList = fmap name players
    let maybePlayersName = Just $ unwords playerNamesList
    let playersName = fromMaybe "No players register" maybePlayersName
    let pageWithName = replace playersTag (pack playersName) page
    return pageWithName
  
  {-| Function to return the map of movements of player1 or player2-}
  getPlayerPieces :: [PlayerInfo] -> Map String String
  getPlayerPieces playersList =
    if null playersList
      then initPlayerPieces1
      else initPlayerPieces2
  
  isNullOrHasOnePlayer :: ChessInfo -> Bool
  isNullOrHasOnePlayer chessInfo = null (players chessInfo) || length (players chessInfo) == 1
  
  {-| Function to extract uri params by name-}
  extractUriParam :: LazyText.Text -> ActionM String
  extractUriParam = Web.Scotty.param
  
  {-| Sugar syntax function where we expect any IO value and we use the Scotty [liftAndCatchIO] function to transform to [ActionM] monad
      Thanks to "eta reduction" sugar syntax we can skip function arguments. f a = x a  -> f = x-}
  toActionM :: IO any -> ActionM any
  toActionM = liftAndCatchIO
  
  data PlayerInfo = PlayerInfo
    { name      :: String
    , movements :: Map String String
    } deriving (Show, Eq)
  
  data ChessInfo = ChessInfo
    { players   :: Map String PlayerInfo
    , boardGame :: Map String String
    } deriving (Show, Eq)
  
  
  