From 227dcd4435b775d7dbc5ae5d3d81b589897253cc Mon Sep 17 00:00:00 2001 From: Joris Date: Sat, 2 Nov 2019 20:52:27 +0100 Subject: Implement incomes server side paging --- client/src/Component/Pages.hs | 22 +++++--------- client/src/Component/Table.hs | 62 +++++++++++++++++++------------------- client/src/Loadable.hs | 17 +++-------- client/src/Util/Reflex.hs | 1 - client/src/View/Income/Income.hs | 65 +++++++++++++++++++--------------------- client/src/View/Income/Table.hs | 4 +-- 6 files changed, 76 insertions(+), 95 deletions(-) (limited to 'client') diff --git a/client/src/Component/Pages.hs b/client/src/Component/Pages.hs index a297222..d54cd3d 100644 --- a/client/src/Component/Pages.hs +++ b/client/src/Component/Pages.hs @@ -16,32 +16,26 @@ import qualified View.Icon as Icon data In t = In { _in_total :: Dynamic t Int , _in_perPage :: Int + , _in_page :: Int } data Out t = Out { _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 - (newPage, currentPage) <- ReflexUtil.divVisibleIf ((> 0) <$> total) $ pageButtons total perPage + newPage <- ReflexUtil.divVisibleIf ((> 0) <$> (_in_total input)) $ pageButtons input return $ Out { _out_newPage = newPage - , _out_currentPage = currentPage } - where - total = _in_total input - perPage = _in_perPage input - pageButtons :: forall t m. MonadWidget t m - => Dynamic t Int - -> Int - -> m (Event t Int, Dynamic t Int) -pageButtons total perPage = do + => In t + -> m (Event t Int) +pageButtons input = do R.divClass "pages" $ do rec let newPage = R.leftmost @@ -52,7 +46,7 @@ pageButtons total perPage = do , lastPageClic ] - currentPage <- R.holdDyn 1 newPage + currentPage <- R.holdDyn (_in_page input) newPage firstPageClic <- pageButton noCurrentPage (R.constDyn 1) Icon.doubleLeftBar @@ -65,9 +59,9 @@ pageButtons total perPage = do lastPageClic <- pageButton noCurrentPage maxPage Icon.doubleRightBar - return (newPage, currentPage) + return newPage - where maxPage = R.ffor total (\t -> ceiling $ toRational t / toRational perPage) + where maxPage = R.ffor (_in_total input) (\t -> ceiling $ toRational t / toRational (_in_perPage input)) pageEvent = R.switch . R.current . fmap R.leftmost noCurrentPage = R.constDyn Nothing diff --git a/client/src/Component/Table.hs b/client/src/Component/Table.hs index 7103abd..3b9ec24 100644 --- a/client/src/Component/Table.hs +++ b/client/src/Component/Table.hs @@ -4,8 +4,9 @@ module Component.Table , Out(..) ) where +import qualified Data.Map as M import Data.Text (Text) -import Reflex.Dom (Dynamic, Event, MonadWidget) +import Reflex.Dom (Event, MonadWidget) import qualified Reflex.Dom as R import qualified Component.Button as Button @@ -15,7 +16,7 @@ import qualified View.Icon as Icon data In m t h r a = In { _in_headerLabel :: h -> Text - , _in_rows :: Dynamic t [r] + , _in_rows :: [r] , _in_cell :: h -> r -> Text , _in_cloneModal :: r -> Modal.Content t m a , _in_editModal :: r -> Modal.Content t m a @@ -44,61 +45,60 @@ view input = R.divClass "cell" $ R.blank R.divClass "cell" $ R.blank - R.simpleList (_in_rows input) $ \r -> + flip mapM (_in_rows input) $ \row -> R.divClass "row" $ do - flip mapM_ [minBound..] $ \h -> + flip mapM_ [minBound..] $ \header -> R.divClass "cell" $ - R.dynText $ - R.ffor r (_in_cell input h) + R.text $ + _in_cell input header row - clone <- + cloneButton <- R.divClass "cell button" $ Button._out_clic <$> (Button.view $ Button.defaultIn Icon.clone) - cloned <- + clone <- Modal.view $ Modal.In - { Modal._in_show = clone - , Modal._in_content = \curtainClick -> - (R.dyn . R.ffor r $ \r2 -> _in_cloneModal input r2 curtainClick) - >>= ReflexUtil.flattenTuple + { Modal._in_show = cloneButton + , Modal._in_content = _in_cloneModal input row } - let isOwner = R.ffor r (_in_isOwner input) + let isOwner = _in_isOwner input row - edit <- + let visibleIf cond = + R.elAttr + "div" + (if cond then M.empty else M.singleton "style" "display:none") + + editButton <- R.divClass "cell button" $ - ReflexUtil.divVisibleIf isOwner $ + visibleIf isOwner $ Button._out_clic <$> (Button.view $ Button.defaultIn Icon.edit) - edited <- + edit <- Modal.view $ Modal.In - { Modal._in_show = edit - , Modal._in_content = \curtainClick -> - (R.dyn . R.ffor r $ \r2 -> _in_editModal input r2 curtainClick) - >>= ReflexUtil.flattenTuple + { Modal._in_show = editButton + , Modal._in_content = _in_editModal input row } - delete <- + deleteButton <- R.divClass "cell button" $ - ReflexUtil.divVisibleIf isOwner $ + visibleIf isOwner $ Button._out_clic <$> (Button.view $ Button.defaultIn Icon.delete) - deleted <- + delete <- Modal.view $ Modal.In - { Modal._in_show = delete - , Modal._in_content = \curtainClick -> - (R.dyn . R.ffor r $ \r2 -> _in_deleteModal input r2 curtainClick) - >>= ReflexUtil.flattenTuple + { Modal._in_show = deleteButton + , Modal._in_content = _in_deleteModal input row } - return (cloned, edited, deleted) + return (clone, edit, delete) - 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 + let add = R.leftmost . map (\(a, _, _) -> a) $ result + edit = R.leftmost . map (\(_, a, _) -> a) $ result + delete = R.leftmost . map (\(_, _, a) -> a) $ result return $ Out { _out_add = add diff --git a/client/src/Loadable.hs b/client/src/Loadable.hs index a5c1d41..f57b99c 100644 --- a/client/src/Loadable.hs +++ b/client/src/Loadable.hs @@ -45,16 +45,7 @@ fromEvent = ) Loading -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) +view :: forall t m a b. MonadWidget t m => (a -> m b) -> Loadable a -> m (Maybe b) +view _ (Loading) = (R.divClass "pageSpinner" $ R.divClass "spinner" $ R.blank) >> return Nothing +view _ (Error e) = R.text e >> return Nothing +view f (Loaded x) = Just <$> f x diff --git a/client/src/Util/Reflex.hs b/client/src/Util/Reflex.hs index 9f51c5c..aa5cebb 100644 --- a/client/src/Util/Reflex.hs +++ b/client/src/Util/Reflex.hs @@ -45,7 +45,6 @@ flatten e = do dyn <- R.holdDyn R.never e return $ R.switchDyn dyn - flattenTuple :: forall t m a b. MonadWidget t m => Event t (Event t a, Event t b) diff --git a/client/src/View/Income/Income.hs b/client/src/View/Income/Income.hs index c48f325..fedf3d8 100644 --- a/client/src/View/Income/Income.hs +++ b/client/src/View/Income/Income.hs @@ -1,10 +1,14 @@ +{-# LANGUAGE ExplicitForAll #-} + module View.Income.Income ( init , view , In(..) ) where +import qualified Data.Text as T import Data.Aeson (FromJSON) +import qualified Data.Maybe as Maybe import Prelude hiding (init) import Reflex.Dom (Dynamic, Event, MonadWidget) import qualified Reflex.Dom as R @@ -41,45 +45,38 @@ init = do view :: forall t m. MonadWidget t m => In t -> m () view input = do - -- 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) - -- } - 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 + { Reducer._in_newPage = newPage + , Reducer._in_currentPage = currentPage + , Reducer._in_addIncome = addIncome + , Reducer._in_editIncome = editIncome + , Reducer._in_deleteIncome = deleteIncome } - 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 - _ -> [] - } + let eventFromResult :: forall a. ((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 - pages <- Pages.view $ Pages.In - { Pages._in_total = R.ffor incomes $ \case - Loaded (IncomesAndCount _ n) -> n - _ -> 0 - , Pages._in_perPage = Reducer.perPage - } + newPage <- eventFromResult $ Pages._out_newPage . snd + currentPage <- R.holdDyn 1 newPage + addIncome <- eventFromResult $ Table._out_add . fst + editIncome <- eventFromResult $ Table._out_edit . fst + deleteIncome <- eventFromResult $ Table._out_delete . fst + + result <- R.dyn . R.ffor ((,) <$> incomes <*> currentPage) $ \(is, p) -> + flip Loadable.view is $ \(IncomesAndCount incomes count) -> do + table <- Table.view $ Table.In + { Table._in_currentUser = _in_currentUser input + , Table._in_currency = _in_currency input + , Table._in_incomes = incomes + } + + pages <- Pages.view $ Pages.In + { Pages._in_total = R.constDyn count + , Pages._in_perPage = Reducer.perPage + , Pages._in_page = p + } - -- -- 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 (table, pages) return () diff --git a/client/src/View/Income/Table.hs b/client/src/View/Income/Table.hs index 6d69c19..9b2129f 100644 --- a/client/src/View/Income/Table.hs +++ b/client/src/View/Income/Table.hs @@ -26,7 +26,7 @@ import qualified View.Income.Form as Form data In t = In { _in_currentUser :: UserId , _in_currency :: Currency - , _in_incomes :: Dynamic t [Income] + , _in_incomes :: [Income] } data Out t = Out @@ -40,7 +40,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_rows = reverse . L.sortOn _income_date $ _in_incomes input , Table._in_cell = cell [] (_in_currency input) , Table._in_cloneModal = \income -> Form.view $ Form.In -- cgit v1.2.3