NewRule.hs

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

module Nomyx.Web.Game.NewRule where

import Prelude hiding (div)
import Control.Monad
import Control.Monad.State
import Control.Concurrent.STM
import Control.Applicative
import Data.Maybe
import Data.String
import Data.Text (Text)
import Text.Blaze.Html5                    (Html, (!), h3, pre, toValue, a)
import Text.Blaze.Html5.Attributes as A    (id, disabled, placeholder, class_)
import Text.Reform.Blaze.String            (label, textarea, inputSubmit)
import qualified Text.Reform.Blaze.String as RB
import Text.Reform.Happstack               (environment)
import Text.Reform                         ((<++), (++>), viewForm, eitherForm)
import Text.Reform.Blaze.Common            (setAttr)
import Happstack.Server                    (Response, Method(..), seeOther, toResponse, methodM, ok)
import Web.Routes.RouteT                   (showURL, liftRouteT)
import qualified Nomyx.Web.Help as Help
import Nomyx.Web.Common as NWC
import Nomyx.Core.Types as T
import Nomyx.Core.Engine
import Nomyx.Core.Session as S
default (Integer, Double, Data.Text.Text)

newRuleForm :: Maybe SubmitRule -> Bool -> NomyxForm (SubmitRule, Maybe String, Maybe String)
newRuleForm (Just sr) isGameAdmin = newRuleForm' sr isGameAdmin
newRuleForm Nothing isGameAdmin = newRuleForm' (SubmitRule "" "" "") isGameAdmin

newRuleForm' :: SubmitRule -> Bool -> NomyxForm (SubmitRule, Maybe String, Maybe String)
newRuleForm' (SubmitRule name desc code) isGameAdmin =
   (,,) <$> submitRuleForm name desc code
        <*> inputSubmit "Check"
        <*> if isGameAdmin then inputSubmit "Admin submit" else pure Nothing

submitRuleForm :: String -> String -> String -> NomyxForm SubmitRule
submitRuleForm name desc code =
   SubmitRule <$> label "Name: " ++> RB.inputText name `setAttr` class_ "ruleName"
              <*> (label "      Short description: " ++> (RB.inputText desc `setAttr` class_ "ruleDescr") <++ RB.br)
              <*> label "      Code: " ++> textarea 80 15 code `setAttr` class_ "ruleCode" `setAttr` placeholder "Enter here your rule"

viewRuleForm :: Maybe LastRule -> Bool -> Bool -> GameName -> RoutedNomyxServer Html
viewRuleForm mlr inGame isGameAdmin gn = do
   link <- showURL (NewRule gn)
   lf  <- lift $ viewForm "user" (newRuleForm (fst <$> mlr) isGameAdmin)
   ok $ do
      a "" ! A.id (toValue ruleFormAnchor)
      titleWithHelpIcon (h3 "Propose a new rule:") Help.code
      if inGame then do
         blazeForm lf link
         let msg = snd <$> mlr
         when (isJust msg) $ pre $ fromString $ fromJust msg
      else lf ! disabled ""

newRule :: GameName -> TVar Session -> RoutedNomyxServer Response
newRule gn ts = toResponse <$> do
   methodM POST
   s@(T.Session sh _ _) <- liftIO $ readTVarIO ts
   let gi = getGameByName gn s
   admin <- isGameAdmin (fromJust gi) ts
   r <- liftRouteT $ eitherForm environment "user" (newRuleForm Nothing admin)
   link <- showURL MainPage
   pn <- fromJust <$> getPlayerNumber ts
   case r of
      Right (sr, Nothing, Nothing) -> webCommand ts $ submitRule sr pn gn sh
      Right (sr, Just _, Nothing)  -> webCommand ts $ checkRule sr pn sh
      Right (sr, Nothing, Just _)  -> webCommand ts $ adminSubmitRule sr pn gn sh
      Right (_,  Just _, Just _)   -> error "Impossible new rule form result"
      (Left _) -> liftIO $ putStrLn "cannot retrieve form data"
   seeOther (link `appendAnchor` ruleFormAnchor) $ "Redirecting..."