From 316bda10c6bec8b5ccc9e23f1f677c076205f046 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 8 Dec 2019 11:39:37 +0100
Subject: Add category page

---
 client/src/View/Category/Reducer.hs | 59 +++++++++++++++++++++++++++++++++++++
 1 file changed, 59 insertions(+)
 create mode 100644 client/src/View/Category/Reducer.hs

(limited to 'client/src/View/Category/Reducer.hs')

diff --git a/client/src/View/Category/Reducer.hs b/client/src/View/Category/Reducer.hs
new file mode 100644
index 0000000..5ad0ddb
--- /dev/null
+++ b/client/src/View/Category/Reducer.hs
@@ -0,0 +1,59 @@
+module View.Category.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 (CategoryPage)
+
+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_addCategory    :: Event t a
+  , _in_editCategory   :: Event t b
+  , _in_deleteCategory :: Event t c
+  }
+
+reducer :: forall t m a b c. MonadWidget t m => In t a b c -> m (Dynamic t (Loadable CategoryPage))
+reducer input = do
+
+  postBuild <- R.getPostBuild
+
+  currentPage <- R.holdDyn 1 (_in_page input)
+
+  let loadPage =
+        R.leftmost
+          [ 1 <$ postBuild
+          , _in_page input
+          , 1 <$ _in_addCategory input
+          , R.tag (R.current currentPage) (_in_editCategory input)
+          , R.tag (R.current currentPage) (_in_deleteCategory input)
+          ]
+
+  getResult <- AjaxUtil.get $ fmap pageUrl loadPage
+
+  R.holdDyn
+    Loading
+    (R.leftmost
+      [ Loading <$ loadPage
+      , Loadable.fromEither <$> getResult
+      ])
+
+  where
+    pageUrl p =
+      "api/categories?page="
+      <> (T.pack . show $ p)
+      <> "&perPage="
+      <> (T.pack . show $ perPage)
-- 
cgit v1.2.3