ui node tree pretty-printer

.console

@@ -0,0 +1 @@
+it consoles you

human.ml

@@ -1,5 +1,7 @@
 (*
 
+ALWAYS BREAK UP THE PROBLEM INTO SMALLER CHUNKS BITCH!!
+
 a computation console
 
 - irmin store provides a tree of data objects
@@ -1254,7 +1256,9 @@ module Panel = struct
     and atom =
       [ `Image of image
       | `Uchar of Uchar.t
-      | `Boundary of [`Word | `Line | `Sentance | `Hint] ]
+      | `Boundary of [`Word | `Line | `Sentance]
+      | `Hint of [`Line | `Other]
+      | `Empty ]
 
     and attr =
       [ `Style of style
@@ -1280,7 +1284,7 @@ module Panel = struct
 
     let node (t : t) = set_parent_on_children {parent= None; t}
     let empty_image = (Image.empty, V2.zero)
-    let empty_node = node (`Atom (`Image empty_image))
+    let empty_node = node (`Atom `Empty)
     let style (s : Style.t) (n : node) = node (`Attr (`Style s, n))
 
     let rec traverse_nodes ~(f : node -> node option) (n : node) :
@@ -1341,70 +1345,110 @@ module Panel = struct
     let ( ^^ ) = join_x
     let ( ^/^ ) = join_y
 
-    let rec pp_ui : node F.t =
+    let pp_uchar ppf v =
-     fun ppf v ->
+      if Uchar.is_char v then Fmt.pf ppf "'%c'" (Uchar.to_char v)
-      let atom a =
+      else Fmt.Dump.uchar ppf v
-        F.pf ppf "`Atom " ;
+
-        match a with
+    let pp_atom ppf v =
-        | `Image _ -> F.pf ppf "`Image"
+      let open Fmt in
-        | `Uchar c ->
+      ( match v with
-            F.pf ppf "`Uchar " ;
+      | `Image _ -> any "`Image"
-            if Uchar.is_char c then F.pf ppf "%c" (Uchar.to_char c)
+      | `Uchar c -> any "`Uchar " ++ const pp_uchar c
-            else F.pf ppf "0x%x" (Uchar.to_int c)
+      | `Boundary b -> (
-        | `Boundary b ->
+          any "`Boundary "
-            F.pf ppf "`Boundary " ;
+          ++
-            F.pf ppf
+          match b with
-              ( match b with
+          | `Word -> any "`Word"
-              | `Word -> "`Word"
+          | `Line -> any "`Line"
-              | `Line -> "`Line"
+          | `Sentance -> any "`Sentance" )
-              | `Sentance -> "`Sentance"
+      | `Hint h ->
-              | `Hint -> "`Hint" ) in
+          any "`Hint "
-      let attr a =
+          ++ any (match h with `Line -> "`Line" | `Other -> "`Other")
-        F.pf ppf "`Attr " ;
+      | `Empty -> any "`Empty" )
-        F.pf ppf
+        ppf ()
-          ( match a with
+
-          | `Style _ -> "`Style ..., "
+    let tess v = F.epr "%a" pp_atom v
-          | `Pad _ -> "`Pad ..., "
+
-          | `Shift _ -> "`Shift ..., "
+    let pp_attr ppf v =
+      let open Fmt in
+      (any
+         ( match v with
+         | `Style _ -> "`Style ..."
+         | `Pad _ -> "`Pad ..."
+         | `Shift _ -> "`Shift ..."
          | `Cursor -> "`Cursor"
-          | `Handler _ -> "`Handler ..., " ) in
+         | `Handler _ -> "`Handler ..." ) )
-      let join (d, a, b) =
+        ppf ()
-        F.pf ppf "`Join " ;
+
-        ( match d with
+    let pp_dir ppf v =
-        | `X -> F.pf ppf "`X "
+      F.pf ppf "%s"
-        | `Y -> F.pf ppf "`Y "
+        (match v with `X -> "`X" | `Y -> "`Y" | `Z -> "`Z")
-        | `Z -> F.pf ppf "`Z " ) ;
+
-        F.parens pp_ui ppf b ; F.parens pp_ui ppf a in
+    let rec pp_node ppf v =
-      match v.t with
+      let open Fmt in
-      | `Join x -> join x
+      pf ppf "@[<hov>%a@]" pp_t v.t
-      | `Attr (x, n) -> attr x ; F.parens pp_ui ppf n
+
-      | `Atom x -> atom x
+    and pp_t ppf v =
+      let open Fmt in
+      match v with
+      | `Join (d, a, b) ->
+          pf ppf "`Join %a"
+            (parens
+               ( const pp_dir d ++ comma ++ const pp_node a ++ comma
+               ++ const pp_node b ) )
+            ()
+      | `Attr (a, n) ->
+          pf ppf "`Attr %a"
+            (parens (const pp_attr a ++ comma ++ const pp_node n))
+            ()
+      | `Atom x -> pf ppf "`Atom %a" pp_atom x
+
+    (* there's no difference between a node element and a node list what, tho an element is kinda like a node.t,
+       so i guess we'll use that to kinda emulate append (vs. concat which is what join is)
+       ugh maybe using types to build this double-linked binary-tree data structure is not a good idea.
+       I'm STONED, so i'm not making sense, but i'm gonna carry on anyway and see what happens.
+       So i think what is really happening is that i'm defining the `list` for this node type that allows `append`.
+       The main problem with this thought is that you can't do anything but append with the datastructure.
+    *)
+    let new_append () = empty_node
+
+    let append (d : dir) (l : unit -> node) (n : node) : unit -> node
+        =
+     fun () ->
+      set_parent_on_children {parent= None; t= `Join (d, l (), n)}
 
     module Text = struct
-      let rec insert_string (n : node) (str : string) : node =
+      let rec _of_string (la : unit -> node) (str : string) :
+          unit -> node =
         let uudec = Uutf.decoder (`String str) in
-        let rec dec (n' : node) : 'a * node =
+        let rec dec (lx : unit -> node) : 'a * (unit -> node) =
           match Uutf.decode uudec with
-          | `Malformed b -> dec (insert_string n' (String.escaped b))
+          | `Malformed b -> dec (_of_string lx (String.escaped b))
-          | (`Await | `Uchar _ | `End) as x -> (x, n') in
+          | (`Await | `Uchar _ | `End) as x -> (x, lx) in
         let uuline = Uuseg.create `Line_break in
-        let rec line (n' : node) : node =
+        let rec new_line la' : unit -> node =
-          let rec char (x, t) (line : node) =
+          let rec char (x, lx) (ly : unit -> node) =
             match Uuseg.add uuline x with
-            | `End as x -> (line, x)
+            | `End as x -> (ly, x)
-            | `Boundary as x when Uuseg.mandatory uuline -> (line, x)
+            | `Boundary as x when Uuseg.mandatory uuline -> (ly, x)
-            | `Await -> char (dec t) line
+            | `Await -> char (dec lx) ly
             | `Boundary ->
                 char
-                  (`Await, t)
+                  (`Await, append `X lx (node (`Atom (`Hint `Line))))
-                  (line ^^ node (`Atom (`Boundary `Hint)))
+                  ly
             | `Uchar c ->
-                char (`Await, t) (line ^^ node (`Atom (`Uchar c)))
+                char
-          in
+                  (`Await, append `X lx (node (`Atom (`Uchar c))))
-          match char (`Await, n') n' with
+                  ly in
-          | l, `Boundary -> line (l ^/^ node (`Atom (`Boundary `Line)))
+          match char (`Await, la') la' with
+          | l, `Boundary ->
+              new_line
+                (append `Y la'
+                   ((append `X l (node (`Atom (`Boundary `Line)))) ()) )
           | l, `End -> l in
-        line n
+        new_line la
+
+      let of_string str = _of_string new_append str ()
 
       (* let segment ?(boundary = `Word) ?(label = `Word) (node : node) :
              node =
@@ -1444,7 +1488,7 @@ module Panel = struct
          let text str : node = insert_string str |> sentances |> words *)
     end
 
-    let text = Text.insert_string
+    let text = Text.of_string
 
     module Draw = struct
       type d = [`X | `Y | `Z]
@@ -1519,6 +1563,8 @@ module Panel = struct
         | `Image i -> i
         | `Uchar uc -> uchar style uc
         | `Boundary _ -> empty_image
+        | `Hint _ -> empty_image
+        | `Empty -> empty_image
 
       and attr ?(style = Style.empty) (attr, node) : image =
         match attr with
@@ -1639,7 +1685,14 @@ module Panel = struct
       let bind = Key.Bind.init bindings in
       let n' = insert_attr `Cursor n in
       let c = ref n in
-      F.epr "%a@." pp_ui n' ;
+      Format.(
+        F.epr
+          "@[<hv> F.stderr margin: %d, max_indent: %d, max_boxes: %d \
+           @]@."
+          (pp_get_margin F.stderr ())
+          (pp_get_max_indent F.stderr ())
+          (pp_get_max_boxes F.stderr ())) ;
+      F.epr "@[<v>%a@]@." pp_node n' ;
       node
         (`Attr
           ( `Handler
@@ -1649,7 +1702,7 @@ module Panel = struct
                     c :=
                       insert_attr `Cursor
                         (perform_action x (remove_attr !c)) ;
-                    F.epr "%a@." pp_ui !c ;
+                    F.epr "%a@." pp_node !c ;
                     Lwt.return_none
                 | [] -> Lwt.return_some e )
           , n ) )
@@ -1700,7 +1753,7 @@ module Panel = struct
                           (Text.insert_string empty_node "hello bitch")
                           (Text.insert_string empty_node
                              "!\n sup daddy" ) ) )*)
-                 (Text.insert_string empty_node "test 1 2 3") ) ) )
+                 (Text.of_string "test 1 2 3") ) ) )
     (* ) *)
   end
 end

opam-switch

@@ -0,0 +1,361 @@
+opam-version: "2.0"
+compiler: ["ocaml-system.4.13.1"]
+roots: [
+  "bogue.20210917"
+  "findlib_top.v0.11.0"
+  "glfw-ocaml.3.3.1-1"
+  "huffman.0.1.2"
+  "inuit.0.4.1"
+  "irc-client.0.7.0"
+  "irc-client-lwt.0.7.0"
+  "irc-client-tls.0.7.0"
+  "irc-client-unix.0.7.0"
+  "irmin.2.9.0"
+  "irmin-unix.2.9.0"
+  "lambda-term.3.1.0"
+  "lwd.0.1"
+  "lwt_ppx.2.0.3"
+  "merlin.4.4-413"
+  "note.0.0.1"
+  "nottui.0.1"
+  "nottui-lwt.0.1"
+  "nottui-pretty.0.1"
+  "ocaml-manual.4.13.0"
+  "ocaml-system.4.13.1"
+  "ocamlformat.0.20.1"
+  "odig.0.0.7"
+  "odoc.2.0.2"
+  "pp.1.1.2"
+  "pprint.20211129"
+  "tgls.0.8.5"
+  "tsdl.0.9.8"
+  "user-setup.0.7"
+  "wall.0.4.1"
+  "zed.3.1.0"
+]
+installed: [
+  "angstrom.0.15.0"
+  "arp.3.0.0"
+  "asn1-combinators.0.2.6"
+  "astring.0.8.5"
+  "awa.0.0.4"
+  "awa-mirage.0.0.4"
+  "b0.0.0.3"
+  "base.v0.14.2"
+  "base-bigarray.base"
+  "base-bytes.base"
+  "base-threads.base"
+  "base-unix.base"
+  "base64.3.5.0"
+  "bheap.2.0.0"
+  "bigarray-compat.1.0.0"
+  "bigstringaf.0.8.0"
+  "biniou.1.2.1"
+  "bogue.20210917"
+  "bos.0.2.0"
+  "ca-certs.0.2.2"
+  "ca-certs-nss.3.71"
+  "camomile.1.0.2"
+  "carton.0.4.3"
+  "carton-git.0.4.3"
+  "carton-lwt.0.4.3"
+  "cf.0.4"
+  "cf-lwt.0.4"
+  "charInfo_width.1.1.0"
+  "checkseum.0.3.2"
+  "cmdliner.1.0.4"
+  "cohttp.4.0.0"
+  "cohttp-lwt.4.0.0"
+  "cohttp-lwt-unix.4.0.0"
+  "conduit.4.0.2"
+  "conduit-lwt.4.0.2"
+  "conduit-lwt-unix.4.0.2"
+  "conf-cairo.1"
+  "conf-gles2.1"
+  "conf-glfw3.2"
+  "conf-gmp.3"
+  "conf-gmp-powm-sec.3"
+  "conf-libffi.2.0.0"
+  "conf-libX11.1"
+  "conf-m4.1"
+  "conf-pkg-config.2"
+  "conf-sdl2.1"
+  "conf-sdl2-image.1"
+  "conf-sdl2-ttf.1"
+  "cppo.1.6.8"
+  "crunch.3.2.0"
+  "csexp.1.5.1"
+  "cstruct.6.0.1"
+  "cstruct-lwt.6.0.1"
+  "cstruct-sexp.6.0.1"
+  "cstruct-unix.6.0.1"
+  "ctypes.0.20.0"
+  "ctypes-foreign.0.18.0"
+  "decompress.1.4.2"
+  "digestif.1.1.0"
+  "dispatch.0.5.0"
+  "domain-name.0.3.1"
+  "dot-merlin-reader.4.1"
+  "duff.0.4"
+  "dune.2.9.1"
+  "dune-build-info.2.9.1"
+  "dune-configurator.2.9.1"
+  "duration.0.2.0"
+  "easy-format.1.3.2"
+  "either.1.0.0"
+  "emile.1.1"
+  "encore.0.8"
+  "eqaf.0.8"
+  "ethernet.3.0.0"
+  "findlib_top.v0.11.0"
+  "fix.20211125"
+  "fmt.0.9.0"
+  "fpath.0.7.3"
+  "fsevents.0.3.0"
+  "fsevents-lwt.0.3.0"
+  "gg.0.9.3"
+  "git.3.6.0"
+  "git-cohttp.3.6.0"
+  "git-cohttp-unix.3.6.0"
+  "git-unix.3.6.0"
+  "glfw-ocaml.3.3.1-1"
+  "gmap.0.3.0"
+  "graphql.0.13.0"
+  "graphql-cohttp.0.13.0"
+  "graphql-lwt.0.13.0"
+  "graphql_parser.0.13.0"
+  "graphv_core.0.1.1"
+  "graphv_core_lib.0.1.1"
+  "graphv_font.0.1.1"
+  "graphv_font_js.0.1.1"
+  "graphv_gles2.0.1.1"
+  "graphv_gles2_native_impl.0.1.1"
+  "graphv_webgl.0.1.1"
+  "graphv_webgl_impl.0.1.1"
+  "grenier.0.13"
+  "hex.1.4.0"
+  "hkdf.1.0.4"
+  "huffman.0.1.2"
+  "hxd.0.3.1"
+  "index.1.5.0"
+  "inotify.2.3"
+  "integers.0.5.1"
+  "inuit.0.4.1"
+  "ipaddr.5.2.0"
+  "ipaddr-sexp.5.2.0"
+  "irc-client.0.7.0"
+  "irc-client-lwt.0.7.0"
+  "irc-client-tls.0.7.0"
+  "irc-client-unix.0.7.0"
+  "irmin.2.9.0"
+  "irmin-fs.2.9.0"
+  "irmin-git.2.9.0"
+  "irmin-graphql.2.9.0"
+  "irmin-http.2.9.0"
+  "irmin-layers.2.9.0"
+  "irmin-pack.2.9.0"
+  "irmin-unix.2.9.0"
+  "irmin-watcher.0.5.0"
+  "jbuilder.1.0+beta20.2"
+  "js_of_ocaml.3.11.0"
+  "js_of_ocaml-compiler.3.11.0"
+  "js_of_ocaml-ppx.3.11.0"
+  "jsonm.1.0.1"
+  "ke.0.4"
+  "lambda-term.3.1.0"
+  "logs.0.7.0"
+  "lru.0.3.0"
+  "lwd.0.1"
+  "lwt.5.5.0"
+  "lwt-dllist.1.0.1"
+  "lwt_log.1.1.1"
+  "lwt_ppx.2.0.3"
+  "lwt_react.1.1.5"
+  "macaddr.5.2.0"
+  "macaddr-cstruct.5.2.0"
+  "magic-mime.1.2.0"
+  "menhir.20211128"
+  "menhirLib.20211128"
+  "menhirSdk.20211128"
+  "merlin.4.4-413"
+  "metrics.0.3.0"
+  "mew.0.1.0"
+  "mew_vi.0.5.0"
+  "mimic.0.0.4"
+  "mirage-clock.4.0.0"
+  "mirage-clock-unix.4.0.0"
+  "mirage-crypto.0.10.5"
+  "mirage-crypto-ec.0.10.5"
+  "mirage-crypto-pk.0.10.5"
+  "mirage-crypto-rng.0.10.5"
+  "mirage-device.2.0.0"
+  "mirage-flow.3.0.0"
+  "mirage-kv.4.0.0"
+  "mirage-net.4.0.0"
+  "mirage-no-solo5.1"
+  "mirage-no-xen.1"
+  "mirage-profile.0.9.1"
+  "mirage-protocols.8.0.0"
+  "mirage-random.3.0.0"
+  "mirage-stack.4.0.0"
+  "mirage-time.3.0.0"
+  "mmap.1.1.0"
+  "mtime.1.3.0"
+  "note.0.0.1"
+  "nottui.0.1"
+  "nottui-lwt.0.1"
+  "nottui-pretty.0.1"
+  "notty.0.2.2"
+  "num.1.4"
+  "oasis.0.4.11"
+  "ocaml.4.13.1"
+  "ocaml-compiler-libs.v0.12.4"
+  "ocaml-config.2"
+  "ocaml-manual.4.13.0"
+  "ocaml-migrate-parsetree.2.3.0"
+  "ocaml-options-vanilla.1"
+  "ocaml-syntax-shims.1.0.0"
+  "ocaml-system.4.13.1"
+  "ocaml-version.3.4.0"
+  "ocamlbuild.0.14.0"
+  "ocamlfind.1.9.1"
+  "ocamlformat.0.20.1"
+  "ocamlgraph.2.0.0"
+  "ocamlify.0.0.1"
+  "ocamlmod.0.0.9"
+  "ocb-stubblr.0.1.1-1"
+  "ocp-indent.1.8.1"
+  "ocplib-endian.1.2"
+  "odig.0.0.7"
+  "odoc.2.0.2"
+  "odoc-parser.1.0.0"
+  "optint.0.1.0"
+  "parsexp.v0.14.1"
+  "pbkdf.1.2.0"
+  "pecu.0.6"
+  "pp.1.1.2"
+  "pprint.20211129"
+  "ppx_cstruct.6.0.1"
+  "ppx_derivers.1.2.1"
+  "ppx_deriving.5.2.1"
+  "ppx_irmin.2.9.0"
+  "ppx_repr.0.5.0"
+  "ppx_sexp_conv.v0.14.3"
+  "ppxlib.0.24.0"
+  "progress.0.2.1"
+  "psq.0.2.0"
+  "ptime.0.8.6"
+  "randomconv.0.1.3"
+  "re.1.10.3"
+  "react.1.2.1"
+  "repr.0.5.0"
+  "result.1.5"
+  "rresult.0.6.0"
+  "semaphore-compat.1.0.1"
+  "seq.base"
+  "sexplib.v0.14.0"
+  "sexplib0.v0.14.0"
+  "stb_image.0.5"
+  "stb_truetype.0.6"
+  "stdio.v0.14.0"
+  "stdlib-shims.0.3.0"
+  "stringext.1.6.0"
+  "tcpip.7.0.0"
+  "terminal.0.2.1"
+  "terminal_size.0.1.4"
+  "tgls.0.8.5"
+  "tls.0.14.1"
+  "tls-mirage.0.14.1"
+  "topkg.1.0.4"
+  "trie.1.0.0"
+  "tsdl.0.9.8"
+  "tsdl-image.0.3.2"
+  "tsdl-ttf.0.3.2"
+  "tyxml.4.5.0"
+  "uchar.0.0.2"
+  "uri.4.2.0"
+  "uri-sexp.4.2.0"
+  "user-setup.0.7"
+  "uucp.14.0.0"
+  "uuseg.14.0.0"
+  "uutf.1.0.2"
+  "vector.1.0.0"
+  "wall.0.4.1"
+  "webmachine.0.7.0"
+  "x509.0.14.1"
+  "yaml.3.0.0"
+  "yojson.1.7.0"
+  "zarith.1.12"
+  "zed.3.1.0"
+]
+pinned: ["lwd.0.1" "nottui.0.1"]
+package "lwd" {
+  opam-version: "2.0"
+  version: "0.1"
+  synopsis: "Lightweight reactive documents"
+  maintainer: "fred@tarides.com"
+  authors: "Frédéric Bour"
+  license: "MIT"
+  homepage: "https://github.com/let-def/lwd"
+  doc: "https://let-def.github.io/lwd/doc"
+  bug-reports: "https://github.com/let-def/lwd/issues"
+  depends: [
+    "dune" {>= "2.0"}
+    "seq"
+    "ocaml" {>= "4.03"}
+    "qtest" {with-test}
+    "qcheck" {with-test}
+  ]
+  build: [
+    ["dune" "subst"] {pinned}
+    [
+      "dune"
+      "build"
+      "-p"
+      name
+      "-j"
+      jobs
+      "@install"
+      "@runtest" {with-test}
+      "@doc" {with-doc}
+    ]
+  ]
+  dev-repo: "git+https://github.com/let-def/lwd.git"
+  url {
+    src: "git+file:///home/cqc/p/console/ref/lwd#master"
+  }
+}
+package "nottui" {
+  opam-version: "2.0"
+  version: "0.1"
+  synopsis: "UI toolkit for the terminal built on top of Notty and Lwd"
+  maintainer: "fred@tarides.com"
+  authors: "Frédéric Bour"
+  license: "MIT"
+  homepage: "https://github.com/let-def/lwd"
+  doc: "https://let-def.github.io/lwd/doc"
+  bug-reports: "https://github.com/let-def/lwd/issues"
+  depends: [
+    "dune" {>= "2.0"}
+    "lwd"
+    "notty"
+  ]
+  build: [
+    ["dune" "subst"] {pinned}
+    [
+      "dune"
+      "build"
+      "-p"
+      name
+      "-j"
+      jobs
+      "@install"
+      "@runtest" {with-test}
+      "@doc" {with-doc}
+    ]
+  ]
+  dev-repo: "git+https://github.com/let-def/lwd.git"
+  url {
+    src: "git+file:///home/cqc/p/console/ref/lwd#master"
+  }
+}