git.iko.soy/rowtype-yoga/ry-blocks
on main help sign in
Add UseTypingPlaceholders Hook
commitd01d028329f434cf903d713f9fa3f940114cfa64 authorMark Eibes <mark.eibes@gmail.com> dateSat 19 Mar 2022, 18:40 (5 years ago) parent943bc72
3 files changed+592−409
src/Yoga/Block/Atom/Input/Hook/UseTypingPlaceholders.purs+161 src/Yoga/Block/Atom/Input/Style.purs+1−1 src/Yoga/Block/Organism/Form.purs+430−408
src/Yoga/Block/Atom/Input/Hook/UseTypingPlaceholders.pursnew file+161
@@ -0,0 +1,161 @@
1+module Yoga.Block.Atom.Input.Hook.UseTypingPlaceholders where
2+
3+import Yoga.Prelude.View hiding (focus)
4+
5+import Data.Array.NonEmpty ((!!))
6+import Data.Array.NonEmpty as NEA
7+import Data.Newtype (class Newtype)
8+import Data.String as String
9+import Data.Traversable (for)
10+import Effect.Aff (Fiber, Milliseconds(..), delay, killFiber, launchAff, launchAff_)
11+import Effect.Aff as Aff
12+import Effect.Random (randomRange)
13+import Partial.Unsafe (unsafeCrashWith)
14+import React.Basic.Hooks as React
15+import Web.DOM.Node as Node
16+import Web.Event.Event (EventType(..))
17+import Web.Event.EventTarget (addEventListener, eventListener, removeEventListener)
18+import Web.HTML.HTMLInputElement as HTMLInputElement
19+import Yoga.Prelude.View (null) as Nullable
20+
21+newtype UseTypingPlaceholders hooks = UseTypingPlaceholders
22+ ( UseEffect Unit
23+ ( UseRef (Maybe (Fiber Unit))
24+ (UseRef Boolean (UseRef Int (UseRef (Nullable Node) hooks)))
25+ )
26+ )
27+
28+derive instance Newtype (UseTypingPlaceholders hooks) _
29+
30+useTypingPlaceholders
31+ ∷ String → Array String → Hook UseTypingPlaceholders NodeRef
32+useTypingPlaceholders defaultPlaceholder otherPlaceholders = coerceHook React.do
33+ let placeholders = NEA.cons' defaultPlaceholder otherPlaceholders
34+ inputRef ← React.useRef Nullable.null
35+ placeholderIndexRef ← React.useRef 0
36+ isDeletingRef ← React.useRef false
37+ fiberRef ← React.useRef Nothing
38+ let
39+ getInputValue ∷ Effect (Maybe String)
40+ getInputValue = runMaybeT do
41+ node ← readRefMaybe inputRef # MaybeT
42+ inputElement ← HTMLInputElement.fromNode node # pure # MaybeT
43+ HTMLInputElement.value inputElement <#> pure # MaybeT
44+
45+ useEffectOnce do
46+ let
47+ start = do
48+ fiber ← launchAff go
49+ writeRef fiberRef $ Just fiber
50+
51+ cancel why = do
52+ fiberʔ ← readRef fiberRef
53+ launchAff_ $ for_ fiberʔ \fib → do
54+ killFiber (Aff.error why) fib
55+ writeRef fiberRef Nothing
56+
57+ getPlaceholder = do
58+ inputElementʔ ← readRefMaybe inputRef # liftEffect <#>
59+ (_ >>= HTMLInputElement.fromNode)
60+ placeholder ← for inputElementʔ \inputElement → do
61+ HTMLInputElement.placeholder inputElement # liftEffect
62+ pure (placeholder # fromMaybe "")
63+
64+ setPlaceholder s = do
65+ inputElementʔ ← readRefMaybe inputRef # liftEffect <#>
66+ (_ >>= HTMLInputElement.fromNode)
67+ for_ inputElementʔ \inputElement → do
68+ HTMLInputElement.setPlaceholder s inputElement # liftEffect
69+
70+ mkOnFocusListener =
71+ eventListener \_ → do
72+ setPlaceholder defaultPlaceholder
73+ writeRef placeholderIndexRef 0
74+ writeRef isDeletingRef false
75+ maybeInputValue ← getInputValue
76+ when (maybeInputValue == Just "") start
77+
78+ mkOnBlurListener =
79+ eventListener \_ → do
80+ setPlaceholder ""
81+ cancel "blur"
82+
83+ mkOnInputListener =
84+ eventListener \_ → do
85+ inputValueʔ ← getInputValue
86+ if inputValueʔ /= Just "" && inputValueʔ /= Nothing then do
87+ cancel "on change non-empty"
88+ else do
89+ setPlaceholder ""
90+ writeRef placeholderIndexRef 0
91+ writeRef isDeletingRef false
92+ start
93+
94+ register et listener = do
95+ maybeInputNode ← readRefMaybe inputRef
96+ for_ maybeInputNode \ie →
97+ addEventListener et listener false (Node.toEventTarget ie)
98+
99+ unregister et listener = do
100+ maybeInputNode ← readRefMaybe inputRef
101+ for_ maybeInputNode \ie →
102+ removeEventListener et listener false (Node.toEventTarget ie)
103+
104+ go = do
105+ placeholderIndex ← readRef placeholderIndexRef # liftEffect
106+ isDeleting ← readRef isDeletingRef # liftEffect
107+ for_ (placeholders !! placeholderIndex) \toWrite → do
108+ placeholder ← getPlaceholder
109+ if not isDeleting && placeholder == toWrite then do
110+ writeRef isDeletingRef true # liftEffect
111+ delay (1200.0 # Milliseconds)
112+ setPlaceholder
113+ (String.take (String.length toWrite - 1) placeholder) #
114+ liftEffect
115+ go
116+ else if isDeleting && placeholder == "" then do
117+ writeRef isDeletingRef false # liftEffect
118+ let
119+ newPlaceholderIndex =
120+ ( (placeholderIndex + 1) `mod` (NEA.length placeholders)
121+ )
122+ writeRef placeholderIndexRef newPlaceholderIndex # liftEffect
123+ let
124+ newToWrite = placeholders !! newPlaceholderIndex # fromMaybe'
125+ \_ → unsafeCrashWith "Nope"
126+ delay (60.0 # Milliseconds)
127+ setPlaceholder (String.take 1 newToWrite) # liftEffect
128+ go
129+ else if not isDeleting then do -- We're still writing
130+ let charactersWritten = String.length placeholder
131+ delayBy1 ← randomRange 40.0 100.0 # liftEffect
132+ delayBy2 ← randomRange 40.0 100.0 # liftEffect
133+ delay (min delayBy1 delayBy2 # Milliseconds)
134+ setPlaceholder
135+ (String.take (charactersWritten + 1) toWrite) # liftEffect
136+ go
137+ else do -- We're still deleting
138+ let charactersWritten = String.length placeholder
139+ let charactersDeleted = String.length toWrite - charactersWritten
140+ case charactersDeleted of
141+ 1 → delay (100.0 # Milliseconds)
142+ 2 → delay (100.0 # Milliseconds)
143+ 3 → delay (100.0 # Milliseconds)
144+ c | c < 5 → delay (16.0 # Milliseconds)
145+ _ → delay (8.0 # Milliseconds)
146+ setPlaceholder (String.take (charactersWritten - 1) toWrite) #
147+ liftEffect
148+ go
149+ onFocusListener ← mkOnFocusListener
150+ onBlurListener ← mkOnBlurListener
151+ onInputListener ← mkOnInputListener
152+ register (EventType "focus") onFocusListener
153+ register (EventType "blur") onBlurListener
154+ register (EventType "input") onInputListener
155+ setPlaceholder defaultPlaceholder
156+ pure do
157+ cancel "Killed fiber because component was unmounted"
158+ unregister (EventType "focus") onFocusListener
159+ unregister (EventType "blur") onBlurListener
160+ unregister (EventType "input") onInputListener
161+ pure $ inputRef
src/Yoga/Block/Atom/Input/Style.purs+1−1
@@ -115,7 +115,7 @@ labelLarge { left, width } =
115115 , height: str "var(--s0)"
116116 , maxWidth: str $ i "calc(" width "px - 2ch)"
117117 , textOverflow: str "ellipsis"
118− , marginTop: str "calc(var(--s0) * 0.5)"
118+ , marginTop: str "calc(var(--s0) * 0.5 - var(--s-4))"
119119 , marginLeft: str $ i left "px"
120120 , marginRight: var "--input-side-padding"
121121 , color: str colour.placeholderText
src/Yoga/Block/Organism/Form.purs+430−408
@@ -67,14 +67,14 @@ import Yoga.Block.Organism.Form.Validation (ModifyValidated(..), Validated(..),
6767-- |
6868-- | _Note_: this function should be fully applied, to avoid remounting
6969-- | the component on each render.
70−build ∷
71− ∀ props unvalidated result.
72− FormBuilder { readOnly ∷ Boolean | props } unvalidated result ->
73− ReactComponent
74− { value ∷ unvalidated
75− , onChange ∷ (unvalidated -> unvalidated) -> Effect Unit
76− , formProps ∷ { readOnly ∷ Boolean | props }
77− }
70+build
71+ ∷ ∀ props unvalidated result
72+ . FormBuilder { readOnly ∷ Boolean | props } unvalidated result
73+ -> ReactComponent
74+ { value ∷ unvalidated
75+ , onChange ∷ (unvalidated -> unvalidated) -> Effect Unit
76+ , formProps ∷ { readOnly ∷ Boolean | props }
77+ }
7878build = build' defaultRenderForm
7979
8080-- | Create a React component for a form from a `FormBuilder'` and a custom
@@ -82,54 +82,56 @@ build = build' defaultRenderForm
8282-- |
8383-- | _Note_: this function should be fully applied, to avoid remounting
8484-- | the component on each render.
85−build' ∷
86− ∀ ui renderProps formProps unvalidated result.
87− Lacks "children" renderProps =>
88− Lacks "key" renderProps =>
89− Lacks "ref" renderProps =>
90− ({ | renderProps } -> formProps -> ui -> JSX) ->
91− FormBuilder' ui formProps unvalidated result ->
92− ReactComponent
93− { value ∷ unvalidated
94− , onChange ∷ (unvalidated -> unvalidated) -> Effect Unit
95− , formProps ∷ formProps
96− | renderProps
97− }
85+build'
86+ ∷ ∀ ui renderProps formProps unvalidated result
87+ . Lacks "children" renderProps
88+ => Lacks "key" renderProps
89+ => Lacks "ref" renderProps
90+ => ({ | renderProps } -> formProps -> ui -> JSX)
91+ -> FormBuilder' ui formProps unvalidated result
92+ -> ReactComponent
93+ { value ∷ unvalidated
94+ , onChange ∷ (unvalidated -> unvalidated) -> Effect Unit
95+ , formProps ∷ formProps
96+ | renderProps
97+ }
9898build' render editor =
9999 unsafePerformEffect
100100 $ reactComponent "Form" \props@{ value, onChange, formProps } -> React.do
101101 let { edit } = un FormBuilder editor formProps value
102102 pure $ render (contractRenderProps props) formProps (edit onChange)
103103 where
104− contractRenderProps ∷
105− { value ∷ unvalidated
106− , onChange ∷ (unvalidated -> unvalidated) -> Effect Unit
107− , formProps ∷ formProps
108− | renderProps
109− } ->
110− { | renderProps }
104+ contractRenderProps
105+ ∷ { value ∷ unvalidated
106+ , onChange ∷ (unvalidated -> unvalidated) -> Effect Unit
107+ , formProps ∷ formProps
108+ | renderProps
109+ }
110+ -> { | renderProps }
111111 contractRenderProps = unsafeCoerce
112112
113113-- | The default Lumi implementation for rendering a forest of JSX
114114-- | form fields.
115−defaultRenderForm ∷
116− ∀ props.
117− {} ->
118− { readOnly ∷ Boolean
119− | props
120− } ->
121− Forest ->
122− JSX
115+defaultRenderForm
116+ ∷ ∀ props
117+ . {}
118+ -> { readOnly ∷ Boolean
119+ | props
120+ }
121+ -> Forest
122+ -> JSX
123123defaultRenderForm _ { readOnly } forest =
124124 R.div'
125− </ { className:
126− String.joinWith " "
127− $ fold
128− [ [ "ry-form" ]
129− , guard readOnly [ "readOnly" ]
130− ]
125+ </
126+ { className:
127+ String.joinWith " "
128+ $ fold
129+ [ [ "ry-form" ]
130+ , guard readOnly [ "readOnly" ]
131+ ]
131132 }
132− /> [ surround fieldDivider
133+ />
134+ [ surround fieldDivider
133135 $ defaultRenderForest
134136 $ Array.mapMaybe pruneTree
135137 $ forest
@@ -137,17 +139,18 @@ defaultRenderForm _ { readOnly } forest =
137139 where
138140 fieldDivider =
139141 R.div'
140− </*> { className: "ry field-divider"
142+ </*>
143+ { className: "ry field-divider"
141144 , css:
142− E.css
143− { height: E.str $ "var(--s-2)"
144− , width: E.str "100%"
145− }
145+ E.css
146+ { height: E.str $ "var(--s-2)"
147+ , width: E.str "100%"
148+ }
146149 }
147150
148−defaultRenderForest ∷
149− Forest ->
150− Array JSX
151+defaultRenderForest
152+ ∷ Forest
153+ -> Array JSX
151154defaultRenderForest =
152155 map case _ of
153156 Child { key, child } -> maybe identity keyed key $ child
@@ -162,55 +165,59 @@ defaultRenderForest =
162165 maybe identity keyed key
163166 $ Block.box
164167 { css:
165− E.css
166− { border: E.str $ "1px solid " <> colour.inputBorder
167− , background: E.str colour.backgroundLayer1
168− , borderRadius: E.var "--s-1"
169− , marginTop: E.str "var(--s0)"
170− , "--label-bg": E.str colour.background
171− , "--label-fg": E.str colour.text
172− , "&:focus-within":
173− nest
174− { "--label-bg": labelSmallFocusBackground
175− , "--label-fg": E.str colour.highlightText
176− }
177− }
168+ E.css
169+ { border: E.str $ "1px solid " <> colour.inputBorder
170+ , background: E.str colour.backgroundLayer1
171+ , borderRadius: E.var "--s-1"
172+ , marginTop: E.str "var(--s0)"
173+ , "--label-bg": E.str colour.background
174+ , "--label-fg": E.str colour.text
175+ , "&:focus-within":
176+ nest
177+ { "--label-bg": labelSmallFocusBackground
178+ , "--label-fg": E.str colour.highlightText
179+ }
180+ }
178181 , padding: E.str "0"
179182 } --space: E.var "--s-2", css: E.css { marginTop: E.var "--s-1" } }
180183 ( [ R.div'
181− </* { className: "ry-form-label"
184+ </*
185+ { className: "ry-form-label"
182186 , css:
183− labelSmall colour.background colour.text
184− <> E.css
187+ labelSmall colour.background colour.text
188+ <> E.css
185189 { position: E.absolute
186190 , display: E.inlineBlock
187191 , "& > span":
188− nest
189− { background: E.var "--label-bg"
190− , color: E.var "--label-fg"
191− }
192+ nest
193+ { background: E.var "--label-bg"
194+ , color: E.var "--label-fg"
195+ }
192196 }
193197 }
194198 /> [ R.span_ [ label ] ]
195199 ]
196− <> [ Block.box
200+ <>
201+ [ Block.box
197202 { padding: E.var "--s-2"
198203 , css: E.css { marginTop: E.var "--s0" }
199204 }
200205 [ intercalate fieldDivider (defaultRenderForest children) ]
201206 ]
202− <> [ foldMap R.text validationError
207+ <>
208+ [ foldMap R.text validationError
203209 ]
204210 )
205211 where
206212 fieldDivider =
207213 R.div'
208− </*> { className: "ry field-divider"
214+ </*>
215+ { className: "ry field-divider"
209216 , css:
210− E.css
211− { height: E.str $ "var(--s-2)"
212− , width: E.str "100%"
213− }
217+ E.css
218+ { height: E.str $ "var(--s-2)"
219+ , width: E.str "100%"
220+ }
214221 }
215222
216223-- , layout: Motion.layout false
@@ -218,21 +225,21 @@ defaultRenderForest =
218225-- , animate: Motion.animate $ R.css { scale: 1 }
219226-- , exit: Motion.exit $ R.css { scale: 0 }
220227-- | Render a form with state managed automatically.
221−useForm ∷
222− ∀ props unvalidated result.
223− Mapping Validation.ModifyValidated unvalidated unvalidated =>
224− FormBuilder { readOnly ∷ Boolean | props } unvalidated result ->
225− { initialState ∷ unvalidated
226− , formProps ∷ { readOnly ∷ Boolean | props }
227− } ->
228− Hooks.Hook (Hooks.UseState unvalidated)
229− { formData ∷ unvalidated
230− , setFormData ∷ (unvalidated -> unvalidated) -> Effect Unit
231− , setModified ∷ Effect Unit
232− , reset ∷ Effect Unit
233− , validated ∷ Maybe result
234− , form ∷ JSX
235− }
228+useForm
229+ ∷ ∀ props unvalidated result
230+ . Mapping Validation.ModifyValidated unvalidated unvalidated
231+ => FormBuilder { readOnly ∷ Boolean | props } unvalidated result
232+ -> { initialState ∷ unvalidated
233+ , formProps ∷ { readOnly ∷ Boolean | props }
234+ }
235+ -> Hooks.Hook (Hooks.UseState unvalidated)
236+ { formData ∷ unvalidated
237+ , setFormData ∷ (unvalidated -> unvalidated) -> Effect Unit
238+ , setModified ∷ Effect Unit
239+ , reset ∷ Effect Unit
240+ , validated ∷ Maybe result
241+ , form ∷ JSX
242+ }
236243useForm editor props = Hooks.do
237244 let renderer = defaultRenderForm {} props.formProps
238245 f <- useForm' editor props.initialState props.formProps
@@ -240,20 +247,20 @@ useForm editor props = Hooks.do
240247
241248-- | Like `useForm`, but allows an alternative render implementation
242249-- | to be provided as an additional argument.
243−useForm' ∷
244− ∀ ui props unvalidated result.
245− Mapping Validation.ModifyValidated unvalidated unvalidated =>
246− FormBuilder' ui props unvalidated result ->
247− unvalidated ->
248− props ->
249− Hooks.Hook (Hooks.UseState unvalidated)
250− { formData ∷ unvalidated
251− , setFormData ∷ (unvalidated -> unvalidated) -> Effect Unit
252− , setModified ∷ Effect Unit
253− , reset ∷ Effect Unit
254− , validated ∷ Maybe result
255− , form ∷ ui
256− }
250+useForm'
251+ ∷ ∀ ui props unvalidated result
252+ . Mapping Validation.ModifyValidated unvalidated unvalidated
253+ => FormBuilder' ui props unvalidated result
254+ -> unvalidated
255+ -> props
256+ -> Hooks.Hook (Hooks.UseState unvalidated)
257+ { formData ∷ unvalidated
258+ , setFormData ∷ (unvalidated -> unvalidated) -> Effect Unit
259+ , setModified ∷ Effect Unit
260+ , reset ∷ Effect Unit
261+ , validated ∷ Maybe result
262+ , form ∷ ui
263+ }
257264useForm' editor initialState props = Hooks.do
258265 formData /\ setFormData <- Hooks.useState initialState
259266 let
@@ -273,11 +280,11 @@ static ∷ ∀ props value. JSX -> FormBuilder props value Unit
273280static edit = formBuilder \_ _ -> { edit: const edit, validate: pure unit }
274281
275282-- | Focus a `FormBuilder` on a smaller piece of state, using a `Lens`.
276−focus ∷
277− ∀ ui props s a result.
278− Lens' s a ->
279− FormBuilder' ui props a result ->
280− FormBuilder' ui props s result
283+focus
284+ ∷ ∀ ui props s a result
285+ . Lens' s a
286+ -> FormBuilder' ui props a result
287+ -> FormBuilder' ui props s result
281288focus l e =
282289 FormBuilder \props s ->
283290 let
@@ -289,25 +296,25 @@ focus l e =
289296
290297-- | Focus a `FormBuilder` on a possible type of state, using a `Prism`,
291298-- | ignoring validation.
292−match_ ∷
293− ∀ ui props s a.
294− Monoid ui =>
295− Prism' s a ->
296− FormBuilder' ui props a a ->
297− FormBuilder' ui props s s
299+match_
300+ ∷ ∀ ui props s a
301+ . Monoid ui
302+ => Prism' s a
303+ -> FormBuilder' ui props a a
304+ -> FormBuilder' ui props s s
298305match_ p = match p p
299306
300307-- | Focus a `FormBuilder` on a possible type of state, using a `Prism`.
301308-- |
302309-- | We need two `Prism`s in order to change the result type for
303310-- | validation purposes.
304−match ∷
305− ∀ ui props result s t a.
306− Monoid ui =>
307− Prism s s a a ->
308− Prism s t a result ->
309− FormBuilder' ui props a result ->
310− FormBuilder' ui props s t
311+match
312+ ∷ ∀ ui props result s t a
313+ . Monoid ui
314+ => Prism s s a a
315+ -> Prism s t a result
316+ -> FormBuilder' ui props a result
317+ -> FormBuilder' ui props s t
311318match p1 p2 e =
312319 FormBuilder \props s -> case matching p2 s of
313320 Left t -> { edit: mempty, validate: pure t }
@@ -320,28 +327,28 @@ match p1 p2 e =
320327 }
321328
322329-- | Change the props type.
323−mapProps ∷
324− ∀ ui p q u a.
325− (q -> p) ->
326− FormBuilder' ui p u a ->
327− FormBuilder' ui q u a
330+mapProps
331+ ∷ ∀ ui p q u a
332+ . (q -> p)
333+ -> FormBuilder' ui p u a
334+ -> FormBuilder' ui q u a
328335mapProps f form = FormBuilder (un FormBuilder form <<< f)
329336
330337-- | Change the UI type of a form.
331−mapUI_ ∷
332− ∀ ui ui' props value result.
333− (ui -> ui') ->
334− FormBuilder' ui props value result ->
335− FormBuilder' ui' props value result
338+mapUI_
339+ ∷ ∀ ui ui' props value result
340+ . (ui -> ui')
341+ -> FormBuilder' ui props value result
342+ -> FormBuilder' ui' props value result
336343mapUI_ f = mapUI \_ _ _ -> f
337344
338345-- | Change the UI type of a form based on the props, the current value and the
339346-- | validated result.
340−mapUI ∷
341− ∀ ui ui' props value result.
342− (props -> value -> Maybe result -> ui -> ui') ->
343− FormBuilder' ui props value result ->
344− FormBuilder' ui' props value result
347+mapUI
348+ ∷ ∀ ui ui' props value result
349+ . (props -> value -> Maybe result -> ui -> ui')
350+ -> FormBuilder' ui props value result
351+ -> FormBuilder' ui' props value result
345352mapUI f form =
346353 FormBuilder \props value ->
347354 let
@@ -353,105 +360,105 @@ mapUI f form =
353360
354361-- | Make the props available. This allows for changing the structure of a form
355362-- | builder based on the current props.
356−withProps ∷
357− ∀ ui props unvalidated result.
358− (props -> FormBuilder' ui props unvalidated result) ->
359− FormBuilder' ui props unvalidated result
363+withProps
364+ ∷ ∀ ui props unvalidated result
365+ . (props -> FormBuilder' ui props unvalidated result)
366+ -> FormBuilder' ui props unvalidated result
360367withProps f = FormBuilder \props value -> un FormBuilder (f props) props value
361368
362369-- | Make the value available. This allows for changing the structure of a form
363370-- | builder based on the current value.
364−withValue ∷
365− ∀ ui props unvalidated result.
366− (unvalidated -> FormBuilder' ui props unvalidated result) ->
367− FormBuilder' ui props unvalidated result
371+withValue
372+ ∷ ∀ ui props unvalidated result
373+ . (unvalidated -> FormBuilder' ui props unvalidated result)
374+ -> FormBuilder' ui props unvalidated result
368375withValue f = FormBuilder \props value -> un FormBuilder (f value) props value
369376
370377-- | Indent a `Forest` of editors by one level, providing a label.
371−indent ∷
372− ∀ props u a.
373− String ->
374− RequiredField ->
375− FormBuilder props u a ->
376− FormBuilder props u a
378+indent
379+ ∷ ∀ props u a
380+ . String
381+ -> RequiredField
382+ -> FormBuilder props u a
383+ -> FormBuilder props u a
377384indent label required editor =
378385 FormBuilder \props val ->
379386 let
380387 { edit, validate } = un FormBuilder editor props val
381388 in
382389 { edit:
383− \k ->
384− pure
385− $ Node
386− { label: R.text label
387− , key: Nothing
388− , required: required
389− , validationError: Nothing
390− , children: edit k
391− }
390+ \k ->
391+ pure
392+ $ Node
393+ { label: R.text label
394+ , key: Nothing
395+ , required: required
396+ , validationError: Nothing
397+ , children: edit k
398+ }
392399 , validate
393400 }
394401
395−wrap ∷
396− ∀ props u a.
397− (Array JSX -> JSX) ->
398− FormBuilder props u a ->
399− FormBuilder props u a
402+wrap
403+ ∷ ∀ props u a
404+ . (Array JSX -> JSX)
405+ -> FormBuilder props u a
406+ -> FormBuilder props u a
400407wrap f form =
401408 FormBuilder \props value ->
402409 let
403410 { edit, validate } = un FormBuilder form props value
404411 in
405412 { edit:
406− \k ->
407− pure
408− $ Wrapper
409− { key: Nothing
410− , wrap: f
411− , children: edit k
412− }
413+ \k ->
414+ pure
415+ $ Wrapper
416+ { key: Nothing
417+ , wrap: f
418+ , children: edit k
419+ }
413420 , validate
414421 }
415422
416423-- | Filter parts of the form based on the current value (and the props).
417−filterWithProps ∷
418− ∀ ui props u a.
419− Monoid ui =>
420− (props -> u -> Boolean) ->
421− FormBuilder' ui props u a ->
422− FormBuilder' ui props u a
424+filterWithProps
425+ ∷ ∀ ui props u a
426+ . Monoid ui
427+ => (props -> u -> Boolean)
428+ -> FormBuilder' ui props u a
429+ -> FormBuilder' ui props u a
423430filterWithProps p editor =
424431 FormBuilder \props value ->
425432 let
426433 { edit, validate } = un FormBuilder editor props value
427434 in
428435 { edit:
429− \onChange ->
430− if p props value then
431− edit onChange
432− else
433− mempty
436+ \onChange ->
437+ if p props value then
438+ edit onChange
439+ else
440+ mempty
434441 , validate
435442 }
436443
437444-- | TODO: document
438−withKey ∷
439− ∀ props u a.
440− String ->
441− FormBuilder props u a ->
442− FormBuilder props u a
445+withKey
446+ ∷ ∀ props u a
447+ . String
448+ -> FormBuilder props u a
449+ -> FormBuilder props u a
443450withKey key editor =
444451 FormBuilder \props value ->
445452 let
446453 { edit, validate } = un FormBuilder editor props value
447454 in
448455 { edit:
449− \onChange ->
450− edit onChange
451− # Array.mapWithIndex case _, _ of
452− i, Child a -> Child a { key = Just (key <> "--" <> show i) }
453− i, Wrapper a -> Wrapper a { key = Just (key <> "--" <> show i) }
454− i, Node n -> Node n { key = Just (key <> "--" <> show i) }
456+ \onChange ->
457+ edit onChange
458+ # Array.mapWithIndex case _, _ of
459+ i, Child a -> Child a { key = Just (key <> "--" <> show i) }
460+ i, Wrapper a -> Wrapper a { key = Just (key <> "--" <> show i) }
461+ i, Node n -> Node n { key = Just (key <> "--" <> show i) }
455462 , validate
456463 }
457464
@@ -465,57 +472,61 @@ type ValidatedInputFixedProps =
465472 , trailing ∷ JSX
466473 )
467474
468−inputBox ∷
469− ∀ p q r more.
470− Union p ValidatedInputFixedProps q =>
471− Union q r Input.Props =>
472− Nub q q =>
473− NonEmptyString -> RequiredField -> Record p -> FormBuilder { readOnly ∷ Boolean, validationError ∷ Maybe (Maybe String) | more } String String
475+inputBox
476+ ∷ ∀ p q r more
477+ . Union p ValidatedInputFixedProps q
478+ => Union q r Input.Props
479+ => Nub q q
480+ => NonEmptyString
481+ -> RequiredField
482+ -> Record p
483+ -> FormBuilder { readOnly ∷ Boolean, validationError ∷ Maybe (Maybe String) | more } String String
474484inputBox label requiredField inputProps =
475485 FormBuilder \props value ->
476486 let
477487 { edit, validate } = f props value
478488 in
479489 { edit:
480− \onChange ->
481− [ Child
482− { key: Nothing
483− , child: edit onChange
484− }
485− ]
490+ \onChange ->
491+ [ Child
492+ { key: Nothing
493+ , child: edit onChange
494+ }
495+ ]
486496 , validate
487497 }
488498 where
489499 f { readOnly, validationError } s =
490500 { edit:
491− \onChange ->
492− R.div' </* { className: "ry-form-input-box", css: E.css { width: E.percent 100.0 } }
493− /> [ element Input.component
494− ( inputProps
495− `disjointUnion`
496− { value: s
497− , onChange: handler targetValue (traverse_ (onChange <<< const))
498− , readOnly: readOnly
499− , label
500− , trailing:
501− case validationError of
502− Nothing -> mempty
503− Just (Just _) -> Block.icon </> { icon: Icons.warn, stroke: E.str colour.invalid }
504− Just Nothing -> Block.icon </> { icon: Icons.checkmark, stroke: E.str colour.success }
505− , _aria:
506− ( case validationError of
507− Nothing {- not validated yet -} -> mempty
508− Just Nothing {- validated and fine -} -> mempty --Object.singleton "invalid" "false"
509− Just (Just _) {- validated with an error -} -> Object.singleton "invalid" "true"
510− )
511− <> case requiredField of
512− Required -> Object.singleton "required" "true"
513− Optional -> mempty
514− Neither -> mempty
515− , css: E.css { width: E.percent 100.0 }
516− }
517− )
518− ]
501+ \onChange ->
502+ R.div' </* { className: "ry-form-input-box", css: E.css { width: E.percent 100.0 } }
503+ />
504+ [ element Input.component
505+ ( inputProps
506+ `disjointUnion`
507+ { value: s
508+ , onChange: handler targetValue (traverse_ (onChange <<< const))
509+ , readOnly: readOnly
510+ , label
511+ , trailing:
512+ case validationError of
513+ Nothing -> mempty
514+ Just (Just _) -> Block.icon </> { icon: Icons.warn, stroke: E.str colour.invalid }
515+ Just Nothing -> Block.icon </> { icon: Icons.checkmark, stroke: E.str colour.success }
516+ , _aria:
517+ ( case validationError of
518+ Nothing {- not validated yet -} -> mempty
519+ Just Nothing {- validated and fine -} -> mempty --Object.singleton "invalid" "false"
520+ Just (Just _) {- validated with an error -} -> Object.singleton "invalid" "true"
521+ )
522+ <> case requiredField of
523+ Required -> Object.singleton "required" "true"
524+ Optional -> mempty
525+ Neither -> mempty
526+ , css: E.css { width: E.percent 100.0 }
527+ }
528+ )
529+ ]
519530 , validate: pure s
520531 }
521532
@@ -526,25 +537,26 @@ type ToggleFixedProps =
526537 )
527538
528539-- | A toggle for Boolean values
529−toggle ∷
530− ∀ p q r more.
531− Union p ToggleFixedProps q =>
532− Union q r Toggle.Props =>
533− Nub q q =>
534− (Record p) -> FormBuilder { readOnly ∷ Boolean | more } Boolean Boolean
540+toggle
541+ ∷ ∀ p q r more
542+ . Union p ToggleFixedProps q
543+ => Union q r Toggle.Props
544+ => Nub q q
545+ => (Record p)
546+ -> FormBuilder { readOnly ∷ Boolean | more } Boolean Boolean
535547toggle toggleProps =
536548 formBuilder_ \{ readOnly } value onChange ->
537549 element Toggle.component
538550 ( toggleProps
539551 `disjointUnion`
540552 { value:
541− case value of
542− false -> ToggleIsLeft
543− true -> ToggleIsRight
553+ case value of
554+ false -> ToggleIsLeft
555+ true -> ToggleIsRight
544556 , onChange:
545− case _ of
546− ToggleIsLeft -> onChange false
547− ToggleIsRight -> onChange true
557+ case _ of
558+ ToggleIsLeft -> onChange false
559+ ToggleIsRight -> onChange true
548560 , disabled: readOnly
549561 }
550562 )
@@ -553,14 +565,14 @@ toggle toggleProps =
553565-- |
554566-- | This `FormBuilder` displays a removable section for each array element,
555567-- | along with an "Add..." button in the final row.
556−array ∷
557− ∀ props u a.
558− { label ∷ String
559− , addLabel ∷ String
560− , defaultValue ∷ u
561− , editor ∷ FormBuilder { readOnly ∷ Boolean | props } u a
562− } ->
563− FormBuilder { readOnly ∷ Boolean | props } (Array u) (Array a)
568+array
569+ ∷ ∀ props u a
570+ . { label ∷ String
571+ , addLabel ∷ String
572+ , defaultValue ∷ u
573+ , editor ∷ FormBuilder { readOnly ∷ Boolean | props } u a
574+ }
575+ -> FormBuilder { readOnly ∷ Boolean | props } (Array u) (Array a)
564576array { label, addLabel, defaultValue, editor } =
565577 FormBuilder \props@{ readOnly } xs ->
566578 let
@@ -569,52 +581,54 @@ array { label, addLabel, defaultValue, editor } =
569581 [ Wrapper
570582 { key: Nothing
571583 , wrap:
572− Block.box { style: R.css { paddingTop: 0 } }
584+ Block.box { style: R.css { paddingTop: 0 } }
573585 , children
574586 }
575587 ]
576588 in
577589 { edit:
578− \onChange -> do
579− let
580− deleteButton i =
581− R.a'
582− </ { onClick:
583− handler preventDefault
584− $ const
585− $ onChange (\xs' -> fromMaybe xs' (Array.deleteAt i xs'))
586− }
587− /> [ R.text "×" ]
588− wrapper $ xs
589− # Array.mapWithIndex
590− ( \i x ->
591− Node
592− { label:
593− fragment
594− [ if readOnly then empty else deleteButton i
595− , R.text $ " " <> label <> " #" <> show (i + 1)
596− ]
597− , key: Nothing
598− , required: Neither
599− , validationError: Nothing
600− , children: (un FormBuilder editor props x).edit (onChange <<< editAt i)
601− }
602− )
603− # if readOnly then
604− identity
605− else
606− flip Array.snoc
607− ( Child
608− { key: Nothing
609− , child:
610− Block.cluster { justify: "flex-end" }
611− /> [ Block.button
612− { onClick: handler preventDefault (const (onChange $ flip append [ defaultValue ]))
613− }
614− [ R.text $ "+ " <> addLabel ]
615− ]
616− }
590+ \onChange -> do
591+ let
592+ deleteButton i =
593+ R.a'
594+ </
595+ { onClick:
596+ handler preventDefault
597+ $ const
598+ $ onChange (\xs' -> fromMaybe xs' (Array.deleteAt i xs'))
599+ }
600+ /> [ R.text "×" ]
601+ wrapper $ xs
602+ # Array.mapWithIndex
603+ ( \i x ->
604+ Node
605+ { label:
606+ fragment
607+ [ if readOnly then empty else deleteButton i
608+ , R.text $ " " <> label <> " #" <> show (i + 1)
609+ ]
610+ , key: Nothing
611+ , required: Neither
612+ , validationError: Nothing
613+ , children: (un FormBuilder editor props x).edit (onChange <<< editAt i)
614+ }
617615 )
616+ #
617+ if readOnly then identity
618+ else
619+ flip Array.snoc
620+ ( Child
621+ { key: Nothing
622+ , child:
623+ Block.cluster { justify: "flex-end" }
624+ />
625+ [ Block.button
626+ { onClick: handler preventDefault (const (onChange $ flip append [ defaultValue ]))
627+ }
628+ [ R.text $ "+ " <> addLabel ]
629+ ]
630+ }
631+ )
618632 , validate: traverse (un FormBuilder editor props >>> _.validate) xs
619633 }
620634
@@ -622,43 +636,43 @@ array { label, addLabel, defaultValue, editor } =
622636-- |
623637-- | This `FormBuilder` displays a removable section for each array element,
624638-- | along with an "Add..." button in the final row.
625−sortableArray ∷
626− ∀ props u a.
627− { label ∷ String
628− , addLabel ∷ String
629− , defaultValue ∷ u
630− , editor ∷ FormBuilder { readOnly ∷ Boolean | props } u a
631− } ->
632− FormBuilder { readOnly ∷ Boolean | props } (Array u) (Array a)
639+sortableArray
640+ ∷ ∀ props u a
641+ . { label ∷ String
642+ , addLabel ∷ String
643+ , defaultValue ∷ u
644+ , editor ∷ FormBuilder { readOnly ∷ Boolean | props } u a
645+ }
646+ -> FormBuilder { readOnly ∷ Boolean | props } (Array u) (Array a)
633647sortableArray { label, addLabel, defaultValue, editor } =
634648 FormBuilder \props@{ readOnly } xs -> do
635649 { edit:
636− \(onChange ∷ (Array u -> Array u) -> Effect Unit) -> do
637− let
638− addButton =
639− Block.cluster { justify: "flex-end" }
640− [ Block.button
641− { onClick: handler preventDefault (const (onChange $ flip append [ defaultValue ]))
642− , disabled: readOnly
643− }
644− [ R.text $ "+ " <> addLabel ]
645− ]
646− appendAddButton items =
647− if readOnly then
648− items
649− else
650− Array.snoc items $ Child { key: Nothing, child: addButton }
651− mkNode i x =
652− Node
653− { label: R.text $ " " <> label <> " #" <> show (i + 1)
654− , key: Nothing
655− , required: Neither
656− , validationError: Nothing
657− , children: (un FormBuilder editor props x).edit (onChange <<< editAt i)
658− }
659− wrapper readOnly onChange $ xs
660− # Array.mapWithIndex mkNode
661− # appendAddButton
650+ \(onChange ∷ (Array u -> Array u) -> Effect Unit) -> do
651+ let
652+ addButton =
653+ Block.cluster { justify: "flex-end" }
654+ [ Block.button
655+ { onClick: handler preventDefault (const (onChange $ flip append [ defaultValue ]))
656+ , disabled: readOnly
657+ }
658+ [ R.text $ "+ " <> addLabel ]
659+ ]
660+ appendAddButton items =
661+ if readOnly then
662+ items
663+ else
664+ Array.snoc items $ Child { key: Nothing, child: addButton }
665+ mkNode i x =
666+ Node
667+ { label: R.text $ " " <> label <> " #" <> show (i + 1)
668+ , key: Nothing
669+ , required: Neither
670+ , validationError: Nothing
671+ , children: (un FormBuilder editor props x).edit (onChange <<< editAt i)
672+ }
673+ wrapper readOnly onChange $ xs
674+ # Array.mapWithIndex mkNode
675+ # appendAddButton
662676 , validate: traverse (un FormBuilder editor props >>> _.validate) xs
663677 }
664678 where
@@ -668,69 +682,74 @@ sortableArray { label, addLabel, defaultValue, editor } =
668682 [ Wrapper
669683 { key: Nothing
670684 , wrap:
671− \kids ->
672− Block.box { style: R.css { paddingTop: 0 } }
673− [ formArray </> { kids, onChange, readOnly } ]
685+ \kids ->
686+ Block.box { style: R.css { paddingTop: 0 } }
687+ [ formArray </> { kids, onChange, readOnly } ]
674688 , children
675689 }
676690 ]
677691
678692 formArray =
679693 unsafePerformEffect
680− $ reactComponent "Form Array" \( props ∷
681− { kids ∷ Array JSX
682− , onChange ∷ (Array u -> Array u) -> Effect Unit
683− , readOnly ∷ Boolean
684− }
685− ) -> Hooks.do
686− let children = if props.readOnly then props.kids else Array.dropEnd 1 props.kids
687− let addButton = guard (not props.readOnly) (Array.last props.kids # Array.fromFoldable)
688− items /\ setItems <- Hooks.useState' []
689− currentKeyRef <- Hooks.useRef 0
690− let numberOfChildren = Array.length children
691− let numberOfItems = Array.length items
692− useEffect numberOfChildren do
693− when (numberOfChildren > numberOfItems) do
694− currentKey <- Hooks.readRef currentKeyRef
695− let newKey = currentKey + 1
696− Hooks.writeRef currentKeyRef newKey
697− setItems (Array.snoc items (show newKey))
698− mempty
699− let
700− onDragEnd =
701− handler (merge { active: Dnd.active, over: Dnd.over }) case _ of
702− { active: Just active, over: Just over } ->
703− when (active.id /= over.id) do
704− case Array.findIndex (_ == active.id) items, Array.findIndex (_ == over.id) items of
705− Just oldIndex, Just newIndex -> do
706− setItems $ Dnd.arrayMove oldIndex newIndex items
707− props.onChange (\xs' -> Dnd.arrayMove oldIndex newIndex xs')
708− _, _ -> mempty
709− _ -> mempty
710− pure $ Dnd.dndContext
711− </ { collisionDetection: Dnd.closestCenter
712− , onDragEnd
713− }
714− /> [ Dnd.sortableContext
715− </ { items
716− , strategy: Dnd.verticalListSortingStrategy
717− }
718− /> ( Array.zip children items
719− # Array.mapWithIndex case _, _ of
720− i, kid /\ id -> do
721− Hooks.elementKeyed itemComponent
722− { id
723− , kid
724− , key: id
725− , readOnly: props.readOnly
726− , delete:
727− do
728− props.onChange \xs' -> fromMaybe xs' (Array.deleteAt i xs')
729− setItems $ fromMaybe items (Array.deleteAt i items)
730− }
731− )
732− ]
733− <> addButton
694+ $ reactComponent "Form Array"
695+ \( props
696+ ∷ { kids ∷ Array JSX
697+ , onChange ∷ (Array u -> Array u) -> Effect Unit
698+ , readOnly ∷ Boolean
699+ }
700+ ) -> Hooks.do
701+ let children = if props.readOnly then props.kids else Array.dropEnd 1 props.kids
702+ let addButton = guard (not props.readOnly) (Array.last props.kids # Array.fromFoldable)
703+ items /\ setItems <- Hooks.useState' []
704+ currentKeyRef <- Hooks.useRef 0
705+ let numberOfChildren = Array.length children
706+ let numberOfItems = Array.length items
707+ useEffect numberOfChildren do
708+ when (numberOfChildren > numberOfItems) do
709+ currentKey <- Hooks.readRef currentKeyRef
710+ let newKey = currentKey + 1
711+ Hooks.writeRef currentKeyRef newKey
712+ setItems (Array.snoc items (show newKey))
713+ mempty
714+ let
715+ onDragEnd =
716+ handler (merge { active: Dnd.active, over: Dnd.over }) case _ of
717+ { active: Just active, over: Just over } ->
718+ when (active.id /= over.id) do
719+ case Array.findIndex (_ == active.id) items, Array.findIndex (_ == over.id) items of
720+ Just oldIndex, Just newIndex -> do
721+ setItems $ Dnd.arrayMove oldIndex newIndex items
722+ props.onChange (\xs' -> Dnd.arrayMove oldIndex newIndex xs')
723+ _, _ -> mempty
724+ _ -> mempty
725+ pure $ Dnd.dndContext
726+ </
727+ { collisionDetection: Dnd.closestCenter
728+ , onDragEnd
729+ }
730+ />
731+ [ Dnd.sortableContext
732+ </
733+ { items
734+ , strategy: Dnd.verticalListSortingStrategy
735+ }
736+ />
737+ ( Array.zip children items
738+ # Array.mapWithIndex case _, _ of
739+ i, kid /\ id -> do
740+ Hooks.elementKeyed itemComponent
741+ { id
742+ , kid
743+ , key: id
744+ , readOnly: props.readOnly
745+ , delete:
746+ do
747+ props.onChange \xs' -> fromMaybe xs' (Array.deleteAt i xs')
748+ setItems $ fromMaybe items (Array.deleteAt i items)
749+ }
750+ )
751+ ]
752+ <> addButton
734753
735754 itemComponent =
736755 unsafePerformEffect
@@ -760,17 +779,17 @@ sortableArray { label, addLabel, defaultValue, editor } =
760779 { ref: setNodeRef
761780 , style
762781 , css:
763− E.css
764− { "&:focus":
765− E.nested
766− $ E.css
767− { outlineColor: E.str colour.highlight
768− }
769− , transition: E.str "box-shadow 0.8s ease"
770− , position: E.relative
771− , boxSizing: E.contentBox
772− , overflow: E.visible
773− }
782+ E.css
783+ { "&:focus":
784+ E.nested
785+ $ E.css
786+ { outlineColor: E.str colour.highlight
787+ }
788+ , transition: E.str "box-shadow 0.8s ease"
789+ , position: E.relative
790+ , boxSizing: E.contentBox
791+ , overflow: E.visible
792+ }
774793 , className: "ry-draggable-array-element"
775794 }
776795 circleStyle =
@@ -796,8 +815,8 @@ sortableArray { label, addLabel, defaultValue, editor } =
796815 )
797816 { className: "ry-draggable-array-drag-handle"
798817 , css:
799− circleStyle
800− <> E.css
818+ circleStyle
819+ <> E.css
801820 { right: E.str "var(--s-1)"
802821 , cursor: E.str "grab"
803822 }
@@ -808,8 +827,8 @@ sortableArray { label, addLabel, defaultValue, editor } =
808827 deleteButtonAttrs =
809828 { className: "ry-draggable-array-delete-button"
810829 , css:
811− circleStyle
812− <> E.css
830+ circleStyle
831+ <> E.css
813832 { right: E.str "calc(var(--s-1) + var(--s-1) + var(--s2) + var(--s-3))"
814833 }
815834 , onClick: handler preventDefault (const props.delete)
@@ -820,8 +839,8 @@ sortableArray { label, addLabel, defaultValue, editor } =
820839 menuButtonAttrs =
821840 { className: "ry-draggable-array-delete-button"
822841 , css:
823− circleStyle
824− <> E.css
842+ circleStyle
843+ <> E.css
825844 { right: E.str "calc(var(--s-1) + var(--s-1) + var(--s2) + var(--s-3))"
826845 }
827846 , onClick: handler_ (setShowMenu (not showMenu))
@@ -832,11 +851,13 @@ sortableArray { label, addLabel, defaultValue, editor } =
832851 menuPopover =
833852 if showMenu then
834853 Block.popover
835− </ { referenceElement
854+ </
855+ { referenceElement
836856 -- , placement: Placement.Placement Placement.Bottom (Just Placement.End)
837857 , renderArrow: true
838858 }
839− /> [ Block.box {}
859+ />
860+ [ Block.box {}
840861 [ R.text "Sure?"
841862 , deleteButton
842863 ]
@@ -844,7 +865,8 @@ sortableArray { label, addLabel, defaultValue, editor } =
844865 else
845866 mempty
846867 pure $ R.li' </* attrs
847− /> [ dragHandle
868+ />
869+ [ dragHandle
848870 , menuButton
849871 , menuPopover
850872 , props.kid