OPFS wip

Author: functora

ghcjs/delivery-calculator/src/Main.hs

@@ -132,20 +132,22 @@ updateModel (InitUpdate ext) prevSt = do
                   modelConsumerQueue = cons
                 }
         if isJust ext
-          then
+          then do
             pushActionQueue
               nextSt
               . Instant
               . PureUpdate
               $ #modelLoading
               .~ False
+            opfsRead nextSt
           else Jsm.selectStorage ("current-" <> vsn) $ \case
-            Nothing ->
+            Nothing -> do
               pushActionQueue nextSt
                 . Instant
                 . PureUpdate
                 $ #modelLoading
                 .~ False
+              opfsRead nextSt
             Just uri -> do
               finSt <- newModel (nextSt ^. #modelWebOpts) (Just nextSt) uri
               pushActionQueue nextSt
@@ -156,6 +158,7 @@ updateModel (InitUpdate ext) prevSt = do
                       & #modelLoading
                       .~ False
                   )
+              opfsRead finSt
         pure
           $ ChanUpdate (const nextSt)
     ]
@@ -480,3 +483,43 @@ syncUri uri = do
             . URI.parseURI
             $ URI.renderStr nextUri
         )
+
+opfsRead :: Model -> JSM ()
+opfsRead st =
+  when (opfsMax >= 0)
+    . forM_ (zip [0 :: Int ..] $ zip (reverse [0 .. opfsMax]) assets)
+    . uncurry
+    $ \assetIdx (opfsIdx, asset) -> do
+      let fields = fmap (^. #fieldPairValue) $ asset ^. #assetFieldPairs
+      forM_ (zip [0 :: Int ..] fields) . uncurry $ \fieldIdx field -> do
+        let optic =
+              #modelState
+                . #stAssets
+                . ix assetIdx
+                . #assetFieldPairs
+                . ix fieldIdx
+                . #fieldPairValue
+        when (field ^. #fieldType == FieldTypeImage)
+          . Jsm.opfsRead
+            ( "asset-"
+                <> inspect @Unicode opfsIdx
+                <> "-field-"
+                <> inspect fieldIdx
+            )
+          . flip whenJust
+          $ \uri ->
+            pushActionQueue st
+              . Instant
+              . PureUpdate
+              $ ( cloneTraversal optic
+                    . #fieldInput
+                    . #uniqueValue
+                    .~ uri
+                )
+              . ( cloneTraversal optic
+                    . #fieldOutput
+                    .~ DynamicFieldText uri
+                )
+  where
+    assets = st ^. #modelState . #stAssets
+    opfsMax = length assets - 1

ghcjs/miso-functora/js/main.js

@@ -82,13 +82,28 @@ export async function opfsWrite(value, opfsName) {
     const stream = await handle.createWritable();
     await stream.write(value);
     await stream.close();
-    console.log("OPFS success", opfsName, handle);
+    console.log("OPFS write success", opfsName, handle);
   } catch (e) {
-    console.log("OPFS failure", opfsName, e);
+    console.log("OPFS write failure", opfsName, e);
   }
   return null;
 }
 
+export async function opfsRead(opfsName) {
+  try {
+    const root = await navigator.storage.getDirectory();
+    const handle = await root.getFileHandle(opfsName);
+    const file = await handle.getFile();
+    const uri = await file.text();
+    const res = await selectDataUrl(uri);
+    console.log("OPFS read success", opfsName, res);
+    return res;
+  } catch (e) {
+    console.log("OPFS read 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

@@ -11,6 +11,7 @@ module Functora.Miso.Jsm.Generic
     selectBarcode,
     selectClipboard,
     selectFile,
+    opfsRead,
     genericPromise,
     printCurrentPage,
     saveFileShow,
@@ -164,6 +165,12 @@ selectFile opfsName file after = do
     $ after
     . fmap strip
 
+opfsRead :: Unicode -> (Maybe Unicode -> JSM ()) -> JSM ()
+opfsRead opfsName after = do
+  genericPromise @[Unicode] @Unicode "opfsRead" [opfsName]
+    $ after
+    . fmap strip
+
 genericPromise ::
   forall args res.
   ( JS.MakeArgs args,