From e622e8fdd2e40b4306b5cc724d8dfb76bf976242 Mon Sep 17 00:00:00 2001
From: Joris
Date: Mon, 25 Nov 2019 08:17:59 +0100
Subject: Remove Loadable2

---
 client/src/Loadable.hs                    | 62 ++++++++++++++++++++-----------
 client/src/View/Income/Income.hs          |  2 +-
 client/src/View/Income/Reducer.hs         | 19 ++++------
 client/src/View/Payment/Payment.hs        |  4 +-
 client/src/View/Payment/Reducer.hs        | 19 ++++------
 common/src/Common/Model/ExceedingPayer.hs |  2 +-
 common/src/Common/Model/Income.hs         |  2 +-
 common/src/Common/Model/IncomeHeader.hs   |  2 +-
 common/src/Common/Model/IncomePage.hs     |  2 +-
 common/src/Common/Model/Payment.hs        |  2 +-
 common/src/Common/Model/PaymentHeader.hs  |  2 +-
 common/src/Common/Model/PaymentPage.hs    |  2 +-
 12 files changed, 65 insertions(+), 55 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="
diff --git a/common/src/Common/Model/ExceedingPayer.hs b/common/src/Common/Model/ExceedingPayer.hs
index 171b6ff..b7d3efb 100644
--- a/common/src/Common/Model/ExceedingPayer.hs
+++ b/common/src/Common/Model/ExceedingPayer.hs
@@ -10,7 +10,7 @@ import           Common.Model.User (UserId)
 data ExceedingPayer = ExceedingPayer
   { _exceedingPayer_userId :: UserId
   , _exceedingPayer_amount :: Int
-  } deriving (Show, Generic)
+  } deriving (Eq, Show, Generic)
 
 instance FromJSON ExceedingPayer
 instance ToJSON ExceedingPayer
diff --git a/common/src/Common/Model/Income.hs b/common/src/Common/Model/Income.hs
index 0423704..57d07f1 100644
--- a/common/src/Common/Model/Income.hs
+++ b/common/src/Common/Model/Income.hs
@@ -21,7 +21,7 @@ data Income = Income
   , _income_createdAt :: UTCTime
   , _income_editedAt  :: Maybe UTCTime
   , _income_deletedAt :: Maybe UTCTime
-  } deriving (Show, Generic)
+  } deriving (Eq, Show, Generic)
 
 instance FromJSON Income
 instance ToJSON Income
diff --git a/common/src/Common/Model/IncomeHeader.hs b/common/src/Common/Model/IncomeHeader.hs
index 87c7aae..7e712e8 100644
--- a/common/src/Common/Model/IncomeHeader.hs
+++ b/common/src/Common/Model/IncomeHeader.hs
@@ -12,7 +12,7 @@ import           Common.Model.User  (UserId)
 data IncomeHeader = IncomeHeader
   { _incomeHeader_since  :: Maybe Day
   , _incomeHeader_byUser :: Map UserId Int
-  } deriving (Show, Generic)
+  } deriving (Eq, Show, Generic)
 
 instance FromJSON IncomeHeader
 instance ToJSON IncomeHeader
diff --git a/common/src/Common/Model/IncomePage.hs b/common/src/Common/Model/IncomePage.hs
index 0572141..977b0ea 100644
--- a/common/src/Common/Model/IncomePage.hs
+++ b/common/src/Common/Model/IncomePage.hs
@@ -13,7 +13,7 @@ data IncomePage = IncomePage
   , _incomePage_header     :: IncomeHeader
   , _incomePage_incomes    :: [Income]
   , _incomePage_totalCount :: Int
-  } deriving (Show, Generic)
+  } deriving (Eq, Show, Generic)
 
 instance FromJSON IncomePage
 instance ToJSON IncomePage
diff --git a/common/src/Common/Model/Payment.hs b/common/src/Common/Model/Payment.hs
index c232fc7..733a145 100644
--- a/common/src/Common/Model/Payment.hs
+++ b/common/src/Common/Model/Payment.hs
@@ -27,7 +27,7 @@ data Payment = Payment
   , _payment_createdAt :: UTCTime
   , _payment_editedAt  :: Maybe UTCTime
   , _payment_deletedAt :: Maybe UTCTime
-  } deriving (Show, Generic)
+  } deriving (Eq, Show, Generic)
 
 instance FromJSON Payment
 instance ToJSON Payment
diff --git a/common/src/Common/Model/PaymentHeader.hs b/common/src/Common/Model/PaymentHeader.hs
index a522cd8..35f5e1a 100644
--- a/common/src/Common/Model/PaymentHeader.hs
+++ b/common/src/Common/Model/PaymentHeader.hs
@@ -12,7 +12,7 @@ import           Common.Model.User           (UserId)
 data PaymentHeader = PaymentHeader
   { _paymentHeader_exceedingPayers :: [ExceedingPayer]
   , _paymentHeader_repartition     :: Map UserId Int
-  } deriving (Show, Generic)
+  } deriving (Eq, Show, Generic)
 
 instance FromJSON PaymentHeader
 instance ToJSON PaymentHeader
diff --git a/common/src/Common/Model/PaymentPage.hs b/common/src/Common/Model/PaymentPage.hs
index 94203a2..88d9715 100644
--- a/common/src/Common/Model/PaymentPage.hs
+++ b/common/src/Common/Model/PaymentPage.hs
@@ -15,7 +15,7 @@ data PaymentPage = PaymentPage
   , _paymentPage_header     :: PaymentHeader
   , _paymentPage_payments   :: [Payment]
   , _paymentPage_totalCount :: Int
-  } deriving (Show, Generic)
+  } deriving (Eq, Show, Generic)
 
 instance FromJSON PaymentPage
 instance ToJSON PaymentPage
-- 
cgit v1.2.3