Category enablement self-service.

2 files changed, 42 insertions, 0 deletions

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 @@
+<h1>#{timeCategoryName cat}
+
+<p>
+  <form method=post action=@{CategoryR tcid}#form enctype=#{formEnctype}>
+    ^{formWidget}
+    <input type="submit" value="Submit">