{-# LANGUAGE OverloadedStrings, ExtendedDefaultRules, OverloadedStrings, NamedFieldPuns#-} module Web.NewGame where import Text.Blaze.Html5 hiding (map, label, br, textarea) import Prelude hiding (div) import Text.Reform import Text.Blaze.Html5.Attributes hiding (label) import Text.Reform.Blaze.String hiding (form) import qualified Text.Reform.Blaze.Common as RBC import Text.Reform.Happstack() import Control.Applicative import Types import Happstack.Server import Text.Reform.Happstack import Web.Common import Control.Monad.State import Language.Nomyx.Expression import Web.Routes.RouteT import Control.Concurrent.STM import Data.Text(Text) import Text.Blaze.Internal(string) default (Integer, Double, Data.Text.Text) data NewGameForm = NewGameForm GameName String newGameForm :: NomyxForm NewGameForm newGameForm = pure NewGameForm <*> br ++> label "Enter new game name: " ++> (inputText "") `RBC.setAttr` placeholder "Game name" <++ br <++ br <*> label "Enter game description, including a link to a place (e.g. a forum, a mailing list...) where the players can discuss their rules: " ++> br ++> (textarea 40 3 "") `RBC.setAttr` placeholder "Enter game description" `RBC.setAttr` class_ "gameDesc" newGamePage :: PlayerNumber -> RoutedNomyxServer Html newGamePage pn = do newGameLink <- showURL (SubmitNewGame pn) mf <- lift $ viewForm "user" $ newGameForm mainPage (blazeForm mf newGameLink) "New game" "New game" False newGame :: PlayerNumber -> (TVar Multi) -> RoutedNomyxServer Html newGame pn tm = do methodM POST r <- liftRouteT $ eitherForm environment "user" newGameForm link <- showURL $ Noop pn case r of Left _ -> error $ "error: newGame" Right (NewGameForm name desc) -> webCommand tm pn $ MultiNewGame name desc pn seeOther link $ string "Redirecting..."