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
|
module View.Income.Form
( view
, FormIn(..)
, FormOut(..)
) 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 Component (InputIn (..), InputOut (..),
ModalFormIn (..), ModalFormOut (..))
import qualified Component as Component
data FormIn m t a = FormIn
{ _formIn_cancel :: Event t ()
, _formIn_headerLabel :: Text
, _formIn_amount :: Text
, _formIn_date :: Day
, _formIn_mkPayload :: Text -> Text -> a
, _formIn_ajax :: Text -> Event t a -> m (Event t (Either Text Income))
}
data FormOut t = FormOut
{ _formOut_hide :: Event t ()
, _formOut_addIncome :: Event t Income
}
view :: forall t m a. (MonadWidget t m, ToJSON a) => FormIn m t a -> m (FormOut t)
view formIn = do
rec
let reset = R.leftmost
[ "" <$ _modalFormOut_cancel modalForm
, "" <$ _modalFormOut_validate modalForm
, "" <$ _formIn_cancel formIn
]
modalForm <- Component.modalForm $ ModalFormIn
{ _modalFormIn_headerLabel = _formIn_headerLabel formIn
, _modalFormIn_ajax = _formIn_ajax formIn "/api/income"
, _modalFormIn_form = form reset (_modalFormOut_confirm modalForm)
}
return $ FormOut
{ _formOut_hide = _modalFormOut_hide modalForm
, _formOut_addIncome = _modalFormOut_validate modalForm
}
where
form
:: Event t String
-> Event t ()
-> m (Dynamic t (Validation Text a))
form reset confirm = do
amount <- _inputOut_raw <$> (Component.input
(Component.defaultInputIn
{ _inputIn_label = Msg.get Msg.Income_Amount
, _inputIn_initialValue = _formIn_amount formIn
, _inputIn_validation = IncomeValidation.amount
})
(_formIn_amount formIn <$ reset)
confirm)
let initialDate = T.pack . Calendar.showGregorian . _formIn_date $ formIn
date <- _inputOut_raw <$> (Component.input
(Component.defaultInputIn
{ _inputIn_label = Msg.get Msg.Income_Date
, _inputIn_initialValue = initialDate
, _inputIn_inputType = "date"
, _inputIn_hasResetButton = False
, _inputIn_validation = IncomeValidation.date
})
(initialDate <$ reset)
confirm)
return $ do
a <- amount
d <- date
return . V.Success $ (_formIn_mkPayload formIn) a d
|
