NewGame.hs

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

module Nomyx.Web.NewGame where

import Prelude hiding (div)
import Text.Reform
import Text.Blaze.Html5.Attributes hiding (label)
import Text.Reform.Blaze.String as RB hiding (form)
import Text.Reform.Happstack
import qualified Text.Reform.Blaze.Common as RBC
import Control.Applicative
import Control.Monad.State
import Control.Concurrent.STM
import Happstack.Server
import Web.Routes.RouteT
import Data.Text(Text)
import Data.Maybe
import Nomyx.Core.Engine
import Nomyx.Web.Common
import qualified Nomyx.Core.Session as S
import Nomyx.Core.Types
default (Integer, Double, Data.Text.Text)

data NewGameForm = NewGameForm GameName GameDesc Bool (Maybe GameName)

newGameForm :: Bool -> [GameName] -> NomyxForm NewGameForm
newGameForm admin gns = pure NewGameForm
   <*> (br ++> errorList ++> label "Enter new game name: " ++> RB.inputText "" `transformEither` fieldRequired GameNameRequired `RBC.setAttr` placeholder "Game name"  <++ br <++ br)
   <*> newGameDesc
   <*> (if admin then label "Public game? " ++> (RB.inputCheckbox True) else pure False) <++ br
   <*> (label "Fork from existing game (optional):" ++> RB.select ((Nothing, "--") : (map (\gn -> (Just gn, gn)) gns)) isNothing) <++ br <++ br

newGameDesc :: NomyxForm GameDesc
newGameDesc = pure GameDesc <*> label "Enter game description:" ++> br ++> textarea 40 3 "" `RBC.setAttr` placeholder "Enter game description" `RBC.setAttr` class_ "gameDesc" <++ br <++ br
                            <*> label "Enter a link to a place where the players can discuss their rules (e.g. a forum, a mailing list...): " ++> br ++> RB.inputText "" `RBC.setAttr` placeholder "Forum URL (including http://...)" `RBC.setAttr` class_ "forum" <++ br <++ br

gameNameRequired :: String -> Either NomyxError String
gameNameRequired = fieldRequired GameNameRequired

newGamePage :: TVar Session -> RoutedNomyxServer Response
newGamePage ts = toResponse <$> do
   admin <- isAdmin ts
   gis <- getPublicGames ts
   let gameNames = map (_gameName . _game . _loggedGame) gis
   newGameLink <- showURL SubmitNewGame
   mf <- lift $ viewForm "user" $ newGameForm admin gameNames
   mainPage "New game"
            "New game"
            (blazeForm mf newGameLink)
            False
            True

newGamePost :: TVar Session -> RoutedNomyxServer Response
newGamePost ts = toResponse <$> do
   methodM POST
   admin <- isAdmin ts
   gis <- getPublicGames ts
   let gameNames = map (_gameName . _game . _loggedGame) gis
   r <- liftRouteT $ eitherForm environment "user" (newGameForm admin gameNames)
   link <- showURL MainPage
   newGameLink <- showURL SubmitNewGame
   pn <- fromJust <$> getPlayerNumber ts
   case r of
      Left errorForm -> mainPage  "New game" "New game" (blazeForm errorForm newGameLink) False True
      Right (NewGameForm name desc isPublic mforkFrom) -> do
         case mforkFrom of
            Nothing       -> webCommand ts $ S.newGame name desc pn isPublic
            Just forkFrom -> webCommand ts $ S.forkGame forkFrom name desc False pn
         seeOther link "Redirecting..."