image file input wip

Author: functora

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

@@ -177,11 +177,22 @@ newAsset = do
     newFieldPair "Price" $ DynamicFieldNumber 10
   qty <-
     newFieldPair "Quantity" $ DynamicFieldNumber 1
+  comment <-
+    newFieldPair "Comment" $ DynamicFieldText mempty
   pure
     Asset
-      { assetFieldPairs = [link, photo, price, qty],
+      { assetFieldPairs =
+          [ required link,
+            required photo,
+            required price,
+            required qty,
+            comment
+          ],
         assetModalState = Opened
       }
+  where
+    required :: FieldPair DynamicField Unique -> FieldPair DynamicField Unique
+    required = #fieldPairValue . #fieldRequired .~ True
 
 newFieldPair ::
   ( MonadIO m

ghcjs/delivery-calculator/src/App/Widgets/Menu.hs

@@ -67,6 +67,15 @@ menu st =
                     [Dialog.optsIcon Dialog.defOpts Icon.IconShare]
                 )
                   :
+              ),
+            Dialog.optsFooterRight =
+              ( ( button_
+                    [shareOnClick]
+                    [ Dialog.optsIcon Dialog.defOpts Icon.IconShare,
+                      text " Share"
+                    ]
+                )
+                  :
               )
           }
       )

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

@@ -122,6 +122,7 @@ data Field a f = Field
     fieldInput :: f Unicode,
     fieldOutput :: a,
     fieldModalState :: OpenedOrClosed,
+    fieldRequired :: Bool,
     fieldOpts :: FieldOpts
   }
   deriving stock (Generic)
@@ -175,6 +176,7 @@ newField typ output newInput = do
         fieldInput = input,
         fieldOutput = output,
         fieldModalState = Closed,
+        fieldRequired = False,
         fieldOpts = defFieldOpts
       }
 
@@ -185,6 +187,7 @@ newFieldId typ viewer output =
       fieldInput = Identity $ viewer output,
       fieldOutput = output,
       fieldModalState = Closed,
+      fieldRequired = False,
       fieldOpts = defFieldOpts
     }
 

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

@@ -162,7 +162,17 @@ field full@Full {fullArgs = args, fullParser = parser, fullViewer = viewer} opts
               if null src
                 then mempty
                 else
-                  [ img_
+                  [ input_
+                      $ catMaybes
+                        [ Just $ type_ "file",
+                          Just $ accept_ "image/*",
+                          Just $ onInput onInputAction,
+                          fmap required_
+                            $ st
+                            ^? cloneTraversal optic
+                            . #fieldRequired
+                        ],
+                    img_
                       ( loading_ "lazy"
                           : src_ src
                           : optsExtraAttributes opts
@@ -174,6 +184,10 @@ field full@Full {fullArgs = args, fullParser = parser, fullViewer = viewer} opts
                 . input_
                 $ ( catMaybes
                       [ Just . type_ $ htmlFieldType typ,
+                        fmap required_
+                          $ st
+                          ^? cloneTraversal optic
+                          . #fieldRequired,
                         fmap
                           (textProp "defaultValue")
                           ( st