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
97
98
99
100
101
102
103
104
105
106
|
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecursiveDo #-}
module View.Payment.Table
( widget
, TableIn(..)
, TableOut(..)
) where
import qualified Data.List as L
import qualified Data.Map as M
import Data.Text (Text)
import qualified Data.Text as T
import Prelude hiding (init)
import Reflex.Dom (MonadWidget, Dynamic)
import qualified Reflex.Dom as R
import qualified Common.Message as Message
import qualified Common.Message.Key as Key
import Common.Model (Category (..), Init (..), Payment (..),
PaymentCategory (..), User (..))
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 t = TableIn
{ _tableIn_init :: Init
, _tableIn_currentPage :: Dynamic t Int
}
data TableOut = TableOut
{
}
visiblePayments :: Int
visiblePayments = 8
widget :: forall t m. MonadWidget t m => TableIn t -> m TableOut
widget tableIn = do
R.dynText (fmap (T.pack . show) . _tableIn_currentPage $ tableIn)
_ <- 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
paymentRange = fmap
(\p -> take visiblePayments . drop ((p - 1) * visiblePayments) . reverse . L.sortOn _payment_date $ payments)
(_tableIn_currentPage tableIn)
R.simpleList paymentRange (paymentRow init)
return $ TableOut {}
paymentRow :: forall t m. MonadWidget t m => Init -> Dynamic t Payment -> m ()
paymentRow init payment =
R.divClass "row" $ do
R.divClass "cell name" . R.dynText . fmap _payment_name $ payment
R.divClass "cell cost" . R.dynText . fmap (Format.price (_init_currency init) . _payment_cost) $ payment
let user = flip fmap payment $ \p -> CM.findUser (_payment_user p) (_init_users init)
R.divClass "cell user" $
R.dynText $ flip fmap user $ \mbUser -> case mbUser of
Just u -> _user_name u
_ -> ""
let category = flip fmap payment $ \p -> findCategory
(_init_categories init)
(_init_paymentCategories init)
(_payment_name p)
R.divClass "cell category" $ do
let attrs = flip fmap category $ \maybeCategory -> case maybeCategory of
Just c -> M.fromList
[ ("class", "tag")
, ("style", T.concat [ "background-color: ", _category_color c ])
]
Nothing -> M.singleton "display" "none"
R.elDynAttr "span" attrs $
R.dynText $ flip fmap category $ \mbCategory -> case mbCategory of
Just c -> _category_name c
_ -> ""
R.divClass "cell date" $ do
R.elClass "span" "shortDate" . R.dynText . fmap (Format.shortDay . _payment_date) $ payment
R.elClass "span" "longDate" . R.dynText . fmap (Format.longDay . _payment_date) $ payment
R.divClass "cell button" . R.el "button" $ Icon.clone
let modifyAttrs = flip fmap payment $ \p ->
M.fromList [("class", "cell button"), ("display", if _payment_user p == _init_currentUser init then "block" else "none")]
R.elDynAttr "div" modifyAttrs $
R.el "button" $ Icon.edit
R.elDynAttr "div" modifyAttrs $
R.el "button" $ Icon.delete
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
|
