Settings.hs

{-# LANGUAGE OverloadedStrings, ExtendedDefaultRules, OverloadedStrings, NamedFieldPuns#-}


module Web.Settings where

import Text.Blaze.Html5 hiding (map, label, br)

import Prelude hiding (div)
import Text.Reform
import Text.Reform.Blaze.String hiding (form)
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 Utils
import Control.Concurrent.STM
import Data.Maybe
import Data.Text(Text)
import Text.Blaze.Internal(string)
default (Integer, Double, Data.Text.Text)



settingsForm :: (Maybe MailSettings) -> NomyxForm MailSettings
settingsForm (Just (MailSettings {mailTo, mailNewRule})) = settingsForm' mailTo mailNewRule
settingsForm Nothing = settingsForm' "" True

settingsForm':: String -> Bool -> NomyxForm MailSettings
settingsForm' mailTo mailNewRule = pure MailSettings <*> label "Please enter your mail: " ++> inputText mailTo <++ br
                             <*> pure True --label " send mail on new input needed from you: " ++> inputCheckbox True <++ label " " <++ br
                             <*> inputCheckbox mailNewRule <++ label " I want to be notified by email if a player proposes a new rule (recommended)" <++ br
                             <*> pure True --label " send mail on new output: " ++> inputCheckbox True <++ label " "
                             <*> pure True

settingsPage :: PlayerNumber -> MailSettings -> RoutedNomyxServer Html
settingsPage pn ms = do
   settingsLink <- showURL (SubmitSettings pn)
   mf <- lift $ viewForm "user" $ settingsForm (Just ms)
   mainPage (blazeForm mf settingsLink)
             "Player settings"
             "Player settings"
             False


settings :: PlayerNumber -> (TVar Multi) -> RoutedNomyxServer Html
settings pn tm  = do
   pm <- evalCommand tm $ findPlayer' pn
   settingsPage pn $ mMail $ fromJust pm


newSettings :: PlayerNumber -> (TVar Multi) -> RoutedNomyxServer Html
newSettings pn tm = do
   methodM POST
   r <- liftRouteT $ eitherForm environment "user" $ settingsForm Nothing
   link <- showURL $ Noop pn
   case r of
       Right ms -> webCommand tm pn $ MultiMailSettings ms pn
       (Left _) -> liftRouteT $ lift $ putStrLn $ "cannot retrieve form data"
   seeOther link $ string "Redirecting..."