aboutsummaryrefslogtreecommitdiff
path: root/client/src/View
diff options
context:
space:
mode:
Diffstat (limited to 'client/src/View')
-rw-r--r--client/src/View/Income/Income.hs101
-rw-r--r--client/src/View/Income/Reducer.hs66
-rw-r--r--client/src/View/Income/Table.hs13
3 files changed, 120 insertions, 60 deletions
diff --git a/client/src/View/Income/Income.hs b/client/src/View/Income/Income.hs
index 2f0b8f5..c48f325 100644
--- a/client/src/View/Income/Income.hs
+++ b/client/src/View/Income/Income.hs
@@ -4,19 +4,23 @@ module View.Income.Income
, In(..)
) where
-import Data.Aeson (FromJSON)
-import Prelude hiding (init)
-import Reflex.Dom (Dynamic, Event, MonadWidget)
-import qualified Reflex.Dom as R
+import Data.Aeson (FromJSON)
+import Prelude hiding (init)
+import Reflex.Dom (Dynamic, Event, MonadWidget)
+import qualified Reflex.Dom as R
-import Common.Model (Currency, Income (..), UserId)
+import Common.Model (Currency, Income (..),
+ IncomesAndCount (..), UserId)
-import Loadable (Loadable (..))
+import qualified Component.Pages as Pages
+import Loadable (Loadable (..))
import qualified Loadable
-import qualified Util.Ajax as AjaxUtil
-import qualified View.Income.Header as Header
-import View.Income.Init (Init (..))
-import qualified View.Income.Table as Table
+import qualified Util.Ajax as AjaxUtil
+import qualified Util.Reflex as ReflexUtil
+-- import qualified View.Income.Header as Header
+import View.Income.Init (Init (..))
+import qualified View.Income.Reducer as Reducer
+import qualified View.Income.Table as Table
data In t = In
{ _in_currentUser :: UserId
@@ -37,50 +41,45 @@ init = do
view :: forall t m. MonadWidget t m => In t -> m ()
view input = do
- R.dyn . R.ffor (_in_init input) . Loadable.view $ \init ->
+ -- rec
+ -- incomes <- Reducer.reducer
+ -- { Reducer._in_newPage = ReflexUtil.flatten (Table._out_newPage <$> table)
+ -- , Reducer._in_currentPage = ReflexUtil.flatten (Table._out_currentPage <$> table)
+ -- , Reducer._in_addIncome = ReflexUtil.flatten (Table._out_add <$> table)
+ -- , Reducer._in_editIncome = ReflexUtil.flatten (Table._out_edit <$> table)
+ -- , Reducer._in_deleteIncome = ReflexUtil.flatten (Table._out_delete <$> table)
+ -- }
- R.elClass "main" "income" $ do
+ rec
+ incomes <- Reducer.reducer $ Reducer.In
+ { Reducer._in_newPage = Pages._out_newPage pages
+ , Reducer._in_currentPage = Pages._out_currentPage pages
+ , Reducer._in_addIncome = Table._out_add table
+ , Reducer._in_editIncome = Table._out_edit table
+ , Reducer._in_deleteIncome = Table._out_delete table
+ }
- rec
- let addIncome = R.leftmost
- [ Header._out_add header
- , Table._out_add table
- ]
+ table <- Table.view $ Table.In
+ { Table._in_currentUser = _in_currentUser input
+ , Table._in_currency = _in_currency input
+ , Table._in_incomes = R.ffor incomes $ \case
+ Loaded (IncomesAndCount xs _) -> xs
+ _ -> []
+ }
- incomes <- reduceIncomes
- (_init_incomes init)
- addIncome
- (Table._out_edit table)
- (Table._out_delete table)
+ pages <- Pages.view $ Pages.In
+ { Pages._in_total = R.ffor incomes $ \case
+ Loaded (IncomesAndCount _ n) -> n
+ _ -> 0
+ , Pages._in_perPage = Reducer.perPage
+ }
- header <- Header.view $ Header.In
- { Header._in_init = init
- , Header._in_currency = _in_currency input
- , Header._in_incomes = incomes
- }
-
- table <- Table.view $ Table.In
- { Table._in_currentUser = _in_currentUser input
- , Table._in_init = init
- , Table._in_currency = _in_currency input
- , Table._in_incomes = incomes
- , Table._in_resetPage = () <$ addIncome
- }
-
- return ()
+ -- -- table :: Event t (Maybe (Table.Out t))
+ -- table <- R.dyn . R.ffor incomes . Loadable.view $ \incomes ->
+ -- Table.view $ Table.In
+ -- { Table._in_currentUser = _in_currentUser input
+ -- , Table._in_currency = _in_currency input
+ -- , Table._in_incomes = incomes
+ -- }
return ()
-
-reduceIncomes
- :: forall t m. MonadWidget t m
- => [Income]
- -> Event t Income -- add
- -> Event t Income -- edit
- -> Event t Income -- delete
- -> m (Dynamic t [Income])
-reduceIncomes initIncomes add edit delete =
- R.foldDyn id initIncomes $ R.leftmost
- [ (:) <$> add
- , R.ffor edit (\p -> (p:) . filter ((/= (_income_id p)) . _income_id))
- , R.ffor delete (\p -> filter ((/= (_income_id p)) . _income_id))
- ]
diff --git a/client/src/View/Income/Reducer.hs b/client/src/View/Income/Reducer.hs
new file mode 100644
index 0000000..5b346cb
--- /dev/null
+++ b/client/src/View/Income/Reducer.hs
@@ -0,0 +1,66 @@
+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 (IncomesAndCount)
+
+import Loadable (Loadable (..))
+import qualified Loadable as Loadable
+import qualified Util.Ajax as AjaxUtil
+
+perPage :: Int
+perPage = 7
+
+data In t a b c = In
+ { _in_newPage :: Event t Int
+ , _in_currentPage :: Dynamic t Int
+ , _in_addIncome :: Event t a
+ , _in_editIncome :: Event t b
+ , _in_deleteIncome :: Event t c
+ }
+
+data Action
+ = LoadPage Int
+ | GetResult (Either Text IncomesAndCount)
+
+reducer :: forall t m a b c. MonadWidget t m => In t a b c -> m (Dynamic t (Loadable IncomesAndCount))
+reducer input = do
+
+ postBuild <- R.getPostBuild
+
+ let loadPage =
+ R.leftmost
+ [ 1 <$ postBuild
+ , _in_newPage input
+ , 1 <$ _in_addIncome input
+ , R.tag (R.current $ _in_currentPage input) (_in_editIncome input)
+ , R.tag (R.current $ _in_currentPage input) (_in_deleteIncome input)
+ ]
+
+ getResult <- AjaxUtil.get $ fmap pageUrl loadPage
+
+ R.foldDyn
+ (\action _ -> case action of
+ LoadPage _ -> Loading
+ GetResult (Left err) -> Error err
+ GetResult (Right incomes) -> Loaded incomes
+ )
+ Loading
+ (R.leftmost
+ [ LoadPage <$> loadPage
+ , GetResult <$> getResult
+ ])
+
+ where
+ pageUrl p =
+ "api/v2/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
index d089d9f..6d69c19 100644
--- a/client/src/View/Income/Table.hs
+++ b/client/src/View/Income/Table.hs
@@ -22,14 +22,11 @@ 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
-import View.Income.Init (Init (..))
data In t = In
{ _in_currentUser :: UserId
- , _in_init :: Init
, _in_currency :: Currency
, _in_incomes :: Dynamic t [Income]
- , _in_resetPage :: Event t ()
}
data Out t = Out
@@ -44,9 +41,7 @@ view input = do
table <- Table.view $ Table.In
{ Table._in_headerLabel = headerLabel
, Table._in_rows = R.ffor (_in_incomes input) $ reverse . L.sortOn _income_date
- , Table._in_cell = cell (_in_init input) (_in_currency input)
- , Table._in_perPage = 7
- , Table._in_resetPage = _in_resetPage input
+ , Table._in_cell = cell [] (_in_currency input)
, Table._in_cloneModal = \income ->
Form.view $ Form.In
{ Form._in_operation = Form.Clone income
@@ -84,11 +79,11 @@ headerLabel UserHeader = Msg.get Msg.Income_Name
headerLabel DateHeader = Msg.get Msg.Income_Date
headerLabel AmountHeader = Msg.get Msg.Income_Amount
-cell :: Init -> Currency -> Header -> Income -> Text
-cell init currency header income =
+cell :: [User] -> Currency -> Header -> Income -> Text
+cell users currency header income =
case header of
UserHeader ->
- Maybe.fromMaybe "" . fmap _user_name $ CM.findUser (_income_userId income) (_init_users init)
+ Maybe.fromMaybe "" . fmap _user_name $ CM.findUser (_income_userId income) users
DateHeader ->
Format.longDay . _income_date $ income
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-23 04:59:43 +0000