Infos.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ExtendedDefaultRules #-}

module Nomyx.Web.Game.Infos where

import Prelude hiding (div)
import Control.Monad
import Control.Monad.State
import Control.Applicative
import Data.Monoid
import Data.Maybe
import Data.String
import Data.List
import Data.List.Split
import Data.Text (Text)
import Text.Blaze.Html5                    (Html, div, (!), p, table, td, tr, h2, h3, h4, pre, toValue, br, a)
import Text.Blaze.Html5.Attributes as A    (id, class_, href, title)
import Text.Reform.Blaze.String            (inputHidden)
import Text.Reform                         (viewForm, eitherForm)
import Text.Reform.Happstack               (environment)
import Happstack.Server                    (Response, Method(..), seeOther, toResponse, methodM, ok)
import Web.Routes.RouteT                   (showURL, liftRouteT)
import Nomyx.Language
import Nomyx.Web.Common as NWC
import Nomyx.Web.Help as Help
import Nomyx.Web.Types
import Nomyx.Core.Engine (Game, GameName, getVictorious, _gameName, _gameDesc, _players, _desc, _forumURL)
import Nomyx.Core.Session as S
import Nomyx.Core.Profile as Profile

default (Integer, Double, Data.Text.Text)

viewGameDesc :: Game -> Maybe PlayerNumber -> Maybe PlayerNumber -> Bool -> RoutedNomyxServer Html
viewGameDesc g mpn playAs gameAdmin = do
   let gn = _gameName g
   let logged = isJust mpn
   let modJoin = modalJoin gn logged
   let modLeave = modalLeave gn logged
   let modDel = modalDel gn logged
   let isInGame = maybe False (\pn -> pn `elem` (_playerNumber <$> _players g)) mpn
   vp <- viewPlayers (_players g) gn gameAdmin
   ok $ do
      h3 $ fromString $ _gameName g
      when (isJust playAs) $ h4 $ fromString $ "You are playing as player " ++ (show $ fromJust playAs)
      p $ pre $ fromString (_desc $ _gameDesc g)
      p $ h4 $ "This game is discussed in the " >> a "Forum" ! (A.href $ toValue (_forumURL $ _gameDesc g)) >> "."
      p $ h4 "Players in game (with their player number):"
      when gameAdmin "(click on a player name to \"play as\" this player)"
      vp
      p $ viewVictory g
      if isInGame
         then a "Leave" ! (href $ toValue $ "#openModalLeave" ++ gn) ! A.class_ "button"
         else a "Join"  ! (href $ toValue $ "#openModalJoin" ++ gn)  ! A.class_ "button" ! (title $ toValue Help.joinGame)
      when gameAdmin $ a "Del"   ! (href $ toValue $ "#openModalDel" ++ gn) ! A.class_ "button"
      modJoin >> modLeave >> modDel

modalWindow :: Text -> String -> String -> String -> Html
modalWindow link buttonTitle question modelRef = do
      div ! A.id (toValue $ modelRef) ! A.class_ "modalWindow" $ do
         div $ do
            h2 (fromString question)
            a "Cancel"                 ! (href $ toValue $ showRelURL MainPage) ! A.class_ "modalButton"
            a (fromString buttonTitle) ! (href $ toValue link) ! A.class_ "modalButton"

modalLeave :: GameName -> Bool -> Html
modalLeave gn logged = modalWindow
   (defLink (LeaveGame gn) logged)
   "Leave"
   "Do you really want to leave? You will loose your assets in the game (for example, your bank account)."
   ("openModalLeave" ++ gn)

modalJoin :: GameName -> Bool -> Html
modalJoin gn logged = modalWindow
   (defLink (JoinGame gn) logged)
   "Join"
   "Joining the game. Please register in the forum (see the link) and introduce yourself to the other players! If you do not whish to play, you can just view the game."
   ("openModalJoin" ++ gn)

modalDel :: GameName -> Bool -> Html
modalDel gn logged = modalWindow
   (defLink (DelGame gn) logged)
   "Delete"
   ("Delete the game " ++ gn ++ " ?")
   ("openModalDel" ++ gn)

viewPlayers :: [PlayerInfo] -> GameName -> Bool -> RoutedNomyxServer Html
viewPlayers pis gn gameAdmin = do
   let plChunks = transpose $ chunksOf 15 (sort pis)
   vp <- mapM mkRow plChunks
   ok $ table $ mconcat vp
   where mkRow :: [PlayerInfo] -> RoutedNomyxServer Html
         mkRow row = do
         r <- mapM (viewPlayer gn gameAdmin) row
         ok $ tr $ mconcat r

viewPlayer :: GameName -> Bool -> PlayerInfo -> RoutedNomyxServer Html
viewPlayer gn gameAdmin (PlayerInfo pn name _) = do
   pad <- playAsDiv pn gn
   let inf = fromString name
   ok $ do
    pad
    td $ div ! A.id "playerNumber" $ fromString $ show pn
    td $ div ! A.id "playerName" $ if gameAdmin
       then a inf ! (href $ toValue $ "#openModalPlayAs" ++ show pn)
       else inf

playAsDiv :: PlayerNumber -> GameName -> RoutedNomyxServer Html
playAsDiv pn gn = do
   paf <- liftRouteT $ lift $ viewForm "user" $ playAsForm $ Just pn
   ok $ do
      let cancel = a "Cancel" ! (href $ toValue $ showRelURL MainPage) ! A.class_ "modalButton"
      div ! A.id (toValue $ "openModalPlayAs" ++ show pn) ! A.class_ "modalWindow" $ do
         div $ do
            h2 $ fromString $ "When you are in a private game, you can play instead of any players. This allows you to test " ++
               "the result of their actions."
            blazeForm (h2 (fromString $ "Play as player " ++ show pn ++ "?  ") >> paf) (showRelURL $ SubmitPlayAs gn)
            br
            cancel

playAsForm :: Maybe PlayerNumber -> NomyxForm String
playAsForm pn = inputHidden (show pn)

viewVictory :: Game -> Html
viewVictory g = do
    let vs = _playerName <$> mapMaybe (Profile.getPlayerInfo g) (getVictorious g)
    case vs of
        []   -> br
        a:[] -> h3 $ fromString $ "Player " ++ show a ++ " won the game!"
        a:bs -> h3 $ fromString $ "Players " ++ intercalate ", " bs ++ " and " ++ a ++ " won the game!"

newPlayAs :: GameName -> RoutedNomyxServer Response
newPlayAs gn = toResponse <$> do
   methodM POST
   p <- liftRouteT $ lift $ eitherForm environment "user" $ playAsForm Nothing
   pn <- fromJust <$> getPlayerNumber
   case p of
      Right playAs -> do
         webCommand $ S.playAs (read playAs) pn gn
         seeOther (showRelURL MainPage) "Redirecting..."
      (Left errorForm) -> mainPage  "Admin settings" "Admin settings" (blazeForm errorForm $ showRelURL $ SubmitPlayAs gn) False True