aboutsummaryrefslogtreecommitdiff
path: root/client/src
diff options
context:
space:
mode:
Diffstat (limited to 'client/src')
-rw-r--r--client/src/Loadable.hs62
-rw-r--r--client/src/View/Income/Income.hs2
-rw-r--r--client/src/View/Income/Reducer.hs19
-rw-r--r--client/src/View/Payment/Payment.hs4
-rw-r--r--client/src/View/Payment/Reducer.hs19
5 files changed, 58 insertions, 48 deletions
diff --git a/client/src/Loadable.hs b/client/src/Loadable.hs
index 9a14b3f..4806b08 100644
--- a/client/src/Loadable.hs
+++ b/client/src/Loadable.hs
@@ -1,9 +1,9 @@
module Loadable
( Loadable (..)
- , Loadable2 (..)
+ , fromEither
, fromEvent
- , view
- , view2
+ , viewHideValueWhileLoading
+ , viewShowValueWhileLoading
) where
import qualified Data.Map as M
@@ -19,7 +19,7 @@ data Loadable t
= Loading
| Error Text
| Loaded t
- deriving Show
+ deriving (Eq, Show)
instance Functor Loadable where
fmap f Loading = Loading
@@ -40,6 +40,10 @@ instance Monad Loadable where
(Error e) >>= f = Error e
(Loaded x) >>= f = f x
+fromEither :: forall a b. Either Text b -> Loadable b
+fromEither (Left err) = Error err
+fromEither (Right value) = Loaded value
+
fromEvent :: forall t m a. MonadWidget t m => Event t (Either Text a) -> m (Dynamic t (Loadable a))
fromEvent =
R.foldDyn
@@ -49,24 +53,38 @@ fromEvent =
)
Loading
-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
+viewHideValueWhileLoading :: forall t m a b. MonadWidget t m => (a -> m b) -> Loadable a -> m (Maybe b)
+viewHideValueWhileLoading f loadable =
+ case loadable of
+ Loading ->
+ (R.divClass "pageSpinner" $ R.divClass "spinner" $ R.blank) >> return Nothing
-data Loadable2 t a = Loadable2
- { _loadable_isLoading :: Dynamic t Bool
- , _loadable_value :: Dynamic t (Maybe a)
- }
+ Error err ->
+ R.text err >> return Nothing
-view2 :: forall t m a b. MonadWidget t m => Loadable2 t a -> (a -> m b) -> m (Event t (Maybe b))
-view2 (Loadable2 isLoading value) f =
- withLoader isLoading $
- R.dyn . R.ffor value . viewMaybe $ f
+ Loaded x ->
+ Just <$> f x
- where
- viewMaybe _ Nothing = return Nothing
- viewMaybe f (Just x) = Just <$> f x
+viewShowValueWhileLoading
+ :: forall t m a b. (MonadWidget t m, Eq a)
+ => Dynamic t (Loadable a)
+ -> (a -> m b)
+ -> m (Event t (Maybe b))
+viewShowValueWhileLoading loadable f = do
+
+ value <-
+ (R.foldDyn
+ (\l v1 ->
+ case l of
+ Loaded v2 -> Just v2
+ _ -> v1)
+ Nothing
+ (R.updated loadable)) >>= R.holdUniqDyn
+
+ withLoader (fmap ((==) Loading) loadable) $
+ R.dyn . R.ffor value $ \case
+ Nothing -> return Nothing
+ Just x -> Just <$> f x
withLoader
:: forall t m a. MonadWidget t m
@@ -75,10 +93,12 @@ withLoader
-> m a
withLoader isLoading block =
R.divClass "g-Loadable" $ do
+ res <- R.elDynAttr "div" (blockAttrs <$> isLoading) $
+ block
R.elDynAttr "div" (spinnerAttrs <$> isLoading) $
R.divClass "spinner" R.blank
- R.elDynAttr "div" (blockAttrs <$> isLoading) $
- block
+ return res
+
where
spinnerAttrs l = M.singleton "class" $
"g-Loadable__Spinner"
diff --git a/client/src/View/Income/Income.hs b/client/src/View/Income/Income.hs
index fa2585d..e83ba80 100644
--- a/client/src/View/Income/Income.hs
+++ b/client/src/View/Income/Income.hs
@@ -50,7 +50,7 @@ view input = do
editIncome <- eventFromResult $ Table._out_edit . (\(_, b, _) -> b)
deleteIncome <- eventFromResult $ Table._out_delete . (\(_, b, _) -> b)
- result <- Loadable.view2 incomePage $
+ result <- Loadable.viewShowValueWhileLoading incomePage $
\(IncomePage page header incomes count) -> do
header <- Header.view $ Header.In
{ Header._in_users = _in_users input
diff --git a/client/src/View/Income/Reducer.hs b/client/src/View/Income/Reducer.hs
index 391890f..ea9f664 100644
--- a/client/src/View/Income/Reducer.hs
+++ b/client/src/View/Income/Reducer.hs
@@ -11,7 +11,8 @@ import qualified Reflex.Dom as R
import Common.Model (IncomePage)
-import Loadable (Loadable2 (..))
+import Loadable (Loadable (..))
+import qualified Loadable as Loadable
import qualified Util.Ajax as AjaxUtil
import qualified Util.Either as EitherUtil
@@ -25,7 +26,7 @@ data In t a b c = In
, _in_deleteIncome :: Event t c
}
-reducer :: forall t m a b c. MonadWidget t m => In t a b c -> m (Loadable2 t IncomePage)
+reducer :: forall t m a b c. MonadWidget t m => In t a b c -> m (Dynamic t (Loadable IncomePage))
reducer input = do
postBuild <- R.getPostBuild
@@ -43,19 +44,13 @@ reducer input = do
getResult <- AjaxUtil.get $ fmap pageUrl loadPage
- isLoading <- R.holdDyn
- True
+ R.holdDyn
+ Loading
(R.leftmost
- [ True <$ loadPage
- , False <$ getResult
+ [ Loading <$ loadPage
+ , Loadable.fromEither <$> getResult
])
- incomePage <- R.holdDyn
- Nothing
- (fmap EitherUtil.eitherToMaybe getResult)
-
- return $ Loadable2 isLoading incomePage
-
where
pageUrl p =
"api/incomes?page="
diff --git a/client/src/View/Payment/Payment.hs b/client/src/View/Payment/Payment.hs
index a97c3df..8d0fee1 100644
--- a/client/src/View/Payment/Payment.hs
+++ b/client/src/View/Payment/Payment.hs
@@ -38,7 +38,7 @@ view input = do
categories <- AjaxUtil.getNow "api/categories"
- R.dyn . R.ffor categories . Loadable.view $ \categories -> do
+ R.dyn . R.ffor categories . Loadable.viewHideValueWhileLoading $ \categories -> do
rec
paymentPage <- Reducer.reducer $ Reducer.In
@@ -69,7 +69,7 @@ view input = do
, HeaderForm._in_categories = categories
}
- result <- Loadable.view2 paymentPage $
+ result <- Loadable.viewShowValueWhileLoading paymentPage $
\(PaymentPage page frequency header payments count) -> do
HeaderInfos.view $ HeaderInfos.In
diff --git a/client/src/View/Payment/Reducer.hs b/client/src/View/Payment/Reducer.hs
index d221ff0..7468097 100644
--- a/client/src/View/Payment/Reducer.hs
+++ b/client/src/View/Payment/Reducer.hs
@@ -13,7 +13,8 @@ import qualified Reflex.Dom as R
import Common.Model (Frequency (..), PaymentPage)
-import Loadable (Loadable2 (..))
+import Loadable (Loadable (..))
+import qualified Loadable as Loadable
import qualified Util.Ajax as AjaxUtil
import qualified Util.Either as EitherUtil
@@ -44,7 +45,7 @@ data Msg
| ResetSearch
deriving Show
-reducer :: forall t m a b c. MonadWidget t m => In t a b c -> m (Loadable2 t 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
@@ -90,19 +91,13 @@ reducer input = do
getResult <- AjaxUtil.get (pageUrl <$> paramsEvent)
- isLoading <- R.holdDyn
- True
+ R.holdDyn
+ Loading
(R.leftmost
- [ True <$ paramsEvent
- , False <$ getResult
+ [ Loading <$ paramsEvent
+ , Loadable.fromEither <$> getResult
])
- paymentPage <- R.holdDyn
- Nothing
- (fmap EitherUtil.eitherToMaybe getResult)
-
- return $ Loadable2 isLoading paymentPage
-
where
pageUrl (Params page search frequency) =
"api/payments?page="
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-22 23:58:14 +0000