diff options
author | Joris | 2019-11-06 19:44:15 +0100 |
---|---|---|
committer | Joris | 2019-11-06 19:44:15 +0100 |
commit | f4f24158a46d8c0975f1b8813bbdbbeebad8c108 (patch) | |
tree | d0aeaa3a920caaff7408a1f6cd12b45f21cb2620 /client/src/View/Payment/Reducer.hs | |
parent | 58f6c4e25f5f20f1b608242c83786e2f13947804 (diff) | |
download | budget-f4f24158a46d8c0975f1b8813bbdbbeebad8c108.tar.gz budget-f4f24158a46d8c0975f1b8813bbdbbeebad8c108.tar.bz2 budget-f4f24158a46d8c0975f1b8813bbdbbeebad8c108.zip |
Show the payment table with server side paging
Diffstat (limited to 'client/src/View/Payment/Reducer.hs')
-rw-r--r-- | client/src/View/Payment/Reducer.hs | 66 |
1 files changed, 66 insertions, 0 deletions
diff --git a/client/src/View/Payment/Reducer.hs b/client/src/View/Payment/Reducer.hs new file mode 100644 index 0000000..0c70f8a --- /dev/null +++ b/client/src/View/Payment/Reducer.hs @@ -0,0 +1,66 @@ +module View.Payment.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 (PaymentPage) + +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_addPayment :: Event t a + , _in_editPayment :: Event t b + , _in_deletePayment :: Event t c + } + +data Action + = LoadPage Int + | GetResult (Either Text PaymentPage) + +reducer :: forall t m a b c. MonadWidget t m => In t a b c -> m (Dynamic t (Loadable PaymentPage)) +reducer input = do + + postBuild <- R.getPostBuild + + let loadPage = + R.leftmost + [ 1 <$ postBuild + , _in_newPage input + , 1 <$ _in_addPayment input + , R.tag (R.current $ _in_currentPage input) (_in_editPayment input) + , R.tag (R.current $ _in_currentPage input) (_in_deletePayment input) + ] + + getResult <- AjaxUtil.get $ fmap pageUrl loadPage + + R.foldDyn + (\action _ -> case action of + LoadPage _ -> Loading + GetResult (Left err) -> Error err + GetResult (Right payments) -> Loaded payments + ) + Loading + (R.leftmost + [ LoadPage <$> loadPage + , GetResult <$> getResult + ]) + + where + pageUrl p = + "api/payments?page=" + <> (T.pack . show $ p) + <> "&perPage=" + <> (T.pack . show $ perPage) |