{-# LANGUAGE RecordWildCards, OverloadedStrings #-} {-# OPTIONS_GHC -F -pgmFhsx2hs #-} module Clckwrks.Page.Admin.EditFeedConfig where import Clckwrks (ClckURL(Admin), AdminURL(Console), query, update) import Clckwrks.Admin.Template (template) import Clckwrks.Page.Acid (GetFeedConfig(..), SetFeedConfig(..)) import Clckwrks.Page.Monad (PageConfig(pageClckURL), PageM, PageForm, PageFormError) import Clckwrks.Page.Types (FeedConfig(..)) import Clckwrks.Page.URL (PageURL(..)) import Control.Applicative ((<$>), (<*), (<*>)) import Control.Monad.Reader (ask) import qualified Data.Text as T import Data.Text.Lazy (Text) import Happstack.Server (Response, seeOther, toResponse) import HSP.XML import HSP.XMLGenerator import Text.Reform import Text.Reform.Happstack import Text.Reform.HSP.Text import Web.Routes (showURL) editFeedConfig :: PageURL -> PageM Response editFeedConfig here = do feedConfig <- query GetFeedConfig action <- showURL here template "edit feed config" () $ <%> <% reform (form action) "ep" updateFeedConfig Nothing (feedConfigForm feedConfig) %> where updateFeedConfig :: FeedConfig -> PageM Response updateFeedConfig fc = do update (SetFeedConfig fc) showURL <- pageClckURL <$> ask seeOther (showURL (Admin Console) []) (toResponse ()) feedConfigForm :: FeedConfig -> PageForm FeedConfig feedConfigForm fc@FeedConfig{..} = divHorizontal $ fieldset $ ((,) <$> (divControlGroup (label' "Feed Title" ++> (divControls $ inputText feedTitle))) <*> (divControlGroup (label' "Default Author Name" ++> (divControls $ inputText feedAuthorName))) <* (divControlGroup (divControls $ (inputSubmit (T.pack "Update") `setAttrs`[("class" := "btn") :: Attr Text Text]))) ) `transformEither` toFeedConfig where label' str = (labelText str `setAttrs` [("class":="control-label") :: Attr Text Text]) divHorizontal = mapView (\xml -> [
<% xml %>
]) divControlGroup = mapView (\xml -> [
<% xml %>
]) divControls = mapView (\xml -> [
<% xml %>
]) toFeedConfig :: (T.Text, T.Text) -> Either PageFormError FeedConfig toFeedConfig (ttl, athr) = Right $ fc { feedTitle = ttl , feedAuthorName = athr }