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
108
109
110
111
112
113
114
115
116
117
118
119
|
module View.Income.Form
( view
, In(..)
, Operation(..)
) where
import Control.Monad.IO.Class (liftIO)
import Data.Aeson (Value)
import qualified Data.Aeson as Aeson
import qualified Data.Maybe as Maybe
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Time.Calendar as Calendar
import qualified Data.Time.Clock as Time
import Data.Validation (Validation)
import qualified Data.Validation as V
import Reflex.Dom (Dynamic, Event, MonadWidget)
import qualified Reflex.Dom as R
import Common.Model (CreateIncomeForm (..),
EditIncomeForm (..), Income (..))
import qualified Common.Msg as Msg
import qualified Common.Util.Time as TimeUtil
import qualified Common.Validation.Income as IncomeValidation
import qualified Component.Input as Input
import qualified Component.Modal as Modal
import qualified Component.ModalForm as ModalForm
import qualified Util.Ajax as Ajax
data In t = In
{ _in_operation :: Operation
}
data Operation
= New
| Clone Income
| Edit Income
view :: forall t m a. MonadWidget t m => In t -> Modal.Content t m Income
view input cancel = do
rec
let reset = R.leftmost
[ "" <$ ModalForm._out_cancel modalForm
, "" <$ ModalForm._out_validate modalForm
, "" <$ cancel
]
modalForm <- ModalForm.view $ ModalForm.In
{ ModalForm._in_headerLabel = headerLabel
, ModalForm._in_ajax = ajax "/api/income"
, ModalForm._in_form = form reset (ModalForm._out_confirm modalForm)
}
return (ModalForm._out_hide modalForm, ModalForm._out_validate modalForm)
where
form
:: Event t String
-> Event t ()
-> m (Dynamic t (Validation Text Value))
form reset confirm = do
amount <- Input._out_raw <$> (Input.view
(Input.defaultIn
{ Input._in_label = Msg.get Msg.Income_Amount
, Input._in_initialValue = amount
, Input._in_validation = IncomeValidation.amount
})
(amount <$ reset)
confirm)
currentDay <- liftIO $ Time.getCurrentTime >>= TimeUtil.timeToDay
let initialDate = T.pack . Calendar.showGregorian $ date currentDay
date <- Input._out_raw <$> (Input.view
(Input.defaultIn
{ Input._in_label = Msg.get Msg.Income_Date
, Input._in_initialValue = initialDate
, Input._in_inputType = "date"
, Input._in_hasResetButton = False
, Input._in_validation = IncomeValidation.date
})
(initialDate <$ reset)
confirm)
return $ do
a <- amount
d <- date
return . V.Success $ mkPayload a d
op = _in_operation input
amount =
case op of
New -> ""
Clone income -> T.pack . show . _income_amount $ income
Edit income -> T.pack . show . _income_amount $ income
date currentDay =
case op of
Edit income -> _income_date income
_ -> currentDay
ajax =
case op of
Edit _ -> Ajax.put
_ -> Ajax.post
headerLabel =
case op of
Edit _ -> Msg.get Msg.Income_Edit
_ -> Msg.get Msg.Income_AddLong
mkPayload =
case op of
Edit income -> \a b -> Aeson.toJSON $ EditIncomeForm (_income_id income) a b
_ -> \a b -> Aeson.toJSON $ CreateIncomeForm a b
|
