From 10f6e8f4cce3303f53df359e0f40fcb5d584e85d Mon Sep 17 00:00:00 2001 From: Clint Adams Date: Wed, 24 Oct 2012 17:16:15 -0400 Subject: Category enablement self-service. --- Handler/Category.hs | 36 ++++++++++++++++++++++++++++++++++++ templates/categorypage.hamlet | 6 ++++++ 2 files changed, 42 insertions(+) create mode 100644 Handler/Category.hs create mode 100644 templates/categorypage.hamlet diff --git a/Handler/Category.hs b/Handler/Category.hs new file mode 100644 index 0000000..62928a2 --- /dev/null +++ b/Handler/Category.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE TupleSections, OverloadedStrings #-} +module Handler.Category where + +import Import +import Data.Maybe (fromMaybe) +import qualified Data.Text as T + +getCategoryR :: TimeCategoryId -> Handler RepHtml +getCategoryR tcid = do + cat <- runDB $ get404 tcid + (formWidget, formEnctype) <- generateFormPost (timeCategoryForm cat) + defaultLayout $ do + aDomId <- lift newIdent + (setTitle . toHtml) ("Time category " `T.append` timeCategoryName cat) + $(widgetFile "categorypage") + +postCategoryR :: TimeCategoryId -> Handler RepHtml +postCategoryR tcid = do + cat <- runDB $ get404 tcid + ((result, formWidget), formEnctype) <- runFormPost (timeCategoryForm cat) + _ <- case result of + FormSuccess res -> (runDB $ replace tcid res) >> return () + _ -> return () + + defaultLayout $ do + aDomId <- lift newIdent + (setTitle . toHtml) ("Time category " `T.append` timeCategoryName cat) + $(widgetFile "categorypage") + +timeCategoryAForm :: TimeCategory -> AForm App App TimeCategory +timeCategoryAForm tc = TimeCategory + <$> pure (timeCategoryName tc) + <*> areq checkBoxField "Disable" (Just (timeCategoryDisabled tc)) + +timeCategoryForm :: TimeCategory -> Html -> MForm App App (FormResult TimeCategory, Widget) +timeCategoryForm tc h = renderDivs (timeCategoryAForm tc) h diff --git a/templates/categorypage.hamlet b/templates/categorypage.hamlet new file mode 100644 index 0000000..fb4a756 --- /dev/null +++ b/templates/categorypage.hamlet @@ -0,0 +1,6 @@ +

#{timeCategoryName cat} + +

+

+ ^{formWidget} + -- cgit v1.2.1