Add category page

1 files changed, 117 insertions, 0 deletions

diff --git a/client/src/View/Category/Form.hs b/client/src/View/Category/Form.hs
new file mode 100644
index 0000000..d91fc2e
--- /dev/null
+++ b/client/src/View/Category/Form.hs
@@ -0,0 +1,117 @@
+module View.Category.Form
+  ( view
+  , In(..)
+  , Operation(..)
+  ) where
+
+import           Control.Monad.IO.Class     (liftIO)
+import           Data.Aeson                 (Value)
+import qualified Data.Aeson                 as Aeson
+import qualified Data.Maybe                 as Maybe
+import           Data.Text                  (Text)
+import qualified Data.Text                  as T
+import qualified Data.Time.Calendar         as Calendar
+import qualified Data.Time.Clock            as Time
+import           Data.Validation            (Validation)
+import qualified Data.Validation            as V
+import           Reflex.Dom                 (Dynamic, Event, MonadWidget)
+import qualified Reflex.Dom                 as R
+
+import           Common.Model               (Category (..),
+                                             CreateCategoryForm (..),
+                                             EditCategoryForm (..))
+import qualified Common.Msg                 as Msg
+import qualified Common.Util.Time           as TimeUtil
+import qualified Common.Validation.Category as CategoryValidation
+import qualified Component.Input            as Input
+import qualified Component.Modal            as Modal
+import qualified Component.ModalForm        as ModalForm
+import qualified Util.Ajax                  as Ajax
+
+data In = In
+  { _in_operation :: Operation
+  }
+
+data Operation
+  = New
+  | Clone Category
+  | Edit Category
+
+view :: forall t m a. MonadWidget t m => In -> Modal.Content t m
+view input cancel = do
+
+  rec
+    let reset = R.leftmost
+          [ "" <$ ModalForm._out_cancel modalForm
+          , "" <$ ModalForm._out_validate modalForm
+          , "" <$ cancel
+          ]
+
+    modalForm <- ModalForm.view $ ModalForm.In
+      { ModalForm._in_headerLabel = headerLabel
+      , ModalForm._in_ajax        = ajax "/api/category"
+      , ModalForm._in_form        = form reset (ModalForm._out_confirm modalForm)
+      }
+
+  return (ModalForm._out_hide modalForm, ModalForm._out_validate modalForm)
+
+  where
+
+    form
+      :: Event t String
+      -> Event t ()
+      -> m (Dynamic t (Validation Text Value))
+    form reset confirm = do
+      name <- Input._out_raw <$> (Input.view
+        (Input.defaultIn
+          { Input._in_label = Msg.get Msg.Category_Name
+          , Input._in_initialValue = name
+          , Input._in_validation = CategoryValidation.name
+          })
+        (name <$ reset)
+        confirm)
+
+      color <- Input._out_raw <$> (Input.view
+        (Input.defaultIn
+          { Input._in_label = Msg.get Msg.Category_Color
+          , Input._in_initialValue = color
+          , Input._in_inputType = "color"
+          , Input._in_hasResetButton = False
+          , Input._in_validation = CategoryValidation.color
+          })
+        (color <$ reset)
+        confirm)
+
+      return $ do
+        n <- name
+        c <- color
+        return . V.Success $ mkPayload n c
+
+    op = _in_operation input
+
+    name =
+      case op of
+        New     -> ""
+        Clone c -> _category_name c
+        Edit c  -> _category_name c
+
+    color =
+      case op of
+        New     -> ""
+        Clone c -> _category_color c
+        Edit c  -> _category_color c
+
+    ajax =
+      case op of
+        Edit _ -> Ajax.put
+        _      -> Ajax.post
+
+    headerLabel =
+      case op of
+        Edit _ -> Msg.get Msg.Category_Edit
+        _      -> Msg.get Msg.Category_Add
+
+    mkPayload =
+      case op of
+        Edit i -> \a b -> Aeson.toJSON $ EditCategoryForm (_category_id i) a b
+        _      -> \a b -> Aeson.toJSON $ CreateCategoryForm a b