From 7194cddb28656c721342c2ef604f9f9fb0692960 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 19 Nov 2017 00:20:25 +0100
Subject: Show payment count and partition

- Also fixes exceedingPayer in back by using only punctual payments
---
 client/src/View/Payment/Header.hs | 70 +++++++++++++++++++++++++++++++++++++++
 1 file changed, 70 insertions(+)
 create mode 100644 client/src/View/Payment/Header.hs

(limited to 'client/src/View/Payment/Header.hs')

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