OPFS wip

Author: functora

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

@@ -13,11 +13,12 @@ import qualified Functora.Miso.Widgets.Icon as Icon
 
 assetsViewer :: Model -> [View Action]
 assetsViewer st = do
-  idx <- fmap fst . zip [0 ..] $ st ^. #modelState . #stAssets
-  assetViewer st idx
+  let assets = st ^. #modelState . #stAssets
+  idx <- fmap fst $ zip [0 ..] assets
+  assetViewer st idx $ "asset-" <> inspect (length assets - idx - 1)
 
-assetViewer :: Model -> Int -> [View Action]
-assetViewer st idx =
+assetViewer :: Model -> Int -> Unicode -> [View Action]
+assetViewer st idx opfsPrefix =
   [ fieldset_ mempty
       $ ( legend_
             mempty
@@ -36,7 +37,7 @@ assetViewer st idx =
                 ]
             ]
         )
-      : FieldPairs.fieldPairsViewer fieldPairsOpts args
+      : FieldPairs.fieldPairsViewer (fieldPairsOpts opfsPrefix) args
   ]
     <> ( Dialog.dialog
           Dialog.defOpts
@@ -69,7 +70,7 @@ assetViewer st idx =
                 failures False
                   <> FieldPairs.fieldPairsEditor
                     args
-                    fieldPairsOpts
+                    (fieldPairsOpts opfsPrefix)
                       { FieldPairs.optsAdvanced = False
                       }
             }
@@ -124,13 +125,18 @@ assetViewer st idx =
         . #stAssets
         . ix idx
 
-fieldPairsOpts :: FieldPairs.Opts model action
-fieldPairsOpts =
+fieldPairsOpts :: Unicode -> FieldPairs.Opts model action
+fieldPairsOpts opfsPrefix =
   FieldPairs.defOpts
     { FieldPairs.optsField =
         Field.defOpts
           { Field.optsExtraAttributesImage =
               [ style_ [("max-height", "10vh")]
               ]
-          }
+          },
+      FieldPairs.optsOpfsName =
+        Just
+          $ (opfsPrefix <>)
+          . ("-field-" <>)
+          . inspect
     }

ghcjs/miso-functora/js/main.js

@@ -42,12 +42,12 @@ export async function compressImage(quality, prevImage) {
   return nextImage;
 }
 
