Skip to content

Commit b569cf8

Browse files
functorafunctora
committed
configurable field onFocus
1 parent 12672c5 commit b569cf8

File tree

8 files changed

+67
-48
lines changed

8 files changed

+67
-48
lines changed

‎ghcjs/delivery-calculator/src/App/Types.hs‎

Lines changed: 12 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -196,19 +196,19 @@ newAsset = do
196196
)
197197
. newFieldPair "Photo"
198198
$ DynamicFieldText mempty
199-
price <-
200-
newFieldPair "Price" $ DynamicFieldNumber 0
201199
qty <-
202200
newFieldPair "Quantity" $ DynamicFieldNumber 1
201+
price <-
202+
newFieldPair "Price" $ DynamicFieldNumber 0
203203
comment <-
204204
newFieldPair "Comment" $ DynamicFieldText mempty
205205
pure
206206
Asset
207207
{ assetFieldPairs =
208208
[ required link,
209209
required photo,
210-
required price,
211210
required qty,
211+
price,
212212
comment
213213
],
214214
assetModalState = Opened,
@@ -221,18 +221,18 @@ newAsset = do
221221
verifyAsset :: Asset Unique -> [View Action]
222222
verifyAsset asset =
223223
case assetFieldPairs asset of
224-
(link : photo : price : qty : _)
224+
(link : photo : qty : price : _)
225225
| assetMustVerify asset -> do
226226
let failures =
227227
intersperse (text " ")
228228
$ verifyLink
229229
(link ^. #fieldPairValue . #fieldInput . #uniqueValue)
230230
<> verifyPhoto
231231
(photo ^. #fieldPairValue . #fieldInput . #uniqueValue)
232-
<> verifyPrice
233-
(price ^. #fieldPairValue . #fieldOutput)
234232
<> verifyQty
235233
(qty ^. #fieldPairValue . #fieldOutput)
234+
<> verifyPrice
235+
(price ^. #fieldPairValue . #fieldOutput)
236236
if null failures
237237
then mempty
238238
else [keyed "asset-failure" $ blockquote_ mempty failures]
@@ -258,16 +258,16 @@ verifyPhoto txt =
258258
where
259259
str = from @Unicode @String $ uriOnlyChars txt
260260

261-
verifyPrice :: DynamicField -> [View Action]
262-
verifyPrice = \case
263-
DynamicFieldNumber x | x > 0 -> mempty
264-
_ -> [text "Price must be a positive number!"]
265-
266261
verifyQty :: DynamicField -> [View Action]
267262
verifyQty = \case
268263
DynamicFieldNumber x | x > 0 -> mempty
269264
_ -> [text "Quantity must be a positive number!"]
270265

266+
verifyPrice :: DynamicField -> [View Action]
267+
verifyPrice = \case
268+
DynamicFieldNumber x | x >= 0 -> mempty
269+
_ -> [text "Price must be non-negative number!"]
270+
271271
uriOnlyChars :: Unicode -> Unicode
272272
uriOnlyChars =
273273
omap $ \x ->
@@ -323,7 +323,7 @@ newTotal st =
323323
newFieldPairId ("Exchange rate")
324324
. DynamicFieldText
325325
$ inspectExchangeRate st,
326-
FieldPair (newTextFieldId "Fee %")
326+
FieldPair (newDynamicFieldId $ DynamicFieldText "Fee %")
327327
$ uniqueToIdentity fee
328328
& #fieldOpts
329329
. #fieldOptsQrState

‎ghcjs/delivery-calculator/src/App/Widgets/Asset.hs‎

Lines changed: 10 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -119,7 +119,7 @@ assetViewer st idx =
119119
. #stAssets
120120
. ix idx
121121

122-
fieldPairsOpts :: FieldPairs.Opts Model Action
122+
fieldPairsOpts :: FieldPairs.Opts Model Action Unique
123123
fieldPairsOpts =
124124
FieldPairs.defOpts
125125
{ FieldPairs.optsField = \case
@@ -128,9 +128,17 @@ fieldPairsOpts =
128128
FieldPairs.optsAdvanced = False
129129
}
130130
where
131+
opts :: Field.Opts Model Action DynamicField Unique
131132
opts =
132133
Field.defOpts
133-
{ Field.optsExtraAttributesImage =
134+
{ Field.optsOnFocus = \field ->
135+
case fieldOutput field of
136+
DynamicFieldNumber 0 ->
137+
addEffect
138+
$ Jsm.setValue (field ^. #fieldInput . #uniqueUid) mempty
139+
_ ->
140+
id,
141+
Field.optsExtraAttributesImage =
134142
[ style_ [("max-height", "10vh")]
135143
]
136144
}

‎ghcjs/delivery-calculator/src/App/Widgets/Main.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -138,7 +138,7 @@ screenWidget st@Model {modelState = St {stScreen = Main}} =
138138
pure
139139
$ #modelState
140140
. #stAssets
141-
%~ (asset :)
141+
%~ (<> [asset])
142142
]
143143
[ icon Icon.IconAdd,
144144
text " Add item"

‎ghcjs/delivery-calculator/src/App/Xlsx.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -169,7 +169,7 @@ mapCol :: (Integral n) => n -> n
169169
mapCol = \case
170170
1 -> 2
171171
2 -> 3
172-
3 -> 6
173-
4 -> 5
172+
3 -> 5
173+
4 -> 6
174174
5 -> 10
175175
n -> n + 10

‎ghcjs/miso-functora/src/Functora/Miso/Jsm/Generic.hs‎

Lines changed: 12 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -20,6 +20,7 @@ module Functora.Miso.Jsm.Generic
2020
saveFileShare,
2121
saveFileThen,
2222
fetchUrlAsRfc2397,
23+
setValue,
2324
)
2425
where
2526

@@ -290,3 +291,14 @@ fetchUrlAsRfc2397 url after = do
290291
argv <- sequence [JS.toJSVal url]
291292
prom <- pkg ^. JS.jsf ("fetchUrlAsRfc2397" :: Unicode) (argv :: [JS.JSVal])
292293
void $ prom ^. JS.js2 @Unicode "then" success failure
294+
295+
setValue :: Uid -> Unicode -> JSM ()
296+
setValue uid value = do
297+
el <-
298+
getElementById
299+
. either impureThrow id
300+
. decodeUtf8Strict
301+
. unTagged
302+
$ htmlUid uid
303+
is <- ghcjsPure $ JS.isTruthy el
304+
when is $ el ^. JS.jss ("value" :: Unicode) value

‎ghcjs/miso-functora/src/Functora/Miso/Types.hs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -316,7 +316,7 @@ userFieldType = \case
316316
FieldTypeImage -> "Image"
317317

318318
data FieldPair a f = FieldPair
319-
{ fieldPairKey :: Field Unicode f,
319+
{ fieldPairKey :: Field a f,
320320
fieldPairValue :: Field a f
321321
}
322322
deriving stock (Generic)
@@ -342,13 +342,13 @@ newFieldPair ::
342342
(MonadIO m) => Unicode -> DynamicField -> m (FieldPair DynamicField Unique)
343343
newFieldPair key val =
344344
FieldPair
345-
<$> newTextField key
345+
<$> newDynamicField (DynamicFieldText key)
346346
<*> newDynamicField val
347347

348348
newFieldPairId :: Unicode -> DynamicField -> FieldPair DynamicField Identity
349349
newFieldPairId key val =
350350
FieldPair
351-
(newFieldId FieldTypeText id key)
351+
(newDynamicFieldId $ DynamicFieldText key)
352352
(newDynamicFieldId val)
353353

354354
mergeFieldPairs ::

‎ghcjs/miso-functora/src/Functora/Miso/Widgets/Field.hs‎

Lines changed: 16 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -44,9 +44,10 @@ data Full model action t f = Full
4444
}
4545
deriving stock (Generic)
4646

47-
data Opts model action = Opts
47+
data Opts model action t f = Opts
4848
{ optsIcon :: Icon.Icon -> View action,
4949
optsLabel :: Maybe Unicode,
50+
optsOnFocus :: Field t f -> Update model -> Update model,
5051
optsFullWidth :: Bool,
5152
optsPlaceholder :: Unicode,
5253
optsOnInputAction :: Maybe (Update model -> action),
@@ -63,11 +64,12 @@ data Opts model action = Opts
6364
}
6465
deriving stock (Generic)
6566

66-
defOpts :: Opts model action
67+
defOpts :: Opts model action t f
6768
defOpts =
6869
Opts
6970
{ optsIcon = Icon.icon @Icon.Fa,
7071
optsLabel = Nothing,
72+
optsOnFocus = const id,
7173
optsFullWidth = False,
7274
optsPlaceholder = mempty,
7375
optsOnInputAction = Nothing,
@@ -155,7 +157,7 @@ labeled label attrs =
155157

156158
field ::
157159
Full model action t Unique ->
158-
Opts model action ->
160+
Opts model action t Unique ->
159161
[View action]
160162
field full@Full {fullArgs = args, fullParser = parser, fullViewer = viewer} opts =
161163
( do
@@ -318,6 +320,8 @@ field full@Full {fullArgs = args, fullParser = parser, fullViewer = viewer} opts
318320
.~ Blurred
319321
onFocusAction =
320322
action
323+
. ( maybe id (optsOnFocus opts) $ st ^? cloneTraversal optic
324+
)
321325
. PureUpdate
322326
$ cloneTraversal optic
323327
. #fieldFocusState
@@ -370,7 +374,7 @@ field full@Full {fullArgs = args, fullParser = parser, fullViewer = viewer} opts
370374

371375
ratioField ::
372376
Args model action Rational Unique ->
373-
Opts model action ->
377+
Opts model action Rational Unique ->
374378
[View action]
375379
ratioField args =
376380
field
@@ -382,7 +386,7 @@ ratioField args =
382386

383387
textField ::
384388
Args model action Unicode Unique ->
385-
Opts model action ->
389+
Opts model action Unicode Unique ->
386390
[View action]
387391
textField args =
388392
field
@@ -394,7 +398,7 @@ textField args =
394398

395399
dynamicField ::
396400
Args model action DynamicField Unique ->
397-
Opts model action ->
401+
Opts model action DynamicField Unique ->
398402
[View action]
399403
dynamicField args =
400404
field
@@ -406,7 +410,7 @@ dynamicField args =
406410

407411
passwordField ::
408412
Args model action Unicode Unique ->
409-
Opts model action ->
413+
Opts model action Unicode Unique ->
410414
[View action]
411415
passwordField args opts =
412416
textField
@@ -423,7 +427,7 @@ passwordField args opts =
423427

424428
fieldIcon ::
425429
Full model action t Unique ->
426-
Opts model action ->
430+
Opts model action t Unique ->
427431
OptsWidget model action ->
428432
View action
429433
fieldIcon full opts = \case
@@ -532,7 +536,7 @@ fieldIcon full opts = \case
532536
. #uniqueUid
533537

534538
fieldIconSimple ::
535-
Opts model action ->
539+
Opts model action t f ->
536540
Icon.Icon ->
537541
[Attribute action] ->
538542
action ->
@@ -673,7 +677,7 @@ selectTypeWidget args@Args {argsAction = action} optic =
673677
fieldViewer ::
674678
( Foldable1 f
675679
) =>
676-
Opts model action ->
680+
Opts model action t f ->
677681
Args model action t f ->
678682
[View action]
679683
fieldViewer opts args =
@@ -729,7 +733,7 @@ header txt =
729733
genericFieldViewer ::
730734
( Foldable1 f
731735
) =>
732-
Opts model action ->
736+
Opts model action t f ->
733737
Args model action t f ->
734738
(Unicode -> View action) ->
735739
[View action]
@@ -828,7 +832,7 @@ genericFieldViewer opts0 args widget =
828832
]
829833
)
830834

831-
fieldViewerIcon :: Opts model action -> Icon.Icon -> action -> View action
835+
fieldViewerIcon :: Opts model action t f -> Icon.Icon -> action -> View action
832836
fieldViewerIcon opts icon action =
833837
button_
834838
[onClick action]

‎ghcjs/miso-functora/src/Functora/Miso/Widgets/FieldPairs.hs‎

Lines changed: 11 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -21,14 +21,14 @@ data Args model action f = Args
2121
}
2222
deriving stock (Generic)
2323

24-
data Opts model action = Opts
24+
data Opts model action f = Opts
2525
{ optsIcon :: Icon.Icon -> View action,
26-
optsField :: Int -> Field.Opts model action,
26+
optsField :: Int -> Field.Opts model action DynamicField f,
2727
optsAdvanced :: Bool
2828
}
2929
deriving stock (Generic)
3030

31-
defOpts :: Opts model action
31+
defOpts :: Opts model action f
3232
defOpts =
3333
Opts
3434
{ optsIcon = Icon.icon @Icon.Fa,
@@ -39,7 +39,7 @@ defOpts =
3939
fieldPairsViewer ::
4040
( Foldable1 f
4141
) =>
42-
Opts model action ->
42+
Opts model action f ->
4343
Args model action f ->
4444
[View action]
4545
fieldPairsViewer opts args@Args {argsOptic = optic} =
@@ -59,20 +59,15 @@ fieldPairViewer ::
5959
forall model action f.
6060
( Foldable1 f
6161
) =>
62-
Opts model action ->
62+
Opts model action f ->
6363
Args model action f ->
6464
Int ->
6565
FieldPair DynamicField f ->
6666
[View action]
6767
fieldPairViewer opts args@Args {argsOptic = optic} idx pair =
6868
( if k == mempty
6969
then mempty
70-
else
71-
[ dt_
72-
mempty
73-
[ text $ pair ^. #fieldPairKey . #fieldOutput
74-
]
75-
]
70+
else [dt_ mempty [text k]]
7671
)
7772
<> ( if v == mempty
7873
then mempty
@@ -96,12 +91,12 @@ fieldPairViewer opts args@Args {argsOptic = optic} idx pair =
9691
}
9792
)
9893
where
99-
k = pair ^. #fieldPairKey . #fieldOutput
94+
k = inspectDynamicField $ pair ^. #fieldPairKey . #fieldOutput
10095
v = inspectDynamicField $ pair ^. #fieldPairValue . #fieldOutput
10196

10297
fieldPairsEditor ::
10398
Args model action Unique ->
104-
Opts model action ->
99+
Opts model action Unique ->
105100
[View action]
106101
fieldPairsEditor args@Args {argsModel = st, argsOptic = optic} opts = do
107102
idx <- fst <$> zip [0 ..] (fromMaybe mempty $ st ^? cloneTraversal optic)
@@ -110,7 +105,7 @@ fieldPairsEditor args@Args {argsModel = st, argsOptic = optic} opts = do
110105
fieldPairEditor ::
111106
forall model action.
112107
Args model action Unique ->
113-
Opts model action ->
108+
Opts model action Unique ->
114109
Int ->
115110
[View action]
116111
fieldPairEditor
@@ -134,7 +129,7 @@ fieldPairEditor
134129
( optsField opts idx
135130
& #optsLabel
136131
.~ Just
137-
( fromMaybe ("#" <> inspect (idx + 1))
132+
( maybe ("#" <> inspect (idx + 1)) inspectDynamicField
138133
$ st
139134
^? cloneTraversal optic
140135
. ix idx
@@ -153,7 +148,7 @@ fieldPairEditor
153148
{ optsAdvanced = True
154149
}
155150
idx =
156-
Field.textField
151+
Field.dynamicField
157152
Field.Args
158153
{ Field.argsModel = st,
159154
Field.argsOptic = cloneTraversal optic . ix idx . #fieldPairKey,

0 commit comments

Comments
 (0)