/
Internal.purs
256 lines (227 loc) · 9.22 KB
/
Internal.purs
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
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
module Lumi.Components.Form.Internal where
import Prelude
import Control.MonadZero (class Alt, class Alternative, class MonadZero, class Plus)
import Control.Parallel.Class (class Parallel)
import Data.Array as Array
import Data.Either (either)
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype, un)
import Effect (Effect)
import Effect.Aff (Aff, runAff_)
import Effect.Exception (throwException)
import Lumi.Components.LabeledField (RequiredField, ValidationMessage)
import Prim.TypeError (class Warn, Above, Text)
import React.Basic (JSX, fragment, keyed)
data Tree
= Child
{ key :: Maybe String
, child :: JSX
}
| Wrapper
{ key :: Maybe String
, wrap :: Array JSX -> JSX
, children :: Forest
}
| Node
{ label :: JSX
, key :: Maybe String
, required :: RequiredField
, validationError :: Maybe ValidationMessage
, children :: Forest
}
type Forest = Array Tree
-- | Traverse a tree bottom-up, removing all "internal" nodes (i.e. `Wrapper`
-- | or `Node` constructors) which have empty `children` arrays. In the case
-- | where there's nothing left in the tree after pruning, we return `Nothing`.
-- |
-- | We need to perform the traversal bottom-up because, for example, a subtree
-- | such as
-- |
-- | ```
-- | let
-- | w children = Wrapper { key: Nothing, children }
-- | in
-- | w [w []]
-- | ```
-- |
-- | should be pruned, but a top-down operation would not be able to identify
-- | such a subtree as prunable.
pruneTree :: Tree -> Maybe Tree
pruneTree =
case _ of
t@(Child _) ->
Just t
Wrapper r@{ children } ->
case Array.mapMaybe pruneTree children of
[] ->
Nothing
children' ->
Just (Wrapper r { children = children' })
Node r@{ children } ->
case Array.mapMaybe pruneTree children of
[] ->
Nothing
children' ->
Just (Node r { children = children' })
-- | An applicative functor which can be used to build forms.
-- | Forms can be turned into components using the `build` function.
newtype FormBuilder' ui props unvalidated result = FormBuilder
(props
-- ^ additional props
-> unvalidated
-- ^ the current value
-> { edit :: ((unvalidated -> unvalidated) -> Effect Unit) -> ui
, validate :: Maybe result
})
type FormBuilder props unvalidated result = FormBuilder' Forest props unvalidated result
derive instance newtypeFormBuilder :: Newtype (FormBuilder' ui props unvalidated result) _
derive instance functorFormBuilder :: Functor (FormBuilder' ui props unvalidated)
instance applyFormBuilder :: Semigroup ui => Apply (FormBuilder' ui props unvalidated) where
apply (FormBuilder f) (FormBuilder x) = FormBuilder \props unvalidated ->
let { edit: editF, validate: validateF } = f props unvalidated
{ edit: editX, validate: validateX } = x props unvalidated
in { edit: \k -> editF k <> editX k
, validate: validateF <*> validateX
}
instance applicativeFormBuilder :: Monoid ui => Applicative (FormBuilder' ui props unvalidated) where
pure a = FormBuilder \_ _ ->
{ edit: mempty
, validate: pure a
}
instance parallelFormBuilder
:: Warn
( Above
(Text "The `Parallel` instance to `FormBuilder` is deprecated.")
(Text "Prefer using `Form.parallel` and `Form.sequential` instead.")
)
=> Parallel (FormBuilder' (Array Tree) props unvalidated) (SeqFormBuilder' (Array Tree) props unvalidated) where
parallel (SeqFormBuilder (FormBuilder f)) = FormBuilder \props value ->
let { edit, validate } = f props value
in { edit: \onChange ->
[ Wrapper
{ key: Just "seq"
, wrap: keyed "seq" <<< fragment
, children: edit onChange
}
]
, validate: validate
}
sequential = SeqFormBuilder
parallel :: forall props value. String -> SeqFormBuilder props value ~> FormBuilder props value
parallel key (SeqFormBuilder (FormBuilder f)) = FormBuilder \props value ->
let { edit, validate } = f props value
in { edit: \onChange ->
[ Wrapper
{ key: Just key
, wrap: keyed key <<< fragment
, children: edit onChange
}
]
, validate: validate
}
sequential :: forall props value. String -> FormBuilder props value ~> SeqFormBuilder props value
sequential key (FormBuilder f) = SeqFormBuilder $ FormBuilder \props value ->
let { edit, validate } = f props value
in { edit: \onChange ->
[ Wrapper
{ key: Just key
, wrap: keyed key <<< fragment
, children: edit onChange
}
]
, validate: validate
}
-- | A form builder where each field depends on the validity of the previous ones.
-- | That is, every field is only displayed if all the previous ones are valid.
-- | Forms can be turned into components using the `build` function.
newtype SeqFormBuilder' ui props unvalidated result =
SeqFormBuilder (FormBuilder' ui props unvalidated result)
type SeqFormBuilder props unvalidated result = SeqFormBuilder' Forest props unvalidated result
derive instance newtypeSeqFormBuilder :: Newtype (SeqFormBuilder' ui props unvalidated result) _
derive newtype instance functorSeqFormBuilder :: Functor (SeqFormBuilder' ui props unvalidated)
instance applySeqFormBuilder :: Monoid ui => Apply (SeqFormBuilder' ui props unvalidated) where
apply = ap
derive newtype instance applicativeSeqFormBuilder :: Monoid ui => Applicative (SeqFormBuilder' ui props unvalidated)
instance bindSeqFormBuilder :: Monoid ui => Bind (SeqFormBuilder' ui props unvalidated) where
bind (SeqFormBuilder f) g =
SeqFormBuilder $ FormBuilder \props unvalidated ->
let { edit: editF, validate: validateF } = (un FormBuilder f) props unvalidated
in
case g <$> validateF of
Nothing ->
{ edit: editF, validate: Nothing }
Just (SeqFormBuilder x) ->
let { edit: editX, validate: validateX } = (un FormBuilder x) props unvalidated
in { edit: \k -> editF k <> editX k
, validate: validateX
}
instance monadSeqFormBuilder :: Monoid ui => Monad (SeqFormBuilder' ui props unvalidated)
instance altSeqFormBuilder :: Monoid ui => Alt (SeqFormBuilder' ui props unvalidated) where
alt (SeqFormBuilder f) (SeqFormBuilder g) =
SeqFormBuilder $ FormBuilder \props unvalidated ->
let rf@{ edit: editF, validate: validateF } = un FormBuilder f props unvalidated
rg@{ edit: editG, validate: validateG } = un FormBuilder g props unvalidated
in case validateF, validateG of
Just _, _ -> rf
_, _ -> rg
instance plusSeqFormBuilder :: Monoid ui => Plus (SeqFormBuilder' ui props unvalidated) where
empty = SeqFormBuilder $ FormBuilder \_ _ -> { edit: mempty, validate: Nothing }
instance alternativeSeqFormBuilder :: Monoid ui => Alternative (SeqFormBuilder' ui props unvalidated)
instance monadZeroSeqFormBuilder :: Monoid ui => MonadZero (SeqFormBuilder' ui props unvalidated)
-- | Create a `FormBuilder` from a function which produces a form
-- | element as `JSX` and a validated result.
formBuilder
:: forall props unvalidated a
. (props
-> unvalidated
-> { edit :: ((unvalidated -> unvalidated) -> Effect Unit) -> JSX
, validate :: Maybe a
})
-> FormBuilder props unvalidated a
formBuilder f =
FormBuilder \props value ->
let { edit, validate } = f props value
in { edit: \onChange -> [ Child { key: Nothing, child: edit onChange } ]
, validate: validate
}
-- | The simplest way to create a `FormBuilder`. Create a `FormBuilder`
-- | provided a function that, given the current value and a change callback,
-- | renders a form element as `JSX`.
formBuilder_
:: forall props a
. (props -> a -> (a -> Effect Unit) -> JSX)
-> FormBuilder props a a
formBuilder_ f = formBuilder \props value ->
{ edit: f props value <<< (_ <<< const)
, validate: pure value
}
-- | Invalidate a form, keeping its user interface but discarding the result
-- | and possibly changing its type.
invalidate :: forall ui props unvalidated a b. FormBuilder' ui props unvalidated a -> FormBuilder' ui props unvalidated b
invalidate (FormBuilder f) = FormBuilder \props value ->
{ edit: (f props value).edit
, validate: Nothing
}
-- | Revalidate the form, in order to display error messages or create
-- | a validated result.
revalidate
:: forall ui props unvalidated result
. FormBuilder' ui props unvalidated result
-> props
-> unvalidated
-> Maybe result
revalidate editor props value = (un FormBuilder editor props value).validate
-- | Listens for changes in a form's value and allows for performing
-- | asynchronous effects and additional value changes.
listen
:: forall ui props unvalidated result
. (unvalidated -> Aff (unvalidated -> unvalidated))
-> FormBuilder' ui props unvalidated result
-> FormBuilder' ui props unvalidated result
listen cb (FormBuilder f) = FormBuilder \props unvalidated ->
let { edit, validate } = f props unvalidated
in { edit: \onChange ->
edit \update ->
runAff_ (either throwException onChange) (map (_ <<< update) (cb (update unvalidated)))
, validate
}