Compute cumulative income with a DB query

6 files changed, 86 insertions, 55 deletions

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 "")
diff --git a/client/src/View/Income/Income.hs b/client/src/View/Income/Income.hs
index d82ab4d..fa2585d 100644
--- a/client/src/View/Income/Income.hs
+++ b/client/src/View/Income/Income.hs
@@ -19,6 +19,7 @@ import           Loadable            (Loadable (..))
 import qualified Loadable
 import qualified Util.Ajax           as AjaxUtil
 import qualified Util.Reflex         as ReflexUtil
+import qualified Util.Reflex         as ReflexUtil
 import qualified View.Income.Header  as Header
 import           View.Income.Init    (Init (..))
 import qualified View.Income.Reducer as Reducer
@@ -33,9 +34,8 @@ data In t = In
 view :: forall t m. MonadWidget t m => In t -> m ()
 view input = do
   rec
-    incomes <- Reducer.reducer $ Reducer.In
-      { Reducer._in_newPage      = newPage
-      , Reducer._in_currentPage  = currentPage
+    incomePage <- Reducer.reducer $ Reducer.In
+      { Reducer._in_page         = page
       , Reducer._in_addIncome    = R.leftmost [headerAddIncome, tableAddIncome]
       , Reducer._in_editIncome   = editIncome
       , Reducer._in_deleteIncome = deleteIncome
@@ -44,15 +44,14 @@ view input = do
     let eventFromResult :: forall a. ((Header.Out t, Table.Out t, Pages.Out t) -> Event t a) -> m (Event t a)
         eventFromResult op = ReflexUtil.flatten . fmap (Maybe.fromMaybe R.never . fmap op) $ result
 
-    newPage <- eventFromResult $ Pages._out_newPage . (\(_, _, c) -> c)
-    currentPage <- R.holdDyn 1 newPage
+    page <- eventFromResult $ Pages._out_newPage . (\(_, _, c) -> c)
     headerAddIncome <- eventFromResult $ Header._out_add . (\(a, _, _) -> a)
     tableAddIncome <- eventFromResult $ Table._out_add . (\(_, b, _) -> b)
     editIncome <- eventFromResult $ Table._out_edit . (\(_, b, _) -> b)
     deleteIncome <- eventFromResult $ Table._out_delete . (\(_, b, _) -> b)
 
-    result <- R.dyn . R.ffor ((,) <$> incomes <*> currentPage) $ \(is, p) ->
-      flip Loadable.view is $ \(IncomePage header incomes count) -> do
+    result <- Loadable.view2 incomePage $
+      \(IncomePage page header incomes count) -> do
         header <- Header.view $ Header.In
           { Header._in_users = _in_users input
           , Header._in_header = header
@@ -69,7 +68,7 @@ view input = do
         pages <- Pages.view $ Pages.In
           { Pages._in_total = R.constDyn count
           , Pages._in_perPage = Reducer.perPage
-          , Pages._in_page = p
+          , Pages._in_page = page
           }
 
         return (header, table, pages)
diff --git a/client/src/View/Income/Reducer.hs b/client/src/View/Income/Reducer.hs
index 092d9b3..391890f 100644
--- a/client/src/View/Income/Reducer.hs
+++ b/client/src/View/Income/Reducer.hs
@@ -11,53 +11,51 @@ import qualified Reflex.Dom   as R
 
 import           Common.Model (IncomePage)
 
-import           Loadable     (Loadable (..))
-import qualified Loadable     as Loadable
+import           Loadable     (Loadable2 (..))
 import qualified Util.Ajax    as AjaxUtil
+import qualified Util.Either  as EitherUtil
 
 perPage :: Int
 perPage = 7
 
 data In t a b c = In
-  { _in_newPage      :: Event t Int
-  , _in_currentPage  :: Dynamic t Int
+  { _in_page         :: Event t Int
   , _in_addIncome    :: Event t a
   , _in_editIncome   :: Event t b
   , _in_deleteIncome :: Event t c
   }
 
-data Action
-  = LoadPage Int
-  | GetResult (Either Text IncomePage)
-
-reducer :: forall t m a b c. MonadWidget t m => In t a b c -> m (Dynamic t (Loadable IncomePage))
+reducer :: forall t m a b c. MonadWidget t m => In t a b c -> m (Loadable2 t IncomePage)
 reducer input = do
 
   postBuild <- R.getPostBuild
 
+  currentPage <- R.holdDyn 1 (_in_page input)
+
   let loadPage =
         R.leftmost
           [ 1 <$ postBuild
-          , _in_newPage input
+          , _in_page input
           , 1 <$ _in_addIncome input
-          , R.tag (R.current $ _in_currentPage input) (_in_editIncome input)
-          , R.tag (R.current $ _in_currentPage input) (_in_deleteIncome input)
+          , R.tag (R.current currentPage) (_in_editIncome input)
+          , R.tag (R.current currentPage) (_in_deleteIncome input)
           ]
 
   getResult <- AjaxUtil.get $ fmap pageUrl loadPage
 
-  R.foldDyn
-    (\action _ -> case action of
-      LoadPage _                -> Loading
-      GetResult (Left err)      -> Error err
-      GetResult (Right incomes) -> Loaded incomes
-    )
-    Loading
+  isLoading <- R.holdDyn
+    True
     (R.leftmost
-      [ LoadPage <$> loadPage
-      , GetResult <$> getResult
+      [ True <$ loadPage
+      , False <$ 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/Form.hs b/client/src/View/Payment/Form.hs
index 99dce13..064b5b3 100644
--- a/client/src/View/Payment/Form.hs
+++ b/client/src/View/Payment/Form.hs
@@ -113,6 +113,7 @@ view input cancel = do
 
       setCategory <-
         R.debounce  (1 :: NominalDiffTime) (R.updated $ Input._out_raw name)
+          >>= (return . R.ffilter (\name -> T.length name >= 3))
           >>= (Ajax.get . (fmap ("/api/payment/category?name=" <>)))
           >>= (return . R.mapMaybe (join . EitherUtil.eitherToMaybe))
 
diff --git a/client/src/View/Payment/Payment.hs b/client/src/View/Payment/Payment.hs
index a34d2f4..a97c3df 100644
--- a/client/src/View/Payment/Payment.hs
+++ b/client/src/View/Payment/Payment.hs
@@ -41,7 +41,7 @@ view input = do
   R.dyn . R.ffor categories . Loadable.view $ \categories -> do
 
     rec
-      payments <- Reducer.reducer $ Reducer.In
+      paymentPage <- Reducer.reducer $ Reducer.In
         { Reducer._in_page          = page
         , Reducer._in_search        = HeaderForm._out_search form
         , Reducer._in_frequency     = HeaderForm._out_frequency form
@@ -50,7 +50,7 @@ view input = do
         , Reducer._in_deletePayment = deletePayment
         }
 
-      let eventFromResult :: forall a. (((), Table.Out t, Pages.Out t) -> Event t a) -> m (Event t a)
+      let eventFromResult :: forall a. ((Table.Out t, Pages.Out t) -> Event t a) -> m (Event t a)
           eventFromResult op = ReflexUtil.flatten . fmap (Maybe.fromMaybe R.never . fmap op) $ result
 
       let addPayment =
@@ -59,18 +59,18 @@ view input = do
               , HeaderForm._out_addPayment form
               ]
 
-      page <- eventFromResult $ Pages._out_newPage . (\(_, _, c) -> c)
-      tableAddPayment <- eventFromResult $ Table._out_add . (\(_, b, _) -> b)
-      editPayment <- eventFromResult $ Table._out_edit . (\(_, b, _) -> b)
-      deletePayment <- eventFromResult $ Table._out_delete . (\(_, b, _) -> b)
+      page <- eventFromResult $ Pages._out_newPage . snd
+      tableAddPayment <- eventFromResult $ Table._out_add . fst
+      editPayment <- eventFromResult $ Table._out_edit . fst
+      deletePayment <- eventFromResult $ Table._out_delete . fst
 
       form <- HeaderForm.view $ HeaderForm.In
         { HeaderForm._in_reset             = () <$ addPayment
         , HeaderForm._in_categories        = categories
         }
 
-      result <- R.dyn . R.ffor payments $
-        Loadable.view $ \(PaymentPage page frequency header payments count) -> do
+      result <- Loadable.view2 paymentPage $
+        \(PaymentPage page frequency header payments count) -> do
 
           HeaderInfos.view $ HeaderInfos.In
             { HeaderInfos._in_users = _in_users input
@@ -94,7 +94,7 @@ view input = do
             , Pages._in_page = page
             }
 
-          return ((), table, pages)
+          return (table, pages)
 
     return ()
 
diff --git a/client/src/View/Payment/Reducer.hs b/client/src/View/Payment/Reducer.hs
index 0b6c041..d221ff0 100644
--- a/client/src/View/Payment/Reducer.hs
+++ b/client/src/View/Payment/Reducer.hs
@@ -13,9 +13,9 @@ import qualified Reflex.Dom   as R
 
 import           Common.Model (Frequency (..), PaymentPage)
 
-import           Loadable     (Loadable (..))
-import qualified Loadable     as Loadable
+import           Loadable     (Loadable2 (..))
 import qualified Util.Ajax    as AjaxUtil
+import qualified Util.Either  as EitherUtil
 
 perPage :: Int
 perPage = 7
@@ -29,10 +29,6 @@ data In t a b c = In
   , _in_deletePayment :: Event t c
   }
 
-data Action
-  = LoadPage
-  | GetResult (Either Text PaymentPage)
-
 data Params = Params
   { _params_page      :: Int
   , _params_search    :: Text
@@ -48,7 +44,7 @@ data Msg
   | ResetSearch
   deriving Show
 
-reducer :: forall t m a b c. MonadWidget t m => In t a b c -> m (Dynamic t (Loadable PaymentPage))
+reducer :: forall t m a b c. MonadWidget t m => In t a b c -> m (Loadable2 t PaymentPage)
 reducer input = do
 
   postBuild <- R.getPostBuild
@@ -94,19 +90,19 @@ reducer input = do
 
   getResult <- AjaxUtil.get (pageUrl <$> paramsEvent)
 
-
-  R.foldDyn
-    (\action _ -> case action of
-      LoadPage                   -> Loading
-      GetResult (Left err)       -> Error err
-      GetResult (Right payments) -> Loaded payments
-    )
-    Loading
+  isLoading <- R.holdDyn
+    True
     (R.leftmost
-      [ LoadPage <$ paramsEvent
-      , GetResult <$> getResult
+      [ True <$ paramsEvent
+      , False <$ getResult
       ])
 
+  paymentPage <- R.holdDyn
+    Nothing
+    (fmap EitherUtil.eitherToMaybe getResult)
+
+  return $ Loadable2 isLoading paymentPage
+
   where
     pageUrl (Params page search frequency) =
       "api/payments?page="