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
|
module View.Payment.Add
( view
, AddIn(..)
, AddOut(..)
) where
import Control.Monad.IO.Class (liftIO)
import qualified Data.Map as M
import qualified Data.Maybe as Maybe
import qualified Data.Text as T
import qualified Data.Time.Clock as Time
import Reflex.Dom (Event, MonadWidget)
import qualified Reflex.Dom as R
import qualified Text.Read as T
import Common.Model (Category (..), CreatePayment (..),
Frequency (..))
import qualified Common.Msg as Msg
import qualified Common.Util.Time as Time
import qualified Common.View.Format as Format
import Component (ButtonIn (..), InputIn (..),
InputOut (..), SelectIn (..),
SelectOut (..))
import qualified Component as Component
import qualified Util.Ajax as Ajax
import qualified Util.WaitFor as Util
data AddIn = AddIn
{ _addIn_categories :: [Category]
}
data AddOut t = AddOut
{ _addOut_cancel :: Event t ()
}
view :: forall t m. MonadWidget t m => AddIn -> m (AddOut t)
view addIn = do
R.divClass "add" $ do
R.divClass "addHeader" $ R.text $ Msg.get Msg.Payment_Add
R.divClass "addContent" $ do
name <- _inputOut_value <$> (Component.input $
Component.defaultInputIn { _inputIn_label = Msg.get Msg.Payment_Name })
cost <- _inputOut_value <$> (Component.input $
Component.defaultInputIn { _inputIn_label = Msg.get Msg.Payment_Cost })
currentDay <- liftIO $ Time.getCurrentTime >>= Time.timeToDay
date <- _inputOut_value <$> (Component.input $
Component.defaultInputIn
{ _inputIn_label = Msg.get Msg.Payment_Cost
, _inputIn_initialValue = Format.shortDay currentDay
})
frequency <- _selectOut_value <$> (Component.select $ SelectIn
{ _selectIn_label = Msg.get Msg.Payment_Frequency
, _selectIn_initialValue = Punctual
, _selectIn_values = R.constDyn frequencies
})
category <- _selectOut_value <$> (Component.select $ SelectIn
{ _selectIn_label = Msg.get Msg.Payment_Category
, _selectIn_initialValue = 0
, _selectIn_values = R.constDyn categories
})
let payment = CreatePayment
<$> name
<*> fmap (Maybe.fromMaybe 0 . T.readMaybe . T.unpack) cost
<*> fmap (Maybe.fromMaybe currentDay . Time.parseDay) date
<*> category
<*> frequency
cancel <- R.divClass "buttons" $ do
rec
validate <- Component._buttonOut_clic <$> (Component.button $
(Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Confirm))
{ _buttonIn_class = R.constDyn "confirm"
, _buttonIn_waiting = waiting
, _buttonIn_submit = True
})
(_, waiting) <- Util.waitFor
(Ajax.post "/payment")
validate
payment
Component._buttonOut_clic <$> (Component.button $
(Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Undo))
{ _buttonIn_class = R.constDyn "undo" })
return AddOut
{ _addOut_cancel = cancel
}
where
frequencies = M.fromList
[ (Punctual, Msg.get Msg.Payment_PunctualMale)
, (Monthly, Msg.get Msg.Payment_MonthlyMale)
]
categories = M.fromList . flip map (_addIn_categories addIn) $ \c ->
(_category_id c, _category_name c)
|
