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
95
96
|
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 (..),
SavedPayment (..), 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
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-HeaderInfos" $ 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-HeaderInfos__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-HeaderInfos__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)
|
