aboutsummaryrefslogtreecommitdiff
path: root/client/src/View/Payment/HeaderInfos.hs
blob: f84ee1fe86825382d14be70c6722898886052e10 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
module View.Payment.HeaderInfos
  ( view
  , In(..)
  ) where

import           Control.Monad.IO.Class (liftIO)
import qualified Data.List              as L hiding (groupBy)
import           Data.Map               (Map)
import qualified Data.Map               as M
import           Data.Maybe             (fromMaybe)
import           Data.Text              (Text)
import qualified Data.Text              as T
import qualified Data.Time              as Time
import           Reflex.Dom             (Dynamic, Event, MonadWidget)
import qualified Reflex.Dom             as R

import           Common.Model           (Currency, ExceedingPayer (..),
                                         Payment (..), PaymentHeader (..),
                                         User (..), UserId)
import qualified Common.Model           as CM
import qualified Common.Msg             as Msg
import qualified Common.View.Format     as Format

data In t = In
  { _in_users        :: [User]
  , _in_currency     :: Currency
  , _in_header       :: PaymentHeader
  , _in_paymentCount :: Int
  }

view :: forall t m. MonadWidget t m => In t -> m ()
view input =
  R.divClass "g-PaymentHeaderInfos" $ do
    exceedingPayers
      (_in_users input)
      (_in_currency input)
      (_paymentHeader_exceedingPayers header)

    infos
      (_in_users input)
      (_in_currency input)
      (_paymentHeader_repartition header)
      (_in_paymentCount input)

  where
    header = _in_header input

exceedingPayers
  :: forall t m. MonadWidget t m
  => [User]
  -> Currency
  -> [ExceedingPayer]
  -> m ()
exceedingPayers users currency payers =
  R.divClass "g-PaymentHeaderInfos__ExceedingPayers" $
    flip mapM_ payers $ \payer ->
      R.elClass "span" "exceedingPayer" $ do
        R.elClass "span" "userName" $
          R.text $
            fromMaybe "" . fmap _user_name $ CM.findUser (_exceedingPayer_userId payer) users
        R.elClass "span" "amount" $ do
          R.text "+ "
          R.text . Format.price currency $ _exceedingPayer_amount payer

infos
  :: forall t m. MonadWidget t m
  => [User]
  -> Currency
  -> Map UserId Int
  -> Int
  -> m ()
infos users currency repartition paymentCount =
  R.divClass "g-PaymentHeaderInfos__Repartition" $ 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 (M.foldl (+) 0 repartition))

    R.elClass "span" "partition" . R.text $
      let totalByUser =
            L.sortBy (\(_, t1) (_, t2) -> compare t2 t1)
              . M.toList
              $ repartition
      in  T.intercalate ", " . flip map totalByUser $ \(userId, userTotal) ->
            Msg.get $ Msg.Payment_By
              (fromMaybe "" . fmap _user_name $ CM.findUser userId users)
              (Format.price currency userTotal)