From 33e78f2ebbf5bf7b40e7aa732cc7c019f6df3f12 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 20 Oct 2019 22:08:31 +0200
Subject: Simplify page initialization

---
 client/src/Loadable.hs | 51 ++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 51 insertions(+)
 create mode 100644 client/src/Loadable.hs

(limited to 'client/src/Loadable.hs')

diff --git a/client/src/Loadable.hs b/client/src/Loadable.hs
new file mode 100644
index 0000000..8714a4d
--- /dev/null
+++ b/client/src/Loadable.hs
@@ -0,0 +1,51 @@
+module Loadable
+  ( Loadable (..)
+  , fromEvent
+  , view
+  ) where
+
+import           Reflex.Dom   (MonadWidget)
+import qualified Reflex.Dom   as R
+
+import           Data.Functor (Functor)
+import           Data.Text    (Text)
+import           Reflex.Dom   (Dynamic, Event, MonadWidget)
+import qualified Reflex.Dom   as R
+
+data Loadable t
+  = Loading
+  | Error Text
+  | Loaded t
+
+instance Functor Loadable where
+  fmap f Loading    = Loading
+  fmap f (Error e)  = Error e
+  fmap f (Loaded x) = Loaded (f x)
+
+instance Applicative Loadable where
+  pure x = Loaded x
+
+  Loading <*> _ = Loading
+  (Error e) <*> _ = Error e
+  (Loaded f) <*> Loading = Loading
+  (Loaded f) <*> (Error e) = Error e
+  (Loaded f) <*> (Loaded x) = Loaded (f x)
+
+instance Monad Loadable where
+  Loading >>= f = Loading
+  (Error e) >>= f = Error e
+  (Loaded x) >>= f = f x
+
+fromEvent :: forall t m a. MonadWidget t m => Event t (Either Text a) -> m (Dynamic t (Loadable a))
+fromEvent =
+  R.foldDyn
+    (\res _ -> case res of
+      Left err -> Error err
+      Right t  -> Loaded t
+    )
+    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
-- 
cgit v1.2.3


From b97ad942495352c3fc1e0c820cfba82a9693ac7a Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 27 Oct 2019 20:26:29 +0100
Subject: WIP Set up server side paging for incomes

---
 client/src/Loadable.hs | 9 +++++++++
 1 file changed, 9 insertions(+)

(limited to 'client/src/Loadable.hs')

diff --git a/client/src/Loadable.hs b/client/src/Loadable.hs
index 8714a4d..a5c1d41 100644
--- a/client/src/Loadable.hs
+++ b/client/src/Loadable.hs
@@ -49,3 +49,12 @@ 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)
-- 
cgit v1.2.3


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/Loadable.hs | 17 ++++-------------
 1 file changed, 4 insertions(+), 13 deletions(-)

(limited to 'client/src/Loadable.hs')

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
-- 
cgit v1.2.3


From c0ea63f8c1a8c7123b78798cec99726b113fb1f3 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 17 Nov 2019 18:08:28 +0100
Subject: Optimize and refactor payments

---
 client/src/Loadable.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

(limited to 'client/src/Loadable.hs')

diff --git a/client/src/Loadable.hs b/client/src/Loadable.hs
index f57b99c..2b9008a 100644
--- a/client/src/Loadable.hs
+++ b/client/src/Loadable.hs
@@ -16,6 +16,7 @@ data Loadable t
   = Loading
   | Error Text
   | Loaded t
+  deriving Show
 
 instance Functor Loadable where
   fmap f Loading    = Loading
@@ -46,6 +47,6 @@ 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 _ 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
-- 
cgit v1.2.3


From 54628c70cb33de5e4309c35b9f6b57bbe9f7a07b Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 24 Nov 2019 16:19:53 +0100
Subject: Compute cumulative income with a DB query

---
 client/src/Loadable.hs | 37 +++++++++++++++++++++++++++++++++++++
 1 file changed, 37 insertions(+)

(limited to 'client/src/Loadable.hs')

diff --git a/client/src/Loadable.hs b/client/src/Loadable.hs
index 2b9008a..9a14b3f 100644
--- a/client/src/Loadable.hs
+++ b/client/src/Loadable.hs
@@ -1,9 +1,12 @@
 module Loadable
   ( Loadable (..)
+  , Loadable2 (..)
   , fromEvent
   , view
+  , view2
   ) where
 
+import qualified Data.Map     as M
 import           Reflex.Dom   (MonadWidget)
 import qualified Reflex.Dom   as R
 
@@ -50,3 +53,37 @@ view :: forall t m a b. MonadWidget t m => (a -> m b) -> Loadable a -> m (Maybe
 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
+
+data Loadable2 t a = Loadable2
+  { _loadable_isLoading :: Dynamic t Bool
+  , _loadable_value     :: Dynamic t (Maybe a)
+  }
+
+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
+
+  where
+    viewMaybe _ Nothing  = return Nothing
+    viewMaybe f (Just x) = Just <$> f x
+
+withLoader
+  :: forall t m a. MonadWidget t m
+  => Dynamic t Bool
+  -> m a
+  -> m a
+withLoader isLoading block =
+  R.divClass "g-Loadable" $ do
+    R.elDynAttr "div" (spinnerAttrs <$> isLoading) $
+      R.divClass "spinner" R.blank
+    R.elDynAttr "div" (blockAttrs <$> isLoading) $
+      block
+  where
+    spinnerAttrs l = M.singleton "class" $
+      "g-Loadable__Spinner"
+      <> (if l then " g-Loadable__Spinner--Loading" else "")
+
+    blockAttrs l = M.singleton "class" $
+      "g-Loadable__Content"
+      <> (if l then " g-Loadable__Content--Loading" else "")
-- 
cgit v1.2.3


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 +++++++++++++++++++++++++++++++++-----------------
 1 file changed, 41 insertions(+), 21 deletions(-)

(limited to 'client/src/Loadable.hs')

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"
-- 
cgit v1.2.3