trying to fix inline image performance

Author: functora

cabal.project

@@ -6,6 +6,12 @@ package unix
 package directory
   flags: +os-string
 
+package miso
+  flags: +logview
+
+packages:
+  pub/miso/*.cabal
+
 source-repository-package
   type: git
   location: https://github.com/dorchard/type-level-sets.git

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

@@ -160,7 +160,11 @@ field full@Full {fullArgs = args, fullParser = parser, fullViewer = viewer} opts
                       if null src
                         then mempty
                         else
-                          [ img_ (src_ src : optsExtraAttributes opts),
+                          [ img_
+                              ( loading_ "lazy"
+                                  : src_ src
+                                  : optsExtraAttributes opts
+                              ),
                             br_ mempty
                           ]
                   )
@@ -660,7 +664,7 @@ genericFieldViewer opts0 args widget =
               opts0
               ( if typ == FieldTypeImage
                   then
-                    [ img_ [src_ input]
+                    [ img_ [loading_ "lazy", src_ input]
                     ]
                   else
                     [ widget

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

@@ -67,7 +67,7 @@ data Fa
   | FaTrash
   | FaFloppyDisk
   | FaPenToSquare
-  | FaPaste
+  | FaClipboard
   | FaEye
   | FaEyeSlash
   | FaAnglesUp
@@ -102,7 +102,7 @@ instance From Icon Fa where
     IconDelete -> FaTrash
     IconSave -> FaFloppyDisk
     IconEdit -> FaPenToSquare
-    IconPaste -> FaPaste
+    IconPaste -> FaClipboard
     IconVisible -> FaEye
     IconHidden -> FaEyeSlash
     IconUp -> FaAnglesUp

pub/miso/src/Miso.hs

@@ -126,18 +126,27 @@ common App {..} m getView = do
     loop !oldModel = liftIO wait >> do
         -- Apply actions to model
         actions <- liftIO $ atomicModifyIORef' actionsRef $ \actions -> (S.empty, actions)
+#ifdef LOGVIEW
+        tsU0 <- liftIO getCurrentTime
+        let (Acc newModel effects) = foldl' (foldEffects writeEvent update)
+                                            (Acc oldModel (pure ())) actions
+        effects
+        tsU1 <- liftIO getCurrentTime
+        consoleLog . ms . ("update " <>) . show $ diffUTCTime tsU1 tsU0
+#else
         let (Acc newModel effects) = foldl' (foldEffects writeEvent update)
                                             (Acc oldModel (pure ())) actions
         effects
+#endif
         oldName <- liftIO $ oldModel `seq` makeStableName oldModel
         newName <- liftIO $ newModel `seq` makeStableName newModel
         when (oldName /= newName && oldModel /= newModel) $ do
           swapCallbacks
 #ifdef LOGVIEW
-          ts0 <- liftIO getCurrentTime
+          tsV0 <- liftIO getCurrentTime
           newVTree <- runView (view newModel) writeEvent
-          ts1 <- liftIO getCurrentTime
-          consoleLog . ms . show $ diffUTCTime ts1 ts0
+          tsV1 <- liftIO getCurrentTime
+          consoleLog . ms . ("view " <>) . show $ diffUTCTime tsV1 tsV0
 #else
           newVTree <- runView (view newModel) writeEvent
 #endif