web,web/programs: Use idiomorph to preserve DOM on HtmlWhen swap

Fixes program details closing every time the program set changes.

Author: osnr

builtin-programs/web/programs.folk

@@ -5,7 +5,12 @@ Wish the web server handles route "/programs" with handler {
         set returnList [list "<details data-label='$label' data-count='[llength $programList]'><summary>$prettyLabel ([llength $programList])</summary>"]
         lappend returnList "<ul>"
         foreach item $programList {
-            lappend returnList "<li><details><summary>[dict get $item programName]</summary><pre><code>[htmlEscape [dict get $item programCode]]</code></pre></details></li>"
+            lappend returnList [subst {
+                <li id="program-[string map {{ } -} $item(programName)]"><details>
+                  <summary>$item(programName)</summary>
+                  <pre><code>[htmlEscape $item(programCode)]</code></pre>
+                </details></li>
+            }]
         }
         lappend returnList "</ul>"
         lappend returnList "</details>"
@@ -62,6 +67,7 @@ Wish the web server handles route "/programs" with handler {
                 }
             </style>
             <script src="/lib/folk.js"></script>
+            <script src="/vendor/idiomorph.js"></script>
             <script>
               const folk = new FolkWS();
             </script>
@@ -70,7 +76,10 @@ Wish the web server handles route "/programs" with handler {
         [HtmlWhen the collected results for [list /programName/ has program code /programCode/] \
                   are /programs/ {
             emitHtmlForPrograms $programs
-        }]
+
+        } -beforeAttributeUpdated {(attributeName, node, mutationType) => {
+            if (attributeName === "open") { return false; }
+        }}]
         </body>
         </html>
     }]

builtin-programs/web/web.folk

@@ -44,6 +44,10 @@ proc handlePage {path httpStatusVar contentTypeVar} {
             set contentType "text/javascript"
             readFile "lib/folk.js" contentType
         }
+        "/vendor/idiomorph.js" {
+            set contentType "text/javascript"
+            readFile "vendor/idiomorph.js" contentType
+        }
         default {
             upvar $httpStatusVar httpStatus
             set httpStatus "HTTP/1.1 404 Not Found"
@@ -79,8 +83,23 @@ proc parseQueryString {queryString} {
 }
 
 fn HtmlWhen args {
-    set body [lindex $args end]
-    set pattern [lreplace $args end end]
+    set callbacks [dict create]
+    set pattern [list]
+    for {set i 0} {$i < [llength $args]} {incr i} {
+        set arg [lindex $args $i]
+        if {$arg in [list "-beforeNodeAdded" "-afterNodeAdded" "-beforeNodeMorphed" \
+                         "-afterNodeMorphed" "-beforeNodeRemoved" "-afterNodeRemoved" \
+                         "-beforeAttributeUpdated"]} {
+            incr i
+            dict set callbacks [string range $arg 1 end] \
+                [lindex $args $i]
+        } else {
+            lappend pattern $arg
+        }
+    }
+    
+    set body [lindex $pattern end]
+    set pattern [lreplace $pattern end end]
     set envStack [uplevel captureEnvStack]
     lappend envStack [list ^HtmlWhen ${^HtmlWhen}]
     # TODO: Retract this when the page is closed.
@@ -115,14 +134,17 @@ fn HtmlWhen args {
         }
     }
 
+    set callbacksJs [join [lmap {callbackName callback} $callbacks {
+        subst {$callbackName: $callback}
+    }] ,]
     return [subst {
         <div style="display: contents;">[join $htmls \n]</div>
         <script>
         (function() {
           const el = document.currentScript.previousElementSibling;
+          const callbacks = {$callbacksJs};
           folk.subscribe(`the html for {$pattern} is /html/`, ({html}) => {
-            // TODO: use morph algorithm.
-            el.innerHTML = html;
+            Idiomorph.morph(el, html, {morphStyle:'innerHTML', callbacks:callbacks});
           });
         })();
         </script>

vendor/README.md

@@ -10,3 +10,5 @@ Some of these packages have been modified by us.
   <https://github.com/stv0g/c11-queues/tree/b602dcd2df5e835798581c46755487d1aca73e2d>
 - wslay is from <https://github.com/tatsuhiro-t/wslay/tree/0e7d106ff89ad6638090fd811a9b2e4c5dda8d40>
 - `vk_mem_alloc` is from <https://github.com/GPUOpen-LibrariesAndSDKs/VulkanMemoryAllocator/blob/e722e57c891a8fbe3cc73ca56c19dd76be242759/include/vk_mem_alloc.h>
+- idiomorph is from
+  <https://github.com/bigskysoftware/idiomorph/blob/10224e0841d4b14bead9f6fd9ac2dfa2d030b4c7/dist/idiomorph.js>