Skip to content

Commit 65614bb

Browse files
functorafunctora
committed
wip
1 parent 89320d6 commit 65614bb

File tree

4 files changed

+81
-72
lines changed

4 files changed

+81
-72
lines changed

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

Lines changed: 12 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -208,6 +208,10 @@ newFieldPair key val = do
208208
. #fieldOpts
209209
. #fieldOptsQrState
210210
.~ Nothing
211+
& #fieldPairValue
212+
. #fieldOpts
213+
. #fieldOptsAllowCopy
214+
.~ False
211215

212216
newFieldPairId ::
213217
Unicode ->
@@ -219,6 +223,10 @@ newFieldPairId key val = do
219223
. #fieldOpts
220224
. #fieldOptsQrState
221225
.~ Nothing
226+
& #fieldPairValue
227+
. #fieldOpts
228+
. #fieldOptsAllowCopy
229+
.~ False
222230

223231
newTotal :: St Unique -> [FieldPair DynamicField Identity]
224232
newTotal st =
@@ -238,7 +246,10 @@ newTotal st =
238246
$ uniqueToIdentity fee
239247
& #fieldOpts
240248
. #fieldOptsQrState
241-
.~ Nothing,
249+
.~ Nothing
250+
& #fieldOpts
251+
. #fieldOptsAllowCopy
252+
.~ False,
242253
newFieldPairId ("Total " <> quoteCur)
243254
. DynamicFieldText
244255
. inspectRatioDef

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

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -131,7 +131,7 @@ screenWidget st@Model {modelState = St {stScreen = Main}} =
131131
pure
132132
$ #modelState
133133
. #stAssets
134-
%~ flip snoc asset
134+
%~ (asset :)
135135
]
136136
[ icon Icon.IconAdd,
137137
text " Add item"

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

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -287,7 +287,7 @@ htmlFieldType = \case
287287
FieldTypeQrCode -> "text"
288288
FieldTypeHtml -> "text"
289289
FieldTypePassword -> "password"
290-
FieldTypeImage -> "image"
290+
FieldTypeImage -> "text"
291291

292292
userFieldType :: FieldType -> Unicode
293293
userFieldType = \case

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

Lines changed: 67 additions & 69 deletions
Original file line numberDiff line numberDiff line change
@@ -152,84 +152,82 @@ field full@Full {fullArgs = args, fullParser = parser, fullViewer = viewer} opts
152152
. (br_ mempty :)
153153
)
154154
(optsLabel opts)
155-
( ( if typ == FieldTypeImage
156-
then do
157-
src <-
158-
maybeToList
159-
$ st
160-
^? cloneTraversal optic
161-
. #fieldInput
162-
. #uniqueValue
163-
if null src
155+
( [ input_
156+
$ ( catMaybes
157+
[ Just . type_ $ htmlFieldType typ,
158+
fmap required_
159+
$ st
160+
^? cloneTraversal optic
161+
. #fieldRequired,
162+
fmap
163+
(textProp "defaultValue")
164+
( st
165+
^? cloneTraversal
166+
optic
167+
. #fieldInput
168+
. #uniqueValue
169+
),
170+
Just
171+
$ onInput onInputAction,
172+
Just
173+
. disabled_
174+
$ opts
175+
^. #optsDisabled,
176+
fmap placeholder_
177+
$ if null placeholder
178+
then optsLabel opts
179+
else Just placeholder,
180+
Just
181+
. id_
182+
. either impureThrow id
183+
. decodeUtf8Strict
184+
. unTagged
185+
$ htmlUid uid,
186+
Just
187+
. onKeyDown
188+
$ action
189+
. optsOnKeyDownAction opts uid,
190+
Just
191+
$ onBlur onBlurAction
192+
]
193+
)
194+
<> ( opts ^. #optsExtraAttributes
195+
)
196+
]
197+
<> ( if typ /= FieldTypeImage
164198
then mempty
165-
else
199+
else do
200+
src <-
201+
maybeToList
202+
$ st
203+
^? cloneTraversal optic
204+
. #fieldInput
205+
. #uniqueValue
166206
[ input_
167207
$ catMaybes
168208
[ Just $ type_ "file",
169209
Just $ accept_ "image/*",
170210
Just $ onInput onInputFileAction,
171211
Just
172212
. id_
173-
. either impureThrow id
213+
. either impureThrow ("file-" <>)
174214
. decodeUtf8Strict
175215
. unTagged
176-
$ htmlUid uid,
177-
fmap required_
178-
$ st
179-
^? cloneTraversal optic
180-
. #fieldRequired
181-
],
182-
img_
183-
( loading_ "lazy"
184-
: src_ src
185-
: optsExtraAttributes opts
186-
),
187-
br_ mempty
188-
]
189-
else
190-
singleton
191-
. input_
192-
$ ( catMaybes
193-
[ Just . type_ $ htmlFieldType typ,
194-
fmap required_
195-
$ st
196-
^? cloneTraversal optic
197-
. #fieldRequired,
198-
fmap
199-
(textProp "defaultValue")
200-
( st
201-
^? cloneTraversal
202-
optic
203-
. #fieldInput
204-
. #uniqueValue
205-
),
206-
Just
207-
$ onInput onInputAction,
208-
Just
209-
. disabled_
210-
$ opts
211-
^. #optsDisabled,
212-
fmap placeholder_
213-
$ if null placeholder
214-
then optsLabel opts
215-
else Just placeholder,
216-
Just
217-
. id_
218-
. either impureThrow id
219-
. decodeUtf8Strict
220-
. unTagged
221-
$ htmlUid uid,
222-
Just
223-
. onKeyDown
224-
$ action
225-
. optsOnKeyDownAction opts uid,
226-
Just
227-
$ onBlur onBlurAction
228-
]
229-
)
230-
<> ( opts ^. #optsExtraAttributes
231-
)
232-
)
216+
$ htmlUid uid
217+
]
218+
]
219+
<> ( if null src
220+
then mempty
221+
else
222+
[ img_
223+
( loading_ "lazy"
224+
: src_ src
225+
: optsExtraAttributes opts
226+
),
227+
br_ mempty
228+
]
229+
)
230+
)
233231
--
234232
-- TODO : with new semantic layout separate leading/trailing
235233
-- widgets do not make a lot of sense, should be a single option
@@ -310,7 +308,7 @@ field full@Full {fullArgs = args, fullParser = parser, fullViewer = viewer} opts
310308
const . fromMaybe action (optsOnInputAction opts) . ImpureUpdate $ do
311309
el <-
312310
getElementById
313-
. either impureThrow id
311+
. either impureThrow ("file-" <>)
314312
. decodeUtf8Strict
315313
. unTagged
316314
$ htmlUid uid

0 commit comments

Comments
 (0)