From 10f6e8f4cce3303f53df359e0f40fcb5d584e85d Mon Sep 17 00:00:00 2001
From: Clint Adams <clint@softwarefreedom.org>
Date: Wed, 24 Oct 2012 17:16:15 -0400
Subject: Category enablement self-service.

---
 Handler/Category.hs | 36 ++++++++++++++++++++++++++++++++++++
 1 file changed, 36 insertions(+)
 create mode 100644 Handler/Category.hs

(limited to 'Handler/Category.hs')

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
-- 
cgit v1.2.3