aboutsummaryrefslogtreecommitdiff
path: root/client/src/View/Payment/Header.hs
diff options
context:
space:
mode:
Diffstat (limited to 'client/src/View/Payment/Header.hs')
-rw-r--r--client/src/View/Payment/Header.hs70
1 files changed, 70 insertions, 0 deletions
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