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
120
121
|
module View.Income.Form
( view
, In(..)
, Operation(..)
) where
import Control.Monad.IO.Class (liftIO)
import Data.Aeson (ToJSON)
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 (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 a = In
{ _in_operation :: Operation a
}
data Operation a
= New (Text -> Text -> a)
| Clone (Text -> Text -> a) Income
| Edit (Text -> Text -> a) Income
view :: forall t m a. (MonadWidget t m, ToJSON a) => In t a -> 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 a))
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
New _ -> currentDay
Clone _ _ -> currentDay
Edit _ income -> _income_date income
ajax =
case op of
New _ -> Ajax.post
Clone _ _ -> Ajax.post
Edit _ _ -> Ajax.put
headerLabel =
case op of
New _ -> Msg.get Msg.Income_AddLong
Clone _ _ -> Msg.get Msg.Income_AddLong
Edit _ _ -> Msg.get Msg.Income_Edit
mkPayload =
case op of
New f -> f
Clone f _ -> f
Edit f _ -> f
|
