diff options
Diffstat (limited to 'client/src/View/Payment/Header.hs')
| -rw-r--r-- | client/src/View/Payment/Header.hs | 66 |
1 files changed, 48 insertions, 18 deletions
diff --git a/client/src/View/Payment/Header.hs b/client/src/View/Payment/Header.hs index 67b4eb4..3f2adc3 100644 --- a/client/src/View/Payment/Header.hs +++ b/client/src/View/Payment/Header.hs @@ -4,22 +4,29 @@ module View.Payment.Header , 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 Control.Monad (forM_) +import Control.Monad.IO.Class (liftIO) +import qualified Data.List as L hiding (groupBy) +import Data.Maybe (fromMaybe) +import qualified Data.Text as T +import qualified Data.Time as Time +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 Common.Model (Currency, ExceedingPayer (..), + Frequency (..), Income (..), Init (..), + Payment (..), User (..), UserId) +import qualified Common.Model as CM +import qualified Common.Msg as Msg +import qualified Common.View.Format as Format -import qualified Util.List as L +import Component (ButtonIn (..)) +import qualified Component as Component +import qualified Util.List as L data HeaderIn t = HeaderIn - { _headerIn_init :: Init + { _headerIn_init :: Init } data HeaderOut = HeaderOut @@ -29,13 +36,37 @@ data HeaderOut = HeaderOut widget :: forall t m. MonadWidget t m => HeaderIn t -> m HeaderOut widget headerIn = R.divClass "header" $ do + payerAndAdd incomes payments users currency infos payments users currency return $ HeaderOut {} where init = _headerIn_init headerIn - payments = _init_payments init + incomes = _init_incomes init + payments = filter ((==) Punctual . _payment_frequency) (_init_payments init) users = _init_users init currency = _init_currency init +payerAndAdd :: forall t m. MonadWidget t m => [Income] -> [Payment] -> [User] -> Currency -> m () +payerAndAdd incomes payments users currency = do + time <- liftIO Time.getCurrentTime + R.divClass "payerAndAdd" $ do + R.divClass "exceedingPayers" $ + forM_ + (CM.getExceedingPayers time users incomes payments) + (\p -> + R.elClass "span" "exceedingPayer" $ do + R.elClass "span" "userName" $ + R.text . fromMaybe "" . fmap _user_name $ CM.findUser (_exceedingPayer_userId p) users + R.elClass "span" "amount" $ do + R.text "+ " + R.text . Format.price currency $ _exceedingPayer_amount p + ) + _ <- Component.button $ ButtonIn + { _buttonIn_class = R.constDyn "addPayment" + , _buttonIn_content = R.text $ Msg.get Msg.Payment_Add + , _buttonIn_waiting = R.never + } + return () + infos :: forall t m. MonadWidget t m => [Payment] -> [User] -> Currency -> m () infos payments users currency = R.divClass "infos" $ do @@ -52,14 +83,13 @@ infos payments users currency = T.intercalate ", " . map (\(userId, userTotal) -> Msg.get $ Msg.Payment_By - (fromMaybe "" . fmap _user_name . L.find ((==) userId . _user_id) $ users) + (fromMaybe "" . fmap _user_name $ CM.findUser userId users) (Format.price currency userTotal) ) $ totalByUser - where punctualPayments = filter ((==) Punctual . _payment_frequency) payments - paymentCount = length punctualPayments - total = sum . map _payment_cost $ punctualPayments + where paymentCount = length payments + total = sum . map _payment_cost $ payments totalByUser :: [(UserId, Int)] totalByUser = @@ -67,4 +97,4 @@ infos payments users currency = . map (\(u, xs) -> (u, sum . map snd $ xs)) . L.groupBy fst . map (\p -> (_payment_user p, _payment_cost p)) - $ punctualPayments + $ payments |