Show payment count and partition

- Also fixes exceedingPayer in back by using only punctual payments

4 files changed, 87 insertions, 21 deletions

diff --git a/client/src/View/Payment/Constants.hs b/client/src/View/Payment/Constants.hs
index ac2320a..028e328 100644
--- a/client/src/View/Payment/Constants.hs
+++ b/client/src/View/Payment/Constants.hs
@@ -3,4 +3,4 @@ module View.Payment.Constants
   ) where
 
 paymentsPerPage :: Int
-paymentsPerPage = 8
+paymentsPerPage = 7
diff --git a/client/src/View/Payment/Header.hs b/client/src/View/Payment/Header.hs
new file mode 100644
index 0000000..67b4eb4
--- /dev/null
+++ b/client/src/View/Payment/Header.hs
@@ -0,0 +1,70 @@
+module View.Payment.Header
+  ( widget
+  , HeaderIn(..)
+  , HeaderOut(..)
+  ) where
+
+import qualified Data.List          as L hiding (groupBy)
+import           Data.Maybe         (fromMaybe)
+import qualified Data.Text          as T
+import           Prelude            hiding (init)
+import           Reflex.Dom         (MonadWidget)
+import qualified Reflex.Dom         as R
+
+import           Common.Model       (Currency, Frequency (..), Init (..),
+                                     Payment (..), User (..), UserId)
+import qualified Common.Msg         as Msg
+import qualified Common.View.Format as Format
+
+import qualified Util.List          as L
+
+data HeaderIn t = HeaderIn
+  { _headerIn_init    :: Init
+  }
+
+data HeaderOut = HeaderOut
+  {
+  }
+
+widget :: forall t m. MonadWidget t m => HeaderIn t -> m HeaderOut
+widget headerIn =
+  R.divClass "header" $ do
+    infos payments users currency
+    return $ HeaderOut {}
+  where init = _headerIn_init headerIn
+        payments = _init_payments init
+        users = _init_users init
+        currency = _init_currency init
+
+infos :: forall t m. MonadWidget t m => [Payment] -> [User] -> Currency -> m ()
+infos payments users currency =
+  R.divClass "infos" $ do
+    R.elClass "span" "total" $ do
+      R.text . Msg.get $ Msg.Payment_Worth
+        (T.intercalate " "
+          [ (Format.number paymentCount)
+          , if paymentCount > 1
+              then Msg.get Msg.Payment_Many
+              else Msg.get Msg.Payment_One
+          ])
+        (Format.price currency total)
+    R.elClass "span" "partition" . R.text $
+      T.intercalate ", "
+        . map (\(userId, userTotal) ->
+            Msg.get $ Msg.Payment_By
+              (fromMaybe "" . fmap _user_name . L.find ((==) userId . _user_id) $ users)
+              (Format.price currency userTotal)
+          )
+        $ totalByUser
+
+  where punctualPayments = filter ((==) Punctual . _payment_frequency) payments
+        paymentCount = length punctualPayments
+        total = sum . map _payment_cost $ punctualPayments
+
+        totalByUser :: [(UserId, Int)]
+        totalByUser =
+          L.sortBy (\(_, t1) (_, t2) -> compare t2 t1)
+            . map (\(u, xs) -> (u, sum . map snd $ xs))
+            . L.groupBy fst
+            . map (\p -> (_payment_user p, _payment_cost p))
+            $ punctualPayments
diff --git a/client/src/View/Payment/Pages.hs b/client/src/View/Payment/Pages.hs
index f96cb8e..81555ab 100644
--- a/client/src/View/Payment/Pages.hs
+++ b/client/src/View/Payment/Pages.hs
@@ -1,6 +1,3 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecursiveDo       #-}
-
 module View.Payment.Pages
   ( widget
   , PagesIn(..)
@@ -11,7 +8,7 @@ import qualified Data.Text              as T
 import           Reflex.Dom             (Dynamic, Event, MonadWidget)
 import qualified Reflex.Dom             as R
 
-import           Common.Model           (Payment (..))
+import           Common.Model           (Frequency (..), Payment (..))
 
 import           Component              (ButtonIn (..), ButtonOut (..))
 import qualified Component              as Component
@@ -48,7 +45,8 @@ widget pagesIn = do
       { _pagesOut_currentPage = currentPage
       }
 
-    where maxPage = ceiling $ (toRational . length . _pagesIn_payments $ pagesIn) / toRational Constants.paymentsPerPage
+    where paymentCount = length . filter ((==) Punctual . _payment_frequency) . _pagesIn_payments $ pagesIn
+          maxPage = ceiling $ toRational paymentCount / toRational Constants.paymentsPerPage
           pageEvent = R.switchPromptlyDyn . fmap R.leftmost
 
 range :: Int -> Int -> [Int]
diff --git a/client/src/View/Payment/Table.hs b/client/src/View/Payment/Table.hs
index 5c0b709..d8093a5 100644
--- a/client/src/View/Payment/Table.hs
+++ b/client/src/View/Payment/Table.hs
@@ -1,6 +1,3 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecursiveDo       #-}
-
 module View.Payment.Table
   ( widget
   , TableIn(..)
@@ -15,11 +12,11 @@ import           Prelude                hiding (init)
 import           Reflex.Dom             (Dynamic, MonadWidget)
 import qualified Reflex.Dom             as R
 
-import qualified Common.Message         as Message
-import qualified Common.Message.Key     as Key
-import           Common.Model           (Category (..), Init (..), Payment (..),
+import           Common.Model           (Category (..), Frequency (..),
+                                         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
 
@@ -40,11 +37,11 @@ widget tableIn = do
   _ <- R.divClass "table" $
     R.divClass "lines" $ do
       R.divClass "header" $ do
-        R.divClass "cell name" $ R.text $ Message.get Key.Payment_Name
-        R.divClass "cell cost" $ R.text $ Message.get Key.Payment_Cost
-        R.divClass "cell user" $ R.text $ Message.get Key.Payment_User
-        R.divClass "cell category" $ R.text $ Message.get Key.Payment_Category
-        R.divClass "cell date" $ R.text $ Message.get Key.Payment_Date
+        R.divClass "cell name" $ R.text $ Msg.get Msg.Payment_Name
+        R.divClass "cell cost" $ R.text $ Msg.get Msg.Payment_Cost
+        R.divClass "cell user" $ R.text $ Msg.get Msg.Payment_User
+        R.divClass "cell category" $ R.text $ Msg.get Msg.Payment_Category
+        R.divClass "cell date" $ R.text $ Msg.get Msg.Payment_Date
         R.divClass "cell" $ R.blank
         R.divClass "cell" $ R.blank
         R.divClass "cell" $ R.blank
@@ -58,10 +55,11 @@ widget tableIn = do
 getPaymentRange :: [Payment] -> Int -> [Payment]
 getPaymentRange payments currentPage =
   take Constants.paymentsPerPage
-  . drop ((currentPage - 1) * Constants.paymentsPerPage)
-  . reverse
-  . L.sortOn _payment_date
-  $ payments
+    . drop ((currentPage - 1) * Constants.paymentsPerPage)
+    . reverse
+    . L.sortOn _payment_date
+    . filter ((==) Punctual . _payment_frequency)
+    $ payments
 
 paymentRow :: forall t m. MonadWidget t m => Init -> Dynamic t Payment -> m ()
 paymentRow init payment =