blob: f3eb9a7953611304a980405300b664d0d63cbf49 (
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
|
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecursiveDo #-}
module View.Payment.Table
( widget
, TableIn(..)
, TableOut(..)
) where
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.List as L
import qualified Data.Map as M
import Prelude hiding (init)
import Reflex.Dom (MonadWidget)
import qualified Reflex.Dom as R
import qualified Common.Message as Message
import qualified Common.Message.Key as Key
import Common.Model (Payment(..), PaymentCategory(..), Category(..), User(..), Init(..))
import qualified Common.Model as CM
import qualified Common.Util.Text as T
import qualified Common.View.Format as Format
import qualified Icon
data TableIn = TableIn
{ _tableIn_init :: Init
}
data TableOut = TableOut
{
}
widget :: forall t m. MonadWidget t m => TableIn -> m TableOut
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" $ R.blank
R.divClass "cell" $ R.blank
R.divClass "cell" $ R.blank
let init = _tableIn_init tableIn
payments = _init_payments init
mapM_
(paymentRow init)
(take 8 . reverse . L.sortOn _payment_date $ payments)
return $ TableOut {}
paymentRow :: forall t m. MonadWidget t m => Init -> Payment -> m ()
paymentRow init payment =
R.divClass "row" $ do
R.divClass "cell name" . R.text $ _payment_name payment
R.divClass "cell cost" . R.text . Format.price (_init_currency init) $ _payment_cost payment
R.divClass "cell user" $
case CM.findUser (_payment_user payment) (_init_users init) of
Just user -> R.text (_user_name user)
_ -> R.blank
R.divClass "cell category" $
case findCategory (_init_categories init) (_init_paymentCategories init) (_payment_name payment) of
Just category ->
R.elAttr "span" (M.fromList [("class", "tag"), ("style", T.concat [ "background-color: ", _category_color category ])]) $
R.text $ _category_name category
_ ->
R.blank
R.divClass "cell date" $ do
R.elClass "span" "shortDate" . R.text $ Format.shortDay (_payment_date payment)
R.elClass "span" "longDate" . R.text $ Format.longDay (_payment_date payment)
R.divClass "cell button" . R.el "button" $ Icon.clone
R.divClass "cell button" $
if _payment_user payment == (_init_currentUser init)
then R.el "button" $ Icon.edit
else R.blank
R.divClass "cell button" $
if _payment_user payment == (_init_currentUser init)
then R.el "button" $ Icon.delete
else R.blank
findCategory :: [Category] -> [PaymentCategory] -> Text -> Maybe Category
findCategory categories paymentCategories paymentName = do
paymentCategory <- L.find
((== (T.unaccent . T.toLower) paymentName) . _paymentCategory_name)
paymentCategories
L.find ((== (_paymentCategory_category paymentCategory)) . _category_id) categories
|
