aboutsummaryrefslogtreecommitdiff
path: root/client/src
diff options
context:
space:
mode:
Diffstat (limited to 'client/src')
-rw-r--r--client/src/Component/Pages.hs37
-rw-r--r--client/src/Component/Table.hs20
-rw-r--r--client/src/Loadable.hs9
-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
6 files changed, 151 insertions, 95 deletions
diff --git a/client/src/Component/Pages.hs b/client/src/Component/Pages.hs
index 7284a36..a297222 100644
--- a/client/src/Component/Pages.hs
+++ b/client/src/Component/Pages.hs
@@ -16,38 +16,43 @@ import qualified View.Icon as Icon
data In t = In
{ _in_total :: Dynamic t Int
, _in_perPage :: Int
- , _in_reset :: Event t ()
}
data Out t = Out
- { _out_currentPage :: Dynamic t Int
+ { _out_newPage :: Event t Int
+ , _out_currentPage :: Dynamic t Int
}
view :: forall t m. MonadWidget t m => In t -> m (Out t)
view input = do
- currentPage <- ReflexUtil.divVisibleIf ((> 0) <$> total) $ pageButtons total perPage reset
+ (newPage, currentPage) <- ReflexUtil.divVisibleIf ((> 0) <$> total) $ pageButtons total perPage
return $ Out
- { _out_currentPage = currentPage
+ { _out_newPage = newPage
+ , _out_currentPage = currentPage
}
where
total = _in_total input
perPage = _in_perPage input
- reset = _in_reset input
-pageButtons :: forall t m. MonadWidget t m => Dynamic t Int -> Int -> Event t () -> m (Dynamic t Int)
-pageButtons total perPage reset = do
+pageButtons
+ :: forall t m. MonadWidget t m
+ => Dynamic t Int
+ -> Int
+ -> m (Event t Int, Dynamic t Int)
+pageButtons total perPage = do
R.divClass "pages" $ do
rec
- currentPage <- R.holdDyn 1 . R.leftmost $
- [ firstPageClic
- , previousPageClic
- , pageClic
- , nextPageClic
- , lastPageClic
- , 1 <$ reset
- ]
+ let newPage = R.leftmost
+ [ firstPageClic
+ , previousPageClic
+ , pageClic
+ , nextPageClic
+ , lastPageClic
+ ]
+
+ currentPage <- R.holdDyn 1 newPage
firstPageClic <- pageButton noCurrentPage (R.constDyn 1) Icon.doubleLeftBar
@@ -60,7 +65,7 @@ pageButtons total perPage reset = do
lastPageClic <- pageButton noCurrentPage maxPage Icon.doubleRightBar
- return currentPage
+ return (newPage, currentPage)
where maxPage = R.ffor total (\t -> ceiling $ toRational t / toRational perPage)
pageEvent = R.switch . R.current . fmap R.leftmost
diff --git a/client/src/Component/Table.hs b/client/src/Component/Table.hs
index a02eaa7..7103abd 100644
--- a/client/src/Component/Table.hs
+++ b/client/src/Component/Table.hs
@@ -10,7 +10,6 @@ import qualified Reflex.Dom as R
import qualified Component.Button as Button
import qualified Component.Modal as Modal
-import qualified Component.Pages as Pages
import qualified Util.Reflex as ReflexUtil
import qualified View.Icon as Icon
@@ -18,8 +17,6 @@ data In m t h r a = In
{ _in_headerLabel :: h -> Text
, _in_rows :: Dynamic t [r]
, _in_cell :: h -> r -> Text
- , _in_perPage :: Int
- , _in_resetPage :: Event t ()
, _in_cloneModal :: r -> Modal.Content t m a
, _in_editModal :: r -> Modal.Content t m a
, _in_deleteModal :: r -> Modal.Content t m a
@@ -47,12 +44,7 @@ view input =
R.divClass "cell" $ R.blank
R.divClass "cell" $ R.blank
- let rows = getRange
- (_in_perPage input)
- <$> (Pages._out_currentPage pages)
- <*> (_in_rows input)
-
- R.simpleList rows $ \r ->
+ R.simpleList (_in_rows input) $ \r ->
R.divClass "row" $ do
flip mapM_ [minBound..] $ \h ->
R.divClass "cell" $
@@ -104,12 +96,6 @@ view input =
return (cloned, edited, deleted)
- pages <- Pages.view $ Pages.In
- { Pages._in_total = length <$> _in_rows input
- , Pages._in_perPage = _in_perPage input
- , Pages._in_reset = _in_resetPage input
- }
-
let add = R.switch . R.current . fmap (R.leftmost . map (\(a, _, _) -> a)) $ result
edit = R.switch . R.current . fmap (R.leftmost . map (\(_, a, _) -> a)) $ result
delete = R.switch . R.current . fmap (R.leftmost . map (\(_, _, a) -> a)) $ result
@@ -119,7 +105,3 @@ view input =
, _out_edit = edit
, _out_delete = delete
}
-
-getRange :: forall a. Int -> Int -> [a] -> [a]
-getRange perPage currentPage =
- take perPage . drop ((currentPage - 1) * perPage)
diff --git a/client/src/Loadable.hs b/client/src/Loadable.hs
index 8714a4d..a5c1d41 100644
--- a/client/src/Loadable.hs
+++ b/client/src/Loadable.hs
@@ -49,3 +49,12 @@ view :: forall t m a. MonadWidget t m => (a -> m ()) -> Loadable a -> m ()
view _ (Loading) = R.divClass "pageSpinner" $ R.divClass "spinner" $ R.blank
view _ (Error e) = R.text e
view f (Loaded x) = f x
+
+-- view :: forall t m a b. MonadWidget t m => (a -> m b) -> Loadable a -> m (Maybe b)
+-- view _ (Loading) = do
+-- R.divClass "pageSpinner" $ R.divClass "spinner" $ R.blank
+-- return Nothing
+-- view _ (Error e) = do
+-- R.text e
+-- return Nothing
+-- view f (Loaded x) = Just <$> (f x)
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 00:41:42 +0000