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
|
module View.Income.Form
( view
, In(..)
, Out(..)
) where
import Data.Aeson (FromJSON, ToJSON)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Calendar (Day)
import qualified Data.Time.Calendar as Calendar
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 (Income)
import qualified Common.Msg as Msg
import qualified Common.Validation.Income as IncomeValidation
import qualified Component.Input as Input
import qualified Component.ModalForm as ModalForm
data In m t a = In
{ _in_cancel :: Event t ()
, _in_headerLabel :: Text
, _in_amount :: Text
, _in_date :: Day
, _in_mkPayload :: Text -> Text -> a
, _in_ajax :: Text -> Event t a -> m (Event t (Either Text Income))
}
data Out t = Out
{ _out_hide :: Event t ()
, _out_addIncome :: Event t Income
}
view :: forall t m a. (MonadWidget t m, ToJSON a) => In m t a -> m (Out t)
view input = do
rec
let reset = R.leftmost
[ "" <$ ModalForm._out_cancel modalForm
, "" <$ ModalForm._out_validate modalForm
, "" <$ _in_cancel input
]
modalForm <- ModalForm.view $ ModalForm.In
{ ModalForm._in_headerLabel = _in_headerLabel input
, ModalForm._in_ajax = _in_ajax input "/api/income"
, ModalForm._in_form = form reset (ModalForm._out_confirm modalForm)
}
return $ Out
{ _out_hide = ModalForm._out_hide modalForm
, _out_addIncome = ModalForm._out_validate modalForm
}
where
form
:: Event t String
-> Event t ()
-> m (Dynamic t (Validation Text a))
form reset confirm = do
amount <- Input._out_raw <$> (Input.view
(Input.defaultIn
{ Input._in_label = Msg.get Msg.Income_Amount
, Input._in_initialValue = _in_amount input
, Input._in_validation = IncomeValidation.amount
})
(_in_amount input <$ reset)
confirm)
let initialDate = T.pack . Calendar.showGregorian . _in_date $ input
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 $ (_in_mkPayload input) a d
|
