aboutsummaryrefslogtreecommitdiff
path: root/client/src/View/Income
diff options
context:
space:
mode:
Diffstat (limited to 'client/src/View/Income')
-rw-r--r--client/src/View/Income/Form.hs119
-rw-r--r--client/src/View/Income/Header.hs77
-rw-r--r--client/src/View/Income/Income.hs75
-rw-r--r--client/src/View/Income/Reducer.hs59
-rw-r--r--client/src/View/Income/Table.hs93
5 files changed, 0 insertions, 423 deletions
diff --git a/client/src/View/Income/Form.hs b/client/src/View/Income/Form.hs
deleted file mode 100644
index 59f6a0d..0000000
--- a/client/src/View/Income/Form.hs
+++ /dev/null
@@ -1,119 +0,0 @@
-module View.Income.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 (CreateIncomeForm (..),
- EditIncomeForm (..), Income (..))
-import qualified Common.Msg as Msg
-import qualified Common.Util.Time as TimeUtil
-import qualified Common.Validation.Income as IncomeValidation
-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 Income
- | Edit Income
-
-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/income"
- , 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
- amount <- Input._out_raw <$> (Input.view
- (Input.defaultIn
- { Input._in_label = Msg.get Msg.Income_Amount
- , Input._in_initialValue = amount
- , Input._in_validation = IncomeValidation.amount
- })
- (amount <$ reset)
- confirm)
-
- currentDay <- liftIO $ Time.getCurrentTime >>= TimeUtil.timeToDay
-
- let initialDate = T.pack . Calendar.showGregorian $ date currentDay
-
- date <- Input._out_raw <$> (Input.view
- (Input.defaultIn
- { Input._in_label = Msg.get Msg.Income_Date
- , Input._in_initialValue = initialDate
- , Input._in_inputType = "date"
- , Input._in_hasResetButton = False
- , Input._in_validation = IncomeValidation.date
- })
- (initialDate <$ reset)
- confirm)
-
- return $ do
- a <- amount
- d <- date
- return . V.Success $ mkPayload a d
-
- op = _in_operation input
-
- amount =
- case op of
- New -> ""
- Clone i -> T.pack . show . _income_amount $ i
- Edit i -> T.pack . show . _income_amount $ i
-
- date currentDay =
- case op of
- Edit i -> _income_date i
- _ -> currentDay
-
- ajax =
- case op of
- Edit _ -> Ajax.put
- _ -> Ajax.post
-
- headerLabel =
- case op of
- Edit _ -> Msg.get Msg.Income_Edit
- _ -> Msg.get Msg.Income_AddLong
-
- mkPayload =
- case op of
- Edit i -> \a b -> Aeson.toJSON $ EditIncomeForm (_income_id i) a b
- _ -> \a b -> Aeson.toJSON $ CreateIncomeForm a b
diff --git a/client/src/View/Income/Header.hs b/client/src/View/Income/Header.hs
deleted file mode 100644
index a26e16a..0000000
--- a/client/src/View/Income/Header.hs
+++ /dev/null
@@ -1,77 +0,0 @@
-module View.Income.Header
- ( view
- , In(..)
- , Out(..)
- ) where
-
-import Control.Monad.IO.Class (liftIO)
-import qualified Data.Map as M
-import qualified Data.Maybe as Maybe
-import qualified Data.Text as T
-import qualified Data.Time.Clock as Clock
-import Reflex.Dom (Dynamic, Event, MonadWidget)
-import qualified Reflex.Dom as R
-
-import Common.Model (Currency, Income (..),
- IncomeHeader (..), User (..))
-import qualified Common.Model as CM
-import qualified Common.Msg as Msg
-import qualified Common.View.Format as Format
-
-import qualified Component.Button as Button
-import qualified Component.Modal as Modal
-import qualified View.Income.Form as Form
-
-data In t = In
- { _in_users :: [User]
- , _in_header :: IncomeHeader
- , _in_currency :: Currency
- }
-
-data Out t = Out
- { _out_add :: Event t ()
- }
-
-view :: forall t m. MonadWidget t m => In t -> m (Out t)
-view input =
- R.divClass "withMargin" $ do
-
- currentTime <- liftIO Clock.getCurrentTime
-
- case _incomeHeader_since $ _in_header input of
- Nothing ->
- R.blank
-
- Just since ->
- R.el "div" $ do
-
- R.el "h1" $ do
- R.text $ Msg.get (Msg.Income_CumulativeSince (Format.longDay since))
-
- R.el "ul" $
- flip mapM_ (M.toList . _incomeHeader_byUser $ _in_header input) $ \(userId, amount) ->
- R.el "li" $
- R.text $
- T.intercalate " "
- [ Maybe.fromMaybe "" . fmap _user_name $ CM.findUser userId (_in_users input)
- , "−"
- , Format.price (_in_currency input) amount
- ]
-
- R.divClass "titleButton" $ do
- R.el "h1" $
- R.text $
- Msg.get Msg.Income_MonthlyNet
-
- addIncome <- Button._out_clic <$>
- (Button.view . Button.defaultIn . R.text $
- Msg.get Msg.Income_AddLong)
-
- addIncome <- Modal.view $ Modal.In
- { Modal._in_show = addIncome
- , Modal._in_content = Form.view $ Form.In { Form._in_operation = Form.New }
- }
-
- return $ Out
- { _out_add = addIncome
- }
diff --git a/client/src/View/Income/Income.hs b/client/src/View/Income/Income.hs
deleted file mode 100644
index 7be8091..0000000
--- a/client/src/View/Income/Income.hs
+++ /dev/null
@@ -1,75 +0,0 @@
-{-# LANGUAGE ExplicitForAll #-}
-
-module View.Income.Income
- ( 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 (Currency, Income (..), IncomePage (..),
- User, UserId)
-
-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.Income.Header as Header
-import qualified View.Income.Reducer as Reducer
-import qualified View.Income.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
- incomePage <- Reducer.reducer $ Reducer.In
- { Reducer._in_page = page
- , Reducer._in_addIncome = R.leftmost [headerAddIncome, tableAddIncome]
- , Reducer._in_editIncome = editIncome
- , Reducer._in_deleteIncome = deleteIncome
- }
-
- let eventFromResult :: forall a. ((Header.Out t, Table.Out t, Pages.Out t) -> Event t a) -> m (Event t a)
- eventFromResult op = ReflexUtil.flatten . fmap (Maybe.fromMaybe R.never . fmap op) $ result
-
- page <- eventFromResult $ Pages._out_newPage . (\(_, _, c) -> c)
- headerAddIncome <- eventFromResult $ Header._out_add . (\(a, _, _) -> a)
- tableAddIncome <- eventFromResult $ Table._out_add . (\(_, b, _) -> b)
- editIncome <- eventFromResult $ Table._out_edit . (\(_, b, _) -> b)
- deleteIncome <- eventFromResult $ Table._out_delete . (\(_, b, _) -> b)
-
- result <- Loadable.viewShowValueWhileLoading incomePage $
- \(IncomePage page header incomes count) -> do
- header <- Header.view $ Header.In
- { Header._in_users = _in_users input
- , Header._in_header = header
- , Header._in_currency = _in_currency input
- }
-
- table <- Table.view $ Table.In
- { Table._in_currentUser = _in_currentUser input
- , Table._in_currency = _in_currency input
- , Table._in_incomes = incomes
- , 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 ()
diff --git a/client/src/View/Income/Reducer.hs b/client/src/View/Income/Reducer.hs
deleted file mode 100644
index ea9f664..0000000
--- a/client/src/View/Income/Reducer.hs
+++ /dev/null
@@ -1,59 +0,0 @@
-module View.Income.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 (IncomePage)
-
-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_addIncome :: Event t a
- , _in_editIncome :: Event t b
- , _in_deleteIncome :: Event t c
- }
-
-reducer :: forall t m a b c. MonadWidget t m => In t a b c -> m (Dynamic t (Loadable IncomePage))
-reducer input = do
-
- postBuild <- R.getPostBuild
-
- currentPage <- R.holdDyn 1 (_in_page input)
-
- let loadPage =
- R.leftmost
- [ 1 <$ postBuild
- , _in_page input
- , 1 <$ _in_addIncome input
- , R.tag (R.current currentPage) (_in_editIncome input)
- , R.tag (R.current currentPage) (_in_deleteIncome input)
- ]
-
- getResult <- AjaxUtil.get $ fmap pageUrl loadPage
-
- R.holdDyn
- Loading
- (R.leftmost
- [ Loading <$ loadPage
- , Loadable.fromEither <$> getResult
- ])
-
- where
- pageUrl p =
- "api/incomes?page="
- <> (T.pack . show $ p)
- <> "&perPage="
- <> (T.pack . show $ perPage)
diff --git a/client/src/View/Income/Table.hs b/client/src/View/Income/Table.hs
deleted file mode 100644
index 7b7940d..0000000
--- a/client/src/View/Income/Table.hs
+++ /dev/null
@@ -1,93 +0,0 @@
-module View.Income.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 (Currency, Income (..), 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 Util.Ajax as Ajax
-import qualified Util.Either as EitherUtil
-import qualified View.Income.Form as Form
-
-data In t = In
- { _in_currentUser :: UserId
- , _in_currency :: Currency
- , _in_incomes :: [Income]
- , _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_incomes input
- , Table._in_cell = cell (_in_users input) (_in_currency input)
- , Table._in_cloneModal = \income ->
- Form.view $ Form.In
- { Form._in_operation = Form.Clone income
- }
- , Table._in_editModal = \income ->
- Form.view $ Form.In
- { Form._in_operation = Form.Edit income
- }
- , Table._in_deleteModal = \income ->
- ConfirmDialog.view $ ConfirmDialog.In
- { ConfirmDialog._in_header = Msg.get Msg.Income_DeleteConfirm
- , ConfirmDialog._in_confirm = \e -> do
- res <- Ajax.delete
- (R.constDyn $ T.concat ["/api/income/", T.pack . show $ _income_id income])
- e
- return $ () <$ R.fmapMaybe EitherUtil.eitherToMaybe res
- }
- , Table._in_canEdit = (== (_in_currentUser input)) . _income_userId
- , Table._in_canDelete = (== (_in_currentUser input)) . _income_userId
- }
-
- return $ Out
- { _out_add = Table._out_add table
- , _out_edit = Table._out_edit table
- , _out_delete = Table._out_delete table
- }
-
-data Header
- = UserHeader
- | AmountHeader
- | DateHeader
- deriving (Eq, Show, Bounded, Enum)
-
-headerLabel :: Header -> Text
-headerLabel UserHeader = Msg.get Msg.Income_Name
-headerLabel DateHeader = Msg.get Msg.Income_Date
-headerLabel AmountHeader = Msg.get Msg.Income_Amount
-
-cell :: forall t m. MonadWidget t m => [User] -> Currency -> Header -> Income -> m ()
-cell users currency header income =
- case header of
- UserHeader ->
- R.text . Maybe.fromMaybe "" . fmap _user_name $ CM.findUser (_income_userId income) users
-
- DateHeader ->
- R.text . Format.longDay . _income_date $ income
-
- AmountHeader ->
- R.text . Format.price currency . _income_amount $ income
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-01 10:15:29 +0000