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
|
module View.Category.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 (Category (..),
CreateCategoryForm (..),
EditCategoryForm (..))
import qualified Common.Msg as Msg
import qualified Common.Util.Time as TimeUtil
import qualified Common.Validation.Category as CategoryValidation
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 = In
{ _in_operation :: Operation
}
data Operation
= New
| Clone Category
| Edit Category
view :: forall t m a. MonadWidget t m => In -> Modal.Content t m
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/category"
, 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
name <- Input._out_raw <$> (Input.view
(Input.defaultIn
{ Input._in_label = Msg.get Msg.Category_Name
, Input._in_initialValue = name
, Input._in_validation = CategoryValidation.name
})
(name <$ reset)
confirm)
color <- Input._out_raw <$> (Input.view
(Input.defaultIn
{ Input._in_label = Msg.get Msg.Category_Color
, Input._in_initialValue = color
, Input._in_inputType = "color"
, Input._in_hasResetButton = False
, Input._in_validation = CategoryValidation.color
})
(color <$ reset)
confirm)
return $ do
n <- name
c <- color
return . V.Success $ mkPayload n c
op = _in_operation input
name =
case op of
New -> ""
Clone c -> _category_name c
Edit c -> _category_name c
color =
case op of
New -> ""
Clone c -> _category_color c
Edit c -> _category_color c
ajax =
case op of
Edit _ -> Ajax.put
_ -> Ajax.post
headerLabel =
case op of
Edit _ -> Msg.get Msg.Category_Edit
_ -> Msg.get Msg.Category_Add
mkPayload =
case op of
Edit i -> \a b -> Aeson.toJSON $ EditCategoryForm (_category_id i) a b
_ -> \a b -> Aeson.toJSON $ CreateCategoryForm a b
|
