Action.pp_t and cleanup

human.ml

@@ -2,6 +2,8 @@
 
 ALWAYS BREAK UP THE PROBLEM INTO SMALLER CHUNKS BITCH!!
 
+Times I would have solved it faster if i broke it up instead of trying to understand it all at once: 2
+
 a computation console
 
 - irmin store provides a tree of data objects
@@ -1242,6 +1244,8 @@ module Panel = struct
     (* Tree-like structure of Ui elements, from the entire display down to individual glyphs. *)
     (* i think this is gonna end up being a binary tree?? *)
 
+    (* TODO make sure this is LCRS: https://en.wikipedia.org/wiki/Left-child_right-sibling_binary_tree *)
+
     open Gg
     open Wall
 
@@ -1250,7 +1254,7 @@ module Panel = struct
       | `Attr of attr * node
       | `Join of dir * node * node ]
 
-    and node = {mutable parent: node option; mutable t: t}
+    and node = {mutable parent: node option; mutable t: t; n: int}
     and cursor = {root: node; mutable sel: node}
 
     and atom =
@@ -1281,7 +1285,15 @@ module Panel = struct
           b.parent <- Some n ) ;
       n
 
-    let node (t : t) = set_parent_on_children {parent= None; t}
+    let node_count = ref 0
+
+    let node_n () =
+      node_count := !node_count + 1 ;
+      !node_count - 1
+
+    let node (t : t) =
+      set_parent_on_children {parent= None; t; n= node_n ()}
+
     let empty_image = (Image.empty, V2.zero)
     let empty_node = node (`Atom `Empty)
     let style (s : Style.t) (n : node) = node (`Attr (`Style s, n))
@@ -1333,7 +1345,8 @@ module Panel = struct
       | `Join (_, a, _) -> a
 
     let join_ d (a : node) (b : node) =
-      set_parent_on_children {parent= a.parent; t= `Join (d, a, b)}
+      set_parent_on_children
+        {parent= a.parent; t= `Join (d, a, b); n= node_n ()}
 
     let join_x = join_ `X
     let join_y = join_ `Y
@@ -1374,8 +1387,6 @@ module Panel = struct
       | `Empty -> any "`Empty" )
         ppf ()
 
-    let tess v = F.epr "%a" pp_atom v
-
     let pp_attr ppf v =
       let open Fmt in
       (any
@@ -1391,36 +1402,44 @@ module Panel = struct
       F.pf ppf "%s"
         (match v with `X -> "`X" | `Y -> "`Y" | `Z -> "`Z")
 
-    let rec pp_node ppf v =
+    let pp_node_n ppf v =
-      let open Fmt in
+      F.(
-      pf ppf "@[<hov>%a@]" pp_t v.t
+        pf ppf "%a"
+          (record [field "n" (fun v -> v.n) int; any "..."])
+          v)
 
-    and pp_t ppf v =
+    let rec _pp_t child ppf v =
       let open Fmt in
       match v with
+      | `Atom x -> pf ppf "`Atom %a" pp_atom x
+      | `Attr (a, n) ->
+          pf ppf "`Attr %a"
+            (parens (const pp_attr a ++ comma ++ const child n))
+            ()
       | `Join (d, a, b) ->
           pf ppf "`Join %a"
             (parens
-               ( const pp_dir d ++ comma ++ const pp_node a ++ comma
+               ( const pp_dir d ++ comma ++ const child a ++ comma
-               ++ const pp_node b ) )
+               ++ const child 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
 
-    let rec pp_dump_node ppf v =
+    and _pp_node child ppf v =
       let open Fmt in
       pf ppf "@[<hov>%a@]"
         (braces
            (record
-              [ field "t" (fun v -> v.t) pp_t
+              [ field "n" (fun v -> v.n) int
+              ; field "t" (fun v -> v.t) (_pp_t child)
               ; field "parent"
                   (fun v -> v.parent)
-                  (option pp_dump_node) ] ) )
+                  (option (fun ppf v -> pf ppf "%a" int v.n)) ] ) )
         v
 
