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
107
|
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 (Dynamic, MonadWidget)
import qualified Reflex.Dom as R
import Common.Model (Category (..), Init (..), Payment (..),
PaymentCategory (..), User (..))
import qualified Common.Model as CM
import qualified Common.Msg as Msg
import qualified Common.Util.Text as T
import qualified Common.View.Format as Format
import qualified Icon
import qualified View.Payment.Constants as Constants
data TableIn t = TableIn
{ _tableIn_init :: Init
, _tableIn_currentPage :: Dynamic t Int
, _tableIn_payments :: Dynamic t [Payment]
}
data TableOut = TableOut
{
}
widget :: forall t m. MonadWidget t m => TableIn t -> m TableOut
widget tableIn = do
_ <- R.divClass "table" $
R.divClass "lines" $ do
R.divClass "header" $ do
R.divClass "cell name" $ R.text $ Msg.get Msg.Payment_Name
R.divClass "cell cost" $ R.text $ Msg.get Msg.Payment_Cost
R.divClass "cell user" $ R.text $ Msg.get Msg.Payment_User
R.divClass "cell category" $ R.text $ Msg.get Msg.Payment_Category
R.divClass "cell date" $ R.text $ Msg.get Msg.Payment_Date
R.divClass "cell" $ R.blank
R.divClass "cell" $ R.blank
R.divClass "cell" $ R.blank
let init = _tableIn_init tableIn
currentPage = _tableIn_currentPage tableIn
payments = _tableIn_payments tableIn
paymentRange = getPaymentRange <$> payments <*> currentPage
R.simpleList paymentRange (paymentRow init)
return $ TableOut {}
getPaymentRange :: [Payment] -> Int -> [Payment]
getPaymentRange payments currentPage =
take Constants.paymentsPerPage
. drop ((currentPage - 1) * Constants.paymentsPerPage)
. reverse
. L.sortOn _payment_date
$ payments
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
|