-export async function selectClipboard() {
+export async function selectClipboard(opfsName = null) {
   const { value } = await Clipboard.read();
-  return await selectDataUrl(value);
+  return await selectDataUrl(value, opfsName);
 }
 
-export async function selectFile(file) {
+export async function selectFile(file, opfsName = null) {
   const value = await new Promise((resolve, reject) => {
     var fr = new FileReader();
     fr.onload = () => {
@@ -56,22 +56,39 @@ export async function selectFile(file) {
     fr.onerror = reject;
     fr.readAsDataURL(file);
   });
-  return await selectDataUrl(value);
+  return await selectDataUrl(value, opfsName);
 }
 
-export async function selectDataUrl(value) {
+export async function selectDataUrl(value, opfsName = null) {
   try {
     const { buffer: u8a, typeFull: mime } = dataUriToBuffer(value);
     let blob = new Blob([u8a], { type: mime });
     if (mime.startsWith("image")) {
       blob = await compressImage(1, blob);
     }
+    if (opfsName) {
+      await opfsWrite(value, opfsName);
+    }
     return URL.createObjectURL(blob);
   } catch (e) {
     return value;
   }
 }
 
+export async function opfsWrite(value, opfsName) {
+  try {
+    const root = await navigator.storage.getDirectory();
+    const handle = await root.getFileHandle(opfsName, { create: true });
+    const stream = await handle.createWritable();
+    await stream.write(value);
+    await stream.close();
+    console.log("OPFS success", opfsName, handle);
+  } catch (e) {
+    console.log("OPFS failure", opfsName, e);
+  }
+  return null;
+}
+
 export async function openBrowserPage(url) {
   try {
     return await Browser.open({ url: url, windowName: "_blank" });

ghcjs/miso-functora/js/main.min.js

@@ -150,15 +150,17 @@ selectBarcode after =
     $ after
     . fmap strip
 
-selectClipboard :: (Maybe Unicode -> JSM ()) -> JSM ()
-selectClipboard after =
-  genericPromise @[Unicode] @Unicode "selectClipboard" mempty
+selectClipboard :: Maybe Unicode -> (Maybe Unicode -> JSM ()) -> JSM ()
+selectClipboard opfsName after = do
+  jopfsName <- JS.toJSVal opfsName
+  genericPromise @[JS.JSVal] @Unicode "selectClipboard" [jopfsName]
     $ after
     . fmap strip
 
-selectFile :: JS.JSVal -> (Maybe Unicode -> JSM ()) -> JSM ()
-selectFile file after =
-  genericPromise @[JS.JSVal] @Unicode "selectFile" [file]
+selectFile :: Maybe Unicode -> JS.JSVal -> (Maybe Unicode -> JSM ()) -> JSM ()
+selectFile opfsName file after = do
+  jopfsName <- JS.toJSVal opfsName
+  genericPromise @[JS.JSVal] @Unicode "selectFile" [file, jopfsName]
     $ after
     . fmap strip
 

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

@@ -46,10 +46,14 @@ data Full model action t f = Full
 data Opts model action = Opts
   { optsIcon :: Icon.Icon -> View action,
     optsLabel :: Maybe Unicode,
+    optsOpfsName :: Maybe Unicode,
     optsDisabled :: Bool,
     optsFullWidth :: Bool,
     optsPlaceholder :: Unicode,
     optsOnInputAction :: Maybe (Update model -> action),
+    --
+    -- TODO : optsTrailingWidgets :: [Unicode -> FocusedOrBlurred -> OptsWidget]
+    --
     optsLeadingWidget :: Maybe (OptsWidgetPair model action),
     optsTrailingWidget :: Maybe (OptsWidgetPair model action),
     optsOnKeyDownAction :: Unicode -> KeyCode -> Update model,
@@ -70,6 +74,7 @@ defOpts =
   Opts
     { optsIcon = Icon.icon @Icon.Fa,
       optsLabel = Nothing,
+      optsOpfsName = Nothing,
       optsDisabled = False,
       optsFullWidth = False,
       optsPlaceholder = mempty,
@@ -350,7 +355,7 @@ field full@Full {fullArgs = args, fullParser = parser, fullViewer = viewer} opts
           then Jsm.popupText @Unicode "File does not exist!"
           else do
             file <- el JS.! ("files" :: Unicode) JS.!! 0
-            Jsm.selectFile file $ \case
+            Jsm.selectFile (optsOpfsName opts) file $ \case
               Nothing -> Jsm.popupText @Unicode "File is not selected!"
               Just url -> argsEmitter args . PureUpdate $ do
                 let next =
@@ -456,7 +461,9 @@ fieldIcon full opts = \case
         )
   PasteWidget ->
     fieldIconSimple opts Icon.IconPaste mempty
-      $ insertAction full Jsm.selectClipboard
+      . insertAction full
+      . Jsm.selectClipboard
+      $ optsOpfsName opts
   ScanQrWidget ->
     fieldIconSimple opts Icon.IconQrCode mempty
       $ insertAction full Jsm.selectBarcode

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

@@ -24,6 +24,7 @@ data Args model action f = Args
 data Opts model action = Opts
   { optsIcon :: Icon.Icon -> View action,
     optsField :: Field.Opts model action,
+    optsOpfsName :: Maybe (Int -> Unicode),
     optsAdvanced :: Bool
   }
   deriving stock (Generic)
@@ -33,6 +34,7 @@ defOpts =
   Opts
     { optsIcon = Icon.icon @Icon.Fa,
       optsField = Field.defOpts,
+      optsOpfsName = Nothing,
       optsAdvanced = True
     }
 
@@ -79,6 +81,8 @@ fieldPairViewer opts args@Args {argsOptic = optic} idx pair =
           else
             Field.fieldViewer
               ( optsField opts
+                  & #optsOpfsName
+                  .~ fmap ($ idx) (optsOpfsName opts)
                   & #optsIcon
                   .~ optsIcon opts
                   & #optsLeftRightViewer
@@ -132,6 +136,8 @@ fieldPairEditor
           Field.argsEmitter = emitter
         }
       ( optsField opts
+          & #optsOpfsName
+          .~ fmap ($ idx) (optsOpfsName opts)
           & #optsLabel
           .~ Just
             ( fromMaybe ("#" <> inspect (idx + 1))
@@ -161,6 +167,8 @@ fieldPairEditor
           Field.argsEmitter = emitter
         }
       ( optsField opts
+          & #optsOpfsName
+          .~ fmap ($ idx) (optsOpfsName opts)
           & #optsPlaceholder
           .~ ("Label " <> idxTxt)
           & ( #optsLeadingWidget ::
@@ -186,6 +194,8 @@ fieldPairEditor
             Field.argsEmitter = emitter
           }
         ( optsField opts
+            & #optsOpfsName
+            .~ fmap ($ idx) (optsOpfsName opts)
             & #optsPlaceholder
             .~ ( "Value "
                   <> idxTxt