+    and pp_node ppf v = _pp_node pp_node_n ppf v
+    and pp_dump_node ppf v = _pp_node pp_dump_node ppf v
+
+    let pp_t = _pp_t pp_node_n
+
     (* 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.
@@ -1593,13 +1612,13 @@ module Panel = struct
       type segment_type =
         [`Char | `Word | `Phrase | `Line | `Page | `Region]
 
-      type segment =
+      and segment =
         [ `Beginning of segment_type
         | `Forward of segment_type
         | `Backward of segment_type
         | `End of segment_type ]
 
-      type t =
+      and t =
         [ `Move of segment
         | `Yank of segment
         | `Kill of segment
@@ -1607,7 +1626,7 @@ module Panel = struct
         | `Descend
         | `Custom of string * (node -> t Key.Bind.t -> unit Lwt.t) ]
 
-      type dir =
+      and dir =
         [ `Next
         | `Prev
         | `Up
@@ -1618,31 +1637,68 @@ module Panel = struct
         | `Enter
         | `In
         | `Out ]
+
+      open Fmt
+
+      let pp_dir ppf v =
+        any
+          ( match v with
+          | `Next -> "`Next"
+          | `Prev -> "`Prev"
+          | `Up -> "`Up"
+          | `Down -> "`Down"
+          | `Left -> "`Left"
+          | `Right -> "`Right"
+          | `Fwd -> "`Fwd"
+          | `Enter -> "`Enter"
+          | `In -> "`In"
+          | `Out -> "`Out" )
+          ppf ()
+
+      let pp_segment_type ppf v =
+        any
+          ( match v with
+          | `Char -> "`Char"
+          | `Word -> "`Word"
+          | `Phrase -> "`Phrase"
+          | `Line -> "`Line"
+          | `Page -> "`Page"
+          | `Region -> "`Region" )
+          ppf ()
+
+      let pp_segment ppf v =
+        ( match v with
+        | `Beginning s -> any "`Beginning " ++ const pp_segment_type s
+        | `Forward s -> any "`Forward " ++ const pp_segment_type s
+        | `Backward s -> any "`Backward " ++ const pp_segment_type s
+        | `End s -> any "`End " ++ const pp_segment_type s )
+          ppf ()
+
+      let pp_t ppf v =
+        ( match v with
+        | `Move s -> any "`Move " ++ const pp_segment s
+        | `Yank s -> any "`Yank " ++ const pp_segment s
+        | `Kill s -> any "`Kill " ++ const pp_segment s
+        | `Ascend -> any "`Ascend"
+        | `Descend -> any "`Descend"
+        | `Custom (s, _) ->
+            fun ppf () -> pf ppf "`Custom \"%a\"" string s )
+          ppf ()
     end
 
     let tree_next (n : node) =
-      F.epr "tree_next @." ;
       let rec next_right n' =
-        F.epr "next_right n=%a@." pp_dump_node n' ;
+        match n'.parent with
-        match n.parent with
+        | None -> None
-        | None ->
-            F.epr "tree_next None@." ;
-            None
         | Some ({t= `Attr _; _} as p) -> next_right p
-        | Some {t= `Join (_, a, b); _} when n' == a ->
+        | Some {t= `Join (_, a, b); _} when n' == a -> Some b
-            F.epr "next_right `Join _,n,_@." ;
-            Some b
         | Some ({t= `Join (_, _, b); _} as p) when n' == b ->
-            F.epr "next_right `Join _,_,n@." ;
             next_right p
-        | Some {t= `Join (_, a, b); _} ->
+        | Some {t= `Join _; _} -> assert false
-            F.epr "next_right `Join (_,%a,%a)@." pp_node a pp_node b ;
-            assert false
         | Some {t= `Atom _; _} -> assert false in
       match n.t with
       | `Atom _ -> next_right n
       | `Attr (_, n') -> Some n'
-      | `Join (_, {t= `Atom `Empty; _}, b) -> Some b
       | `Join (_, a, _) -> Some a
 
     let tree_prev (n : node) =
@@ -1658,7 +1714,6 @@ module Panel = struct
 
     let rec search_forward (n : node) (f : node -> 'a option) :
         'a option =
-      F.epr "search_forward @." ;
       match f n with
       | None -> (
         match tree_next n with
@@ -1685,7 +1740,6 @@ module Panel = struct
                 | `Atom (`Boundary `Word) -> Some n
                 | _ -> None )
         | `Move (`Forward `Char) ->
-            F.epr "`Move (`Forward `Char)%a@." pp_node c.sel ;
             search_forward c.sel (fun n ->
                 match n.t with
                 | _ when n == c.sel -> None
@@ -1756,6 +1810,7 @@ module Panel = struct
               ( match join_search_forward n with
               | Some n -> n
               | None -> n ) } in
+      Format.pp_set_max_boxes F.stderr 99999 ;
       Format.(
         F.epr
           "@[<hv>F.stderr margin: %d, max_indent: %d, max_boxes: %d \
@@ -1763,34 +1818,30 @@ module Panel = struct
           (pp_get_margin F.stderr ())
           (pp_get_max_indent F.stderr ())
           (pp_get_max_boxes F.stderr ())) ;
-      Format.pp_set_max_boxes F.stderr 32 ;
       node
         (`Attr
           ( `Handler
               (fun (_ : node) (e : Event.t) : Event.t option Lwt.t ->
                 match Key.Bind.resolve_events bind [e] with
                 | x :: _ ->
-                    F.epr "textedit_handler handling event@." ;
                     c.sel <- remove_attr c.sel ;
                     ( match perform_action x c with
                     | Some _ ->
                         F.epr
-                          "textedit_handler perform_action success@."
+                          "textedit_handler perform_action @[%a@] \
+                           success@."
+                          Action.pp_t x
                     | None ->
                         F.epr
-                          "textedit_handler perform_action FAILURE@."
+                          "textedit_handler perform_action @[%a@] \
-                    ) ;
+                           FAILURE@."
+                          Action.pp_t x ) ;
                     c.sel <- insert_attr cursor_attr c.sel ;
-                    F.epr "@[<v>textedit_handler root:@ %a@]@."
-                      pp_node n ;
-                    F.epr "@[<v>textedit_handler cursor:@ %a@]@."
-                      pp_node c.sel ;
                     Lwt.return_none
                 | [] -> Lwt.return_some e )
           , n ) )
 
     let handler_of_node (n : node) : handler option =
-      F.epr "handler_of_node " ;
       search_forward n (fun n ->
           match n.t with `Attr (`Handler f, _) -> Some f | _ -> None )
 
@@ -1835,7 +1886,7 @@ module Panel = struct
                         (join_x
                            (Text.of_string "hello bitch")
                            (Text.of_string "!\n sup daddy") ) )*)
-                 (Text.of_string "test 1 2 3") ) ) )
+                 (Text.of_string "123") ) ) )
     (* ) *)
   end
 end