Modify weelky report and payment search interface

- Add payment balance in weekly report
- Show a message and hide pages when the search results in no results
- Go to page 1 when the search is updated / erased

5 files changed, 74 insertions, 53 deletions

diff --git a/client/src/View/Payment.hs b/client/src/View/Payment.hs
index 8aa4d38..f4aaf5c 100644
--- a/client/src/View/Payment.hs
+++ b/client/src/View/Payment.hs
@@ -38,6 +38,8 @@ widget paymentIn = do
             (\s -> filter (filterPayment s) (_init_payments init))
             (_headerOut_search header)
 
+          paymentsPerPage = 7
+
       header <- Header.widget $ HeaderIn
         { _headerIn_init = init
         }
@@ -46,10 +48,13 @@ widget paymentIn = do
         { _tableIn_init = init
         , _tableIn_currentPage = _pagesOut_currentPage pages
         , _tableIn_payments = payments
+        , _tableIn_perPage = paymentsPerPage
         }
 
       pages <- Pages.widget $ PagesIn
-        { _pagesIn_payments = payments
+        { _pagesIn_total = length <$> payments
+        , _pagesIn_perPage = paymentsPerPage
+        , _pagesIn_reset = (fmap $ const ()) . R.updated $ _headerOut_search header
         }
 
     return $ PaymentOut {}
diff --git a/client/src/View/Payment/Constants.hs b/client/src/View/Payment/Constants.hs
deleted file mode 100644
index 028e328..0000000
--- a/client/src/View/Payment/Constants.hs
+++ /dev/null
@@ -1,6 +0,0 @@
-module View.Payment.Constants
-  ( paymentsPerPage
-  ) where
-
-paymentsPerPage :: Int
-paymentsPerPage = 7
diff --git a/client/src/View/Payment/Pages.hs b/client/src/View/Payment/Pages.hs
index dfd92c0..55ceb9f 100644
--- a/client/src/View/Payment/Pages.hs
+++ b/client/src/View/Payment/Pages.hs
@@ -4,20 +4,20 @@ module View.Payment.Pages
   , PagesOut(..)
   ) where
 
-import qualified Data.Text              as T
-import           Reflex.Dom             (Dynamic, Event, MonadWidget)
-import qualified Reflex.Dom             as R
+import qualified Data.Text  as T
+import           Reflex.Dom (Dynamic, Event, MonadWidget)
+import qualified Reflex.Dom as R
 
-import           Common.Model           (Payment (..))
-
-import           Component              (ButtonIn (..), ButtonOut (..))
-import qualified Component              as Component
+import           Component  (ButtonIn (..), ButtonOut (..))
+import qualified Component  as Component
 
 import qualified Icon
-import qualified View.Payment.Constants as Constants
+import qualified Util.Dom   as Dom
 
 data PagesIn t = PagesIn
-  { _pagesIn_payments :: Dynamic t [Payment]
+  { _pagesIn_total   :: Dynamic t Int
+  , _pagesIn_perPage :: Int
+  , _pagesIn_reset   :: Event t ()
   }
 
 data PagesOut t = PagesOut
@@ -26,9 +26,29 @@ data PagesOut t = PagesOut
 
 widget :: forall t m. MonadWidget t m => PagesIn t -> m (PagesOut t)
 widget pagesIn = do
+  currentPage <- Dom.divVisibleIf ((> 0) <$> total) $ pageButtons total perPage reset
+
+  return $ PagesOut
+    { _pagesOut_currentPage = currentPage
+    }
+
+  where
+    total = _pagesIn_total pagesIn
+    perPage = _pagesIn_perPage pagesIn
+    reset = _pagesIn_reset pagesIn
+
+pageButtons :: forall t m. MonadWidget t m => Dynamic t Int -> Int -> Event t () -> m (Dynamic t Int)
+pageButtons total perPage reset = do
   R.divClass "pages" $ do
     rec
-      currentPage <- R.holdDyn 1 . R.leftmost $ [ firstPageClic, previousPageClic, pageClic, nextPageClic, lastPageClic ]
+      currentPage <- R.holdDyn 1 . R.leftmost $
+        [ firstPageClic
+        , previousPageClic
+        , pageClic
+        , nextPageClic
+        , lastPageClic
+        , (const 1) <$> reset
+        ]
 
       firstPageClic <- pageButton noCurrentPage (R.constDyn 1) Icon.doubleLeftBar
 
@@ -41,17 +61,10 @@ widget pagesIn = do
 
       lastPageClic <- pageButton noCurrentPage maxPage Icon.doubleRightBar
 
-    return $ PagesOut
-      { _pagesOut_currentPage = currentPage
-      }
-
-    where maxPage =
-            R.ffor (_pagesIn_payments pagesIn) (\payments ->
-              ceiling $ toRational (length payments) / toRational Constants.paymentsPerPage
-            )
+    return currentPage
 
+    where maxPage = R.ffor total (\t -> ceiling $ toRational t / toRational perPage)
           pageEvent = R.switchPromptlyDyn . fmap R.leftmost
-
           noCurrentPage = R.constDyn Nothing
 
 range :: Int -> Int -> [Int]
diff --git a/client/src/View/Payment/Table.hs b/client/src/View/Payment/Table.hs
index 0c3b769..a49be5c 100644
--- a/client/src/View/Payment/Table.hs
+++ b/client/src/View/Payment/Table.hs
@@ -4,28 +4,29 @@ module View.Payment.Table
   , TableOut(..)
   ) where
 
-import qualified Data.List              as L
-import qualified Data.Map               as M
-import           Data.Text              (Text)
-import qualified Data.Text              as T
-import           Prelude                hiding (init)
-import           Reflex.Dom             (Dynamic, MonadWidget)
-import qualified Reflex.Dom             as R
-
-import           Common.Model           (Category (..), Init (..), Payment (..),
-                                         PaymentCategory (..), User (..))
-import qualified Common.Model           as CM
-import qualified Common.Msg             as Msg
-import qualified Common.Util.Text       as T
-import qualified Common.View.Format     as Format
+import qualified Data.List          as L
+import qualified Data.Map           as M
+import           Data.Text          (Text)
+import qualified Data.Text          as T
+import           Prelude            hiding (init)
+import           Reflex.Dom         (Dynamic, MonadWidget)
+import qualified Reflex.Dom         as R
+
+import           Common.Model       (Category (..), Init (..), Payment (..),
+                                     PaymentCategory (..), User (..))
+import qualified Common.Model       as CM
+import qualified Common.Msg         as Msg
+import qualified Common.Util.Text   as T
+import qualified Common.View.Format as Format
 
 import qualified Icon
-import qualified View.Payment.Constants as Constants
+import qualified Util.Dom           as Dom
 
 data TableIn t = TableIn
   { _tableIn_init        :: Init
   , _tableIn_currentPage :: Dynamic t Int
   , _tableIn_payments    :: Dynamic t [Payment]
+  , _tableIn_perPage     :: Int
   }
 
 data TableOut = TableOut
@@ -34,7 +35,8 @@ data TableOut = TableOut
 
 widget :: forall t m. MonadWidget t m => TableIn t -> m TableOut
 widget tableIn = do
-  _ <- R.divClass "table" $
+  R.divClass "table" $ do
+
     R.divClass "lines" $ do
       R.divClass "header" $ do
         R.divClass "cell name" $ R.text $ Msg.get Msg.Payment_Name
@@ -45,17 +47,24 @@ widget tableIn = do
         R.divClass "cell" $ R.blank
         R.divClass "cell" $ R.blank
         R.divClass "cell" $ R.blank
-      let init = _tableIn_init tableIn
-          currentPage = _tableIn_currentPage tableIn
-          payments = _tableIn_payments tableIn
-          paymentRange = getPaymentRange <$> payments <*> currentPage
-      R.simpleList paymentRange (paymentRow init)
+      _ <- R.simpleList paymentRange (paymentRow init)
+      return ()
+
+    Dom.divClassVisibleIf (null <$> payments) "emptyTableMsg" $
+      R.text $ Msg.get Msg.Payment_Empty
+
   return $ TableOut {}
 
-getPaymentRange :: [Payment] -> Int -> [Payment]
-getPaymentRange payments currentPage =
-  take Constants.paymentsPerPage
-    . drop ((currentPage - 1) * Constants.paymentsPerPage)
+  where
+    init = _tableIn_init tableIn
+    currentPage = _tableIn_currentPage tableIn
+    payments = _tableIn_payments tableIn
+    paymentRange = getPaymentRange (_tableIn_perPage tableIn) <$> payments <*> currentPage
+
+getPaymentRange :: Int -> [Payment] -> Int -> [Payment]
+getPaymentRange perPage payments currentPage =
+  take perPage
+    . drop ((currentPage - 1) * perPage)
     . reverse
     . L.sortOn _payment_date
     $ payments
diff --git a/client/src/View/SignIn.hs b/client/src/View/SignIn.hs
index be6b152..89be737 100644
--- a/client/src/View/SignIn.hs
+++ b/client/src/View/SignIn.hs
@@ -45,7 +45,7 @@ view result =
             ]
 
       button <- Component.button $ ButtonIn
-        { _buttonIn_class = R.constDyn ""
+        { _buttonIn_class = R.constDyn "validate"
         , _buttonIn_content = R.text (Msg.get Msg.SignIn_Button)
         , _buttonIn_waiting = waiting
         }
@@ -57,7 +57,7 @@ view result =
 askSignIn :: forall t m. MonadWidget t m => Event t Text -> m (Event t (Either Text Text))
 askSignIn email =
   fmap getResult <$> R.performRequestAsync xhrRequest
-  where xhrRequest = fmap (R.postJson "/signIn" . SignIn) email
+  where xhrRequest = fmap (R.postJson "/askSignIn" . SignIn) email
         getResult response =
           case R._xhrResponse_responseText response of
             Just key ->