aboutsummaryrefslogtreecommitdiff
path: root/client/src/View/Category
diff options
context:
space:
mode:
Diffstat (limited to 'client/src/View/Category')
-rw-r--r--client/src/View/Category/Category.hs94
-rw-r--r--client/src/View/Category/Form.hs117
-rw-r--r--client/src/View/Category/Reducer.hs59
-rw-r--r--client/src/View/Category/Table.hs93
4 files changed, 0 insertions, 363 deletions
diff --git a/client/src/View/Category/Category.hs b/client/src/View/Category/Category.hs
deleted file mode 100644
index 5b41bb6..0000000
--- a/client/src/View/Category/Category.hs
+++ /dev/null
@@ -1,94 +0,0 @@
-{-# LANGUAGE ExplicitForAll #-}
-
-module View.Category.Category
- ( view
- , In(..)
- ) where
-
-import Data.Aeson (FromJSON)
-import qualified Data.Maybe as Maybe
-import qualified Data.Text as T
-import Reflex.Dom (Dynamic, Event, MonadWidget)
-import qualified Reflex.Dom as R
-
-import Common.Model (Category, CategoryPage (..), Currency,
- User, UserId)
-import qualified Common.Msg as Msg
-
-import qualified Component.Button as Button
-import qualified Component.Modal as Modal
-import qualified Component.Pages as Pages
-import Loadable (Loadable (..))
-import qualified Loadable
-import qualified Util.Ajax as AjaxUtil
-import qualified Util.Reflex as ReflexUtil
-import qualified Util.Reflex as ReflexUtil
-import qualified View.Category.Form as Form
-import qualified View.Category.Reducer as Reducer
-import qualified View.Category.Table as Table
-
-data In t = In
- { _in_users :: [User]
- , _in_currentUser :: UserId
- , _in_currency :: Currency
- }
-
-view :: forall t m. MonadWidget t m => In t -> m ()
-view input = do
- rec
- categoryPage <- Reducer.reducer $ Reducer.In
- { Reducer._in_page = page
- , Reducer._in_addCategory = R.leftmost [ headerAddCategory, tableAddCategory ]
- , Reducer._in_editCategory = editCategory
- , Reducer._in_deleteCategory = deleteCategory
- }
-
- let eventFromResult :: forall a. ((Event t (), Table.Out t, Pages.Out t) -> Event t a) -> m (Event t a)
- eventFromResult op = ReflexUtil.flatten $ (Maybe.fromMaybe R.never . fmap op) <$> result
-
- page <- eventFromResult $ Pages._out_newPage . (\(_, _, c) -> c)
- headerAddCategory <- eventFromResult $ (\(a, _, _) -> a)
- tableAddCategory <- eventFromResult $ Table._out_add . (\(_, b, _) -> b)
- editCategory <- eventFromResult $ Table._out_edit . (\(_, b, _) -> b)
- deleteCategory <- eventFromResult $ Table._out_delete . (\(_, b, _) -> b)
-
- result <- Loadable.viewShowValueWhileLoading categoryPage $
- \(CategoryPage page categories usedCategories count) -> do
- header <- headerView
-
- table <- Table.view $ Table.In
- { Table._in_currentUser = _in_currentUser input
- , Table._in_currency = _in_currency input
- , Table._in_categories = categories
- , Table._in_usedCategories = usedCategories
- , Table._in_users = _in_users input
- }
-
- pages <- Pages.view $ Pages.In
- { Pages._in_total = R.constDyn count
- , Pages._in_perPage = Reducer.perPage
- , Pages._in_page = page
- }
-
- return (header, table, pages)
-
- return ()
-
-headerView :: forall t m. MonadWidget t m => m (Event t ())
-headerView =
- R.divClass "withMargin" $
- R.divClass "titleButton" $ do
- R.el "h1" $
- R.text $
- Msg.get Msg.Category_Title
-
- addCategory <- Button._out_clic <$>
- (Button.view . Button.defaultIn . R.text $
- Msg.get Msg.Category_Add)
-
- addCategory <- Modal.view $ Modal.In
- { Modal._in_show = addCategory
- , Modal._in_content = Form.view $ Form.In { Form._in_operation = Form.New }
- }
-
- return addCategory
diff --git a/client/src/View/Category/Form.hs b/client/src/View/Category/Form.hs
deleted file mode 100644
index d91fc2e..0000000
--- a/client/src/View/Category/Form.hs
+++ /dev/null
@@ -1,117 +0,0 @@
-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
diff --git a/client/src/View/Category/Reducer.hs b/client/src/View/Category/Reducer.hs
deleted file mode 100644
index 5ad0ddb..0000000
--- a/client/src/View/Category/Reducer.hs
+++ /dev/null
@@ -1,59 +0,0 @@
-module View.Category.Reducer
- ( perPage
- , reducer
- , In(..)
- ) where
-
-import Data.Text (Text)
-import qualified Data.Text as T
-import Reflex.Dom (Dynamic, Event, MonadWidget)
-import qualified Reflex.Dom as R
-
-import Common.Model (CategoryPage)
-
-import Loadable (Loadable (..))
-import qualified Loadable as Loadable
-import qualified Util.Ajax as AjaxUtil
-import qualified Util.Either as EitherUtil
-
-perPage :: Int
-perPage = 7
-
-data In t a b c = In
- { _in_page :: Event t Int
- , _in_addCategory :: Event t a
- , _in_editCategory :: Event t b
- , _in_deleteCategory :: Event t c
- }
-
-reducer :: forall t m a b c. MonadWidget t m => In t a b c -> m (Dynamic t (Loadable CategoryPage))
-reducer input = do
-
- postBuild <- R.getPostBuild
-
- currentPage <- R.holdDyn 1 (_in_page input)
-
- let loadPage =
- R.leftmost
- [ 1 <$ postBuild
- , _in_page input
- , 1 <$ _in_addCategory input
- , R.tag (R.current currentPage) (_in_editCategory input)
- , R.tag (R.current currentPage) (_in_deleteCategory input)
- ]
-
- getResult <- AjaxUtil.get $ fmap pageUrl loadPage
-
- R.holdDyn
- Loading
- (R.leftmost
- [ Loading <$ loadPage
- , Loadable.fromEither <$> getResult
- ])
-
- where
- pageUrl p =
- "api/categories?page="
- <> (T.pack . show $ p)
- <> "&perPage="
- <> (T.pack . show $ perPage)
diff --git a/client/src/View/Category/Table.hs b/client/src/View/Category/Table.hs
deleted file mode 100644
index 90d013d..0000000
--- a/client/src/View/Category/Table.hs
+++ /dev/null
@@ -1,93 +0,0 @@
-module View.Category.Table
- ( view
- , In(..)
- , Out(..)
- ) where
-
-import qualified Data.Maybe as Maybe
-import Data.Text (Text)
-import qualified Data.Text as T
-import Reflex.Dom (Dynamic, Event, MonadWidget)
-import qualified Reflex.Dom as R
-
-import Common.Model (Category (..), CategoryId, Currency,
- User (..), UserId)
-import qualified Common.Model as CM
-import qualified Common.Msg as Msg
-import qualified Common.View.Format as Format
-
-import qualified Component.ConfirmDialog as ConfirmDialog
-import qualified Component.Table as Table
-import qualified Component.Tag as Tag
-import qualified Util.Ajax as Ajax
-import qualified Util.Either as EitherUtil
-import qualified View.Category.Form as Form
-
-data In t = In
- { _in_currentUser :: UserId
- , _in_currency :: Currency
- , _in_categories :: [Category]
- , _in_usedCategories :: [CategoryId]
- , _in_users :: [User]
- }
-
-data Out t = Out
- { _out_add :: Event t ()
- , _out_edit :: Event t ()
- , _out_delete :: Event t ()
- }
-
-view :: forall t m. MonadWidget t m => In t -> m (Out t)
-view input = do
-
- table <- Table.view $ Table.In
- { Table._in_headerLabel = headerLabel
- , Table._in_rows = _in_categories input
- , Table._in_cell = cell (_in_users input) (_in_currency input)
- , Table._in_cloneModal = \category ->
- Form.view $ Form.In
- { Form._in_operation = Form.Clone category
- }
- , Table._in_editModal = \category ->
- Form.view $ Form.In
- { Form._in_operation = Form.Edit category
- }
- , Table._in_deleteModal = \category ->
- ConfirmDialog.view $ ConfirmDialog.In
- { ConfirmDialog._in_header = Msg.get Msg.Category_DeleteConfirm
- , ConfirmDialog._in_confirm = \e -> do
- res <- Ajax.delete
- (R.constDyn $ T.concat ["/api/category/", T.pack . show $ _category_id category])
- e
- return $ () <$ R.fmapMaybe EitherUtil.eitherToMaybe res
- }
- , Table._in_canEdit = const True
- , Table._in_canDelete = not . flip elem (_in_usedCategories input) . _category_id
- }
-
- return $ Out
- { _out_add = Table._out_add table
- , _out_edit = Table._out_edit table
- , _out_delete = Table._out_delete table
- }
-
-data Header
- = NameHeader
- | ColorHeader
- deriving (Eq, Show, Bounded, Enum)
-
-headerLabel :: Header -> Text
-headerLabel NameHeader = Msg.get Msg.Category_Name
-headerLabel ColorHeader = Msg.get Msg.Category_Color
-
-cell :: forall t m. MonadWidget t m => [User] -> Currency -> Header -> Category -> m ()
-cell users currency header category =
- case header of
- NameHeader ->
- R.text $ _category_name category
-
- ColorHeader ->
- Tag.view $ Tag.In
- { Tag._in_text = _category_name category
- , Tag._in_color = _category_color category
- }
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-23 12:27:21 +0000