looks like shit

dune

@@ -25,7 +25,6 @@
    uri
    zed
    gg
-   wall
-
+   lwd
 ))
 

human.ml

@@ -68,13 +68,15 @@ module Logs_reporter = struct
     in
     (Format.formatter_of_buffer b, flush)
 
-  let log_buf = Buffer.create 4096
+  let hook =
+    ref (fun level s ->
+        ignore (Logs.level_to_string (Some level) ^ ": " ^ s))
 
   let console_report _src level ~over k msgf =
     let k _ =
       let s = flush () in
       console level s;
-      Buffer.add_string log_buf s;
+      !hook level s;
       over ();
       k ()
     in
@@ -92,6 +94,7 @@ let _ =
   Logs.set_level (Some Debug);
   Logs.debug (fun m -> m "hello")
 
+module Log = Logs
 module Cohttp_backend = Cohttp_lwt_jsoo
 
 module Git_af = struct
@@ -284,7 +287,10 @@ module Git_console_http = struct
       match git_scheme with
       | `Git | `SSH | `Scheme _ -> Lwt.return_none
       | `HTTP | `HTTPS ->
-          let headers = git_http_headers in
+          let headers =
+            ("content-type", "application/x-git-upload-pack-request")
+            :: git_http_headers
+          in
           let handshake ~uri0 ~uri1 = function
             | T.T flow -> (
                 Firebug.console##log
@@ -450,12 +456,12 @@ module Nav = struct
     Firebug.console##log (Js.string "Nav.test_pull()\n");
     S.Repo.v (Config.init "") >>= fun repo ->
     Firebug.console##log (Js.string "Nav.test_pull(2)\n");
-    S.of_branch repo "main" >>= fun t ->
+    S.of_branch repo "current" >>= fun t ->
     Firebug.console##log (Js.string "Nav.test_pull(3)\n");
     Git_console_http.connect Mimic.empty >>= fun ctx ->
     Firebug.console##log (Js.string "Nav.test_pull(4)\n");
     let upstream =
-      S.remote ~ctx "https://localhost:8080/console/boot"
+      S.remote ~ctx "https://localhost:8080/console/rootstore.git"
     in
     Firebug.console##log (Js.string "Nav.test_pull(5)\n");
     Sync.fetch_exn t upstream >>= fun _ -> S.tree t
@@ -1747,34 +1753,94 @@ module Panel = struct
        scratch i will try to steal it.
     *)
 
+    (* we need to determine how "document types" should be implemented:
+       * as a module that implements a common interface which allows
+       production of a Ui.t which is then rendered.
+         * this will require exposing the Ui and all drawing related functions.
+         *
+    *)
+
     module View = struct
+      type path = Nav.path
+
+      type t = {
+        tree : Nav.tree;
+        view : path list Lwd.var;
+        cursor : Nav.path Lwd.var;
+        doc : node Lwd.t;
+      }
+
       open Lwt.Infix
 
-      let tree = ref (Nav.test_pull ())
-      let cursor = ref []
+      let pack_x = Lwd_utils.lift_monoid (empty_node (), join_x)
+      let pack_y = Lwd_utils.lift_monoid (empty_node (), join_y)
+      let pack_z = Lwd_utils.lift_monoid (empty_node (), join_z)
 
-      let contents tree =
-        Nav.S.Tree.list tree !cursor >>= fun l ->
+      module DText = struct
+        let lines = Lwd.map ~f:Text.lines
+        let of_string = Lwd.map ~f:Text.of_string
+      end
+
+      let of_path path =
+        Lwd.map2 ~f:join_x
+          (DText.of_string (Lwd.pure "/"))
+          (Lwd_utils.map_reduce
+             (fun step ->
+               Lwd_utils.pack
+                 (empty_node (), join_x)
+                 [
+                   DText.of_string (Lwd.pure "/");
+                   DText.of_string (Lwd.pure step);
+                 ])
+             pack_x path)
+
+      let of_tree ?(path = []) tree =
+        Nav.S.Tree.list tree path >>= fun l ->
         Lwt.return
-          (String.concat "\n" (List.map (fun (step, _t') -> step) l))
+          {
+            tree;
+            view = Lwd.var [ path ];
+            cursor = Lwd.var path;
+            doc =
+              Lwd_utils.map_reduce
+                (fun (step, _t') -> DText.of_string (Lwd.pure step))
+                pack_y l;
+          }
 
-      type t = { tree : Nav.tree; mutable cursor : Nav.step }
+      let list_logs hook =
+        let var = Lwd.var (empty_node ()) in
+        (hook :=
+           fun level s ->
+             Lwd.set var
+               (join_y
+                  (Text.of_string
+                     (Logs.level_to_string (Some level) ^ ": " ^ s))
+                  (Lwd.peek var)));
+        Lwd.get var
 
-      let draw (vg, p) tree : p Lwt.t =
-        contents tree >>= fun contents ->
-        Lwt.return (Draw.node vg p (textedit (Text.lines contents)))
+      let draw (vg, p) (t : node Lwd.t) : p Lwt.t =
+        let root =
+          Lwd.observe
+            ~on_invalidate:(fun _ ->
+              Log.warn (fun m -> m "View.draw doc_root on_invalidate"))
+            t
+        in
+        Lwt.return (Draw.node vg p (Lwd.quick_sample root))
     end
 
     open Lwt.Infix
 
     let render_lwt (vg : NVG.t) (p : p) (_ev : Event.t) : p Lwt.t =
       let t = { vg; style = Style.dark } in
-      !View.tree >>= fun tree ->
-      View.draw (t, p) tree >>= fun p ->
-      let module Buffer = Stdlib.Buffer in
-      Lwt.return
-        (Draw.node t p
-           (Text.lines (Buffer.contents Logs_reporter.log_buf)))
+      Nav.test_pull () >>= fun tree ->
+      View.of_tree tree >>= fun doc ->
+      View.draw (t, p)
+        (Lwd_utils.reduce View.pack_y
+           [
+             doc.doc;
+             View.of_path (Lwd.peek doc.cursor);
+             View.list_logs Logs_reporter.hook;
+           ])
   end
 end
 

index.html

@@ -1,4 +1,4 @@
-<!DOCTYPE>
+<!DOCTYPE html>
 <html>
   <head>
     <style>