wip

Author: functora

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

@@ -145,7 +145,8 @@ newSt = do
       }
 
 data Asset f = Asset
-  { assetFieldPairs :: [FieldPair DynamicField f],
+  { assetUid :: Uid,
+    assetFieldPairs :: [FieldPair DynamicField f],
     assetModalState :: OpenedOrClosed,
     assetMustVerify :: Bool
   }
@@ -167,6 +168,7 @@ deriving via GenericType (Asset Identity) instance Binary (Asset Identity)
 
 newAsset :: (MonadIO m, MonadThrow m) => m (Asset Unique)
 newAsset = do
+  uid <- newUid
   link <-
     newFieldPair "Link"
       $ DynamicFieldText mempty
@@ -204,7 +206,8 @@ newAsset = do
     newFieldPair "Comment" $ DynamicFieldText mempty
   pure
     Asset
-      { assetFieldPairs =
+      { assetUid = uid,
+        assetFieldPairs =
           [ required link,
             required photo,
             required qty,

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

@@ -19,58 +19,70 @@ assetsViewer st = do
 
 assetViewer :: Model -> Int -> [View Action]
 assetViewer st idx =
-  [ fieldset_ mempty
-      $ ( legend_
-            mempty
-            [ text title,
-              text " ",
-              button_
-                [ onClick
-                    . PushUpdate
-                    . PureUpdate
-                    $ cloneTraversal modalOptic
-                    .~ Opened
-                ]
-                [ icon Icon.IconEdit,
-                  text " Edit"
-                ]
-            ]
+  [ keyed uid
+      . fieldset_ mempty
+      $ ( ( legend_
+              mempty
+              [ text title,
+                text " ",
+                button_
+                  [ onClick
+                      . PushUpdate
+                      . PureUpdate
+                      $ cloneTraversal modalOptic
+                      .~ Opened
+                  ]
+                  [ icon Icon.IconEdit,
+                    text " Edit"
+                  ]
+              ]
+          )
+            : FieldPairs.fieldPairsViewer fieldPairsOpts args
         )
-      : FieldPairs.fieldPairsViewer fieldPairsOpts args
+      <> ( Dialog.dialog
+            Dialog.defOpts
+              { Dialog.optsTitle = Just title,
+                Dialog.optsExtraOnClose = saveUpdate,
+                Dialog.optsHeaderRight =
+                  const
+                    [ button_
+                        [type_ "reset", onClick removeAction]
+                        [icon Icon.IconDelete],
+                      button_
+                        [type_ "submit", onClick saveAction]
+                        [icon Icon.IconSave]
+                    ],
+                Dialog.optsFooterRight =
+                  const
+                    [ button_
+                        [type_ "reset", onClick removeAction]
+                        [icon Icon.IconDelete, text " Remove"],
+                      button_
+                        [type_ "submit", onClick saveAction]
+                        [icon Icon.IconSave, text " Save"]
+                    ]
+              }
+            Dialog.Args
+              { Dialog.argsModel = st,
+                Dialog.argsOptic = modalOptic,
+                Dialog.argsAction = PushUpdate,
+                Dialog.argsContent =
+                  failures False
+                    <> FieldPairs.fieldPairsEditor args fieldPairsOpts
+              }
+         )
   ]
-    <> ( Dialog.dialog
-          Dialog.defOpts
-            { Dialog.optsTitle = Just title,
-              Dialog.optsExtraOnClose = saveUpdate,
-              Dialog.optsHeaderRight =
-                const
-                  [ button_
-                      [type_ "reset", onClick removeAction]
-                      [icon Icon.IconDelete],
-                    button_
-                      [type_ "submit", onClick saveAction]
-                      [icon Icon.IconSave]
-                  ],
-              Dialog.optsFooterRight =
-                const
-                  [ button_
-                      [type_ "reset", onClick removeAction]
-                      [icon Icon.IconDelete, text " Remove"],
-                    button_
-                      [type_ "submit", onClick saveAction]
-                      [icon Icon.IconSave, text " Save"]
-                  ]
-            }
-          Dialog.Args
-            { Dialog.argsModel = st,
-              Dialog.argsOptic = modalOptic,
-              Dialog.argsAction = PushUpdate,
-              Dialog.argsContent =
-                failures False
-                  <> FieldPairs.fieldPairsEditor args fieldPairsOpts
-            }
-       )
   where
+    uid =
+      decodeUtf8
+        . unTagged
+        . htmlUid
+        . fromMaybe nilUid
+        $ st
+        ^? #modelState
+        . #stAssets
+        . ix idx
+        . #assetUid
     args =
       FieldPairs.Args
         { FieldPairs.argsModel = st,

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

@@ -164,7 +164,8 @@ totalViewer st =
     then mempty
     else
       singleton
-        $ fieldset_ mempty
+        . keyed "total"
+        . fieldset_ mempty
         $ (legend_ mempty [text "Total"])
         : FieldPairs.fieldPairsViewer
           FieldPairs.defOpts

ghcjs/delivery-calculator/src/Main.hs

@@ -204,14 +204,13 @@ updateModel (EvalUpdate f) st = do
           $ #modelUriViewer
           %~ mergeFieldPairs
             [ uriViewer
-                & #fieldPairValue
-                . #fieldOpts
-                . #fieldOptsQrState
-                .~ Just Opened
                 & #fieldPairValue
                 . #fieldOpts
                 . #fieldOptsAllowCopy
                 .~ True
+                & #fieldPairValue
+                . #fieldType
+                .~ FieldTypeQrCode
             ],
       do
         --

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

@@ -810,7 +810,7 @@ genericFieldViewer opts0 args widget =
               . _Just
               %~ nextEnum
       )
-        <> ( if isNothing $ opts ^. #fieldOptsQrState
+        <> ( if typ == FieldTypeQrCode || isNothing (opts ^. #fieldOptsQrState)
               then mempty
               else
                 pure