Rules.hs

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

module Nomyx.Web.Game.Rules where

import           Control.Applicative
import           Control.Monad
import           Data.Maybe
import           Data.String
import           Data.Text                   (Text, unpack)
import           Nomyx.Language
import           Nomyx.Core.Engine
import           Nomyx.Core.Profile          as Profile
import           Nomyx.Web.Common            as NWC
import           Nomyx.Web.Game.Actions
import qualified Nomyx.Web.Help              as Help
import           Prelude                     hiding (div)
import           Text.Blaze.Html5            as H (Html, a, br, div, h2, h3, h4,
                                                   img, li, p, table, td, thead,
                                                   toHtml, toValue, tr, ul, (!))
import           Text.Blaze.Html5.Attributes as A (class_, href, id, src, title)
import           Happstack.Server            (ok)
import           Nomyx.Web.Types
default (Integer, Double, Data.Text.Text)

viewAllRules :: PlayerNumber -> Game -> RoutedNomyxServer Html
viewAllRules pn g = do
  vrs <- viewRules pn g (_rules g)
  ok $ do
  div ! class_ "ruleList" $ do
   h3 "Constitution"
   ul $ do
     li "Active rules"
     ul $ viewRuleNames (activeRules g)
     li "Pending rules"
     ul $ viewRuleNames (pendingRules g)
     li "Suppressed rules"
     ul $ viewRuleNames (rejectedRules g)
  div ! class_ "rules" $ vrs

viewRuleNames :: [RuleInfo] -> Html
viewRuleNames nrs = mapM_  viewRuleName nrs

viewRuleName :: RuleInfo -> Html
viewRuleName ri = do
  let name = fromString $ (show $ _rNumber ri) ++ " " ++ (_rName $ _rRuleTemplate ri)
  li $ H.a name ! A.class_ "ruleName" ! (href $ toValue $ "?ruleNumber=" ++ (show $ _rNumber ri))

viewRules :: PlayerNumber -> Game -> [RuleInfo] -> RoutedNomyxServer Html
viewRules pn g nrs = do
  (vrs :: [Html]) <- mapM (viewRule pn g) nrs
  ok $ sequence_ vrs

viewRule :: PlayerNumber -> Game -> RuleInfo -> RoutedNomyxServer Html
viewRule pn g ri = do
   vrm <- viewRuleMain pn g ri
   vrds <- mapM viewRuleDecl (_rModules ri) 
   ok $ div ! A.class_ "rule" ! A.id (toValue ("rule" ++ (show $ _rNumber ri))) $ do
      vrm
      sequence_ vrds

viewRuleMain :: PlayerNumber -> Game -> RuleInfo -> RoutedNomyxServer Html
viewRuleMain pn g ri@(RuleInfo rn proposedBy _ status assessBy mods (RuleTemplate name desc code author picture _ _))= do
  ios <- viewIORule pn g ri
  ok $ div ! A.class_ "ruleMain" $ do
      let pl = if (proposedBy == 0)
               then "System"
               else "player " ++ fromMaybe (show proposedBy) (_playerName <$> (Profile.getPlayerInfo g proposedBy))
      viewRuleHead name picture desc author
      let assessedBy = case assessBy of
           Nothing -> fromString "not assessed"
           Just 0  -> fromString "System"
           Just a  -> H.a (fromString $ "rule " ++ show a) ! (href $ toValue $ "?ruleNumber=" ++ (show a))
      
      fromString $ "This rule was proposed by " ++ pl
      case status of
          Active -> (fromString " and activated by ") >> assessedBy >> (fromString ".") ! A.id "assessedBy"
          Reject -> (fromString " and deleted by ") >> assessedBy >> (fromString ".") ! A.id "assessedBy"
          Pending -> fromString "."
      ios
      viewRuleCode code
      br
      sequence_ $ map (declLink rn) (map _modPath mods)


viewRuleDecl :: ModuleInfo -> RoutedNomyxServer Html
viewRuleDecl (ModuleInfo path cont) = do
   ok $ div ! A.class_ "ruleDecl" ! A.id (toValue ("ruleDecl" ++ (idEncode path))) $ do
      displayCode $ unpack cont
       
declLink :: RuleNumber -> FilePath -> Html
declLink rn modPath = do
   H.a (fromString modPath) ! (href $ toValue $ "?ruleNumber=" ++ (show rn) ++ "&decl=" ++ (idEncode modPath))
   br