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/Constants.hs | 2 +- client/src/View/Payment/Header.hs | 70 ++++++++++++++++++++++++++++++++++++ client/src/View/Payment/Pages.hs | 8 ++--- client/src/View/Payment/Table.hs | 28 +++++++-------- 4 files changed, 87 insertions(+), 21 deletions(-) create mode 100644 client/src/View/Payment/Header.hs (limited to 'client/src/View/Payment') 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 = -- cgit v1.2.3