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)
|