Greatly simplify the extensibility desing; pass config to handlers

src/PrintBox.ml

@@ -209,82 +209,7 @@ let mk_tree ?indent f root =
 
 let link ~uri inner : t = Link { uri; inner }
 let anchor ~id inner : t = Anchor { id; inner }
-let extension_to_key : ((ext -> bool) * string) list ref = ref []
-let extension_keys = Hashtbl.create 4
-
-let register_extension ~key ~domain =
-  if Hashtbl.mem extension_keys key then
-    invalid_arg @@ "PrintBox.register_extension: key " ^ key
-    ^ " is already registered";
-  Hashtbl.add extension_keys key domain;
-  extension_to_key := (domain, key) :: !extension_to_key
-
-let get_extension_key ext =
-  let rec loop = function
-    | [] -> invalid_arg "PrintBox.get_extension_key: unregistered extension"
-    | (domain, key) :: tl ->
-      if domain ext then
-        key
-      else
-        loop tl
-  in
-  loop !extension_to_key
-
-let extension ext = Ext { key = get_extension_key ext; ext }
-
-type ext_backend_result = ..
-type ext_backend_result += Unrecognized_extension | Same_as of t
-type ext += Embed_rendering of ext_backend_result
-
-let extension_backends = Hashtbl.create 3
-let embed_rendering result = Ext { key = ""; ext = Embed_rendering result }
-
-let register_extension_handler ~backend_name ~example ~handler =
-  if not @@ Hashtbl.mem extension_backends backend_name then
-    Hashtbl.add extension_backends backend_name (Hashtbl.create 4);
-  let handlers = Hashtbl.find extension_backends backend_name in
-  let key = get_extension_key example in
-  (match handler example ~nested:(fun _ -> Same_as Empty) with
-  | Unrecognized_extension ->
-    invalid_arg
-      "PrintBox.register_extension_handler: example outside of handler domain"
-  | _ -> ());
-  Hashtbl.add handlers key handler
-
-let get_extension_handler ~backend_name =
-  if not @@ Hashtbl.mem extension_backends backend_name then
-    Hashtbl.add extension_backends backend_name (Hashtbl.create 4);
-  let handlers = Hashtbl.find extension_backends backend_name in
-  fun ~key -> function
-    | Embed_rendering result -> fun ~nested:_ -> result
-    | ext -> Hashtbl.find handlers key ext
-
-let expand_extensions_same_as_only ~backend_name =
-  let get_handler = get_extension_handler ~backend_name in
-  let rec loop = function
-    | Empty -> Text { l = []; style = Style.default }
-    | Text _ as b -> b
-    | Frame { sub; stretch } -> Frame { sub = loop sub; stretch }
-    | Pad (p, b) -> Pad (p, loop b)
-    | Align { h; v; inner } -> Align { h; v; inner = loop inner }
-    | Grid (bars, grid) -> Grid (bars, map_matrix loop grid)
-    | Tree (indent, node, children) ->
-      Tree (indent, loop node, Array.map loop children)
-    | Link { uri; inner } -> Link { uri; inner = loop inner }
-    | Anchor { id; inner } -> Anchor { id; inner = loop inner }
-    | Ext { key; ext } ->
-      let nested b = Same_as (loop b) in
-      (match get_handler ~key ext ~nested with
-      | Same_as b -> b
-      | Unrecognized_extension ->
-        failwith
-        @@ "PrintBox.expand_extensions_same_as_only: unrecognized extension "
-        ^ key ^ " for backend " ^ backend_name
-      | _ ->
-        invalid_arg @@ "PrintBox.expand_extensions_same_as_only: extension "
-        ^ key ^ " is not `Same_as`-only for backend " ^ backend_name)
-  in
-  loop
+let extension ~key ext = Ext { key; ext }
 
 (** {2 Simple Structural Interface} *)
 

src/PrintBox.mli

@@ -327,9 +327,9 @@ val anchor : id:string -> t -> t
     @since 0.11
 *)
 
-val extension : ext -> t
-(** [extension ext] embeds an extended representation [ext] as a box. [ext] must be recognized
-    as a registered extension by one of the [domain] arguments passed to {!register_extension}.
+val extension : key:string -> ext -> t
+(** [extension ~key ext] embeds an extended representation [ext] as a box. [ext] must be
+    recognized by the used backends as an extension registered under [key].
     @since NEXT_RELEASE
 *)
 
@@ -356,56 +356,6 @@ val asprintf_with_style :
 (** Formatting for {!text}, with style.
     @since 0.3 *)
 
-(** {2 Managing Representation Extensions} *)
-
-val register_extension : key:string -> domain:(ext -> bool) -> unit
-(** Registers a new representation extension, where [key] is a unique identifier for
-    the scope of the extension values, and [domain] delineates that scope.
-    Intended for extension writers.
-    @since NEXT_RELEASE *)
-
-type ext_backend_result = ..
-(** The type packaging backend-dependent results of handling a representation extension. *)
-
-type ext_backend_result +=
-  | Unrecognized_extension  (** This is an error condition. *)
-  | Same_as of t
-        (** The result of rendering is the same as for the given box. *)
-
-type ext +=
-  | Embed_rendering of ext_backend_result
-        (** Lets extensions stage rendering by embedding partial results inside boxes. *)
-
-val embed_rendering : ext_backend_result -> t
-(** Embeds the given rendering result in a box. Only backends that can handle the result
-    will be able to render the returned box!
-    @since NEXT_RELEASE *)
-
-val register_extension_handler :
-  backend_name:string ->
-  example:ext ->
-  handler:(ext -> nested:(t -> ext_backend_result) -> ext_backend_result) ->
-  unit
-(** Registers a [handler] for the backend [backend_name] of extensions of the same domain
-    as [example]. Intended for extension writers.
-    @since NEXT_RELEASE *)
-
-val get_extension_handler :
-  backend_name:string ->
-  key:string ->
-  ext ->
-  nested:(t -> ext_backend_result) ->
-  ext_backend_result
-(** [get_extension_handler ~backend_name] returns a getter function for extension handlers.
-    Intended for backend writers.
-    @since NEXT_RELEASE *)
-
-val expand_extensions_same_as_only : backend_name:string -> t -> t
-(** [expand_extensions_same_as_only ~backend_name b] expands extensions in [b] for the backend,
-    as long as the backend's extension handlers (for extensions in [b]) only use
-    the [Same_as] variant of {!ext_backend_result}.
-    @since NEXT_RELEASE *)
-
 (** {2 Simple Structural Interface} *)
 
 type 'a ktree = unit -> [ `Nil | `Node of 'a * 'a ktree list ]

src/printbox-ext-plot/PrintBox_ext_plot.ml

@@ -46,10 +46,7 @@ let default_config =
 
 type PrintBox.ext += Plot of graph
 
-let () =
-  B.register_extension ~key:"plot" ~domain:(function
-    | Plot _ -> true
-    | _ -> false)
+let box graph = B.extension ~key:"Plot" (Plot graph)
 
 let plot_canvas ?canvas ?(size : (int * int) option) ?(sparse = false)
     (specs : plot_spec list) =
@@ -287,7 +284,6 @@ let plot ?(prec = 3) ?(no_axes = false) ?canvas ?size ?(x_label = "x")
         ];
       ]
 
-let example = Plot default_config
 let scale_size_for_text = ref (0.125, 0.05)
 
 let explode s =
@@ -344,23 +340,28 @@ let flatten_text_canvas ~num_specs canvas =
     (fun row -> String.concat "" @@ List.map snd @@ Array.to_list row)
     canvas
 
-let text_handler ext ~nested:_ =
+let text_based_handler ~render ext =
   match ext with
   | Plot { specs; x_label; y_label; size = sx, sy; no_axes; prec } ->
     let cx, cy = !scale_size_for_text in
     let size =
       Float.(to_int @@ (cx *. of_int sx), to_int @@ (cy *. of_int sy))
     in
-    B.Same_as
+    render
       (B.frame
       @@ plot ~prec ~no_axes ~size ~x_label ~y_label ~sparse:false
            (fun canvas ->
              B.lines @@ Array.to_list
              @@ flatten_text_canvas ~num_specs:(List.length specs) canvas)
            specs)
-  | _ -> B.Unrecognized_extension
+  | _ -> invalid_arg "PrintBox_ext_plot.text_handler: unrecognized extension"
+
+let text_handler = text_based_handler ~render:PrintBox_text.to_string
+
+let md_handler config =
+  text_based_handler ~render:(PrintBox_md.to_string config)
 
-let embed_canvas_html ~num_specs ~nested canvas =
+let embed_canvas_html ~num_specs canvas =
   let size_y = Array.length canvas in
   let size_x = Array.length canvas.(0) in
   let cells =
@@ -385,12 +386,7 @@ let embed_canvas_html ~num_specs ~nested canvas =
                         ";z-index:" ^ Int.to_string (num_specs - priority)
                       in
                       let cell =
-                        match nested cell with
-                        | PrintBox_html.Render_html html -> html
-                        | _ ->
-                          invalid_arg
-                            "PrintBox_ext_plot.embed_canvas_html: unrecognized \
-                             rendering backend"
+                        PrintBox_html.((to_html cell :> toplevel_html))
                       in
                       H.div
                         ~a:
@@ -413,21 +409,20 @@ let embed_canvas_html ~num_specs ~nested canvas =
              ^ Int.to_string size_x ^ ";height:" ^ Int.to_string size_y;
            ]
   in
-  B.embed_rendering @@ PrintBox_html.Render_html result
+  PrintBox_html.embed_html result
 
-let html_handler ext ~nested =
+let html_handler config ext =
   match ext with
   | Plot { specs; x_label; y_label; size; no_axes; prec } ->
-    B.Same_as
-      (B.frame
-      @@ plot ~prec ~no_axes ~size ~x_label ~y_label ~sparse:true
-           (embed_canvas_html ~num_specs:(List.length specs) ~nested)
-           specs)
-  | _ -> B.Unrecognized_extension
+    (PrintBox_html.to_html ~config
+       (B.frame
+       @@ plot ~prec ~no_axes ~size ~x_label ~y_label ~sparse:true
+            (embed_canvas_html ~num_specs:(List.length specs))
+            specs)
+      :> PrintBox_html.toplevel_html)
+  | _ -> invalid_arg "PrintBox_ext_plot.html_handler: unrecognized extension"
 
 let () =
-  B.register_extension_handler ~backend_name:"text" ~example
-    ~handler:text_handler;
-  B.register_extension_handler ~backend_name:"md" ~example ~handler:text_handler;
-  B.register_extension_handler ~backend_name:"html" ~example
-    ~handler:html_handler
+  PrintBox_text.register_extension ~key:"Plot" text_handler;
+  PrintBox_md.register_extension ~key:"Plot" md_handler;
+  PrintBox_html.register_extension ~key:"Plot" html_handler

src/printbox-ext-plot/PrintBox_ext_plot.mli

@@ -49,6 +49,9 @@ type PrintBox.ext +=
         (** PrintBox extension for plotting: scatterplots, linear graphs, decision boundaries...
             See {!graph} and {!plot_spec} for details. *)
 
+val box : graph -> PrintBox.t
+(** [box graph] is the same as [PrintBox.extension ~key:"Plot" (Plot graph)]. *)
+
 val concise_float : (prec:int -> float -> string) ref
 (** The conversion function for labeling axes. Defaults to [sprintf "%.*g"]. *)
 

src/printbox-html/PrintBox_html.ml

@@ -8,7 +8,7 @@ module H = Html
 
 type 'a html = 'a Html.elt
 type toplevel_html = Html_types.li_content_fun html
-type PrintBox.ext_backend_result += Render_html of toplevel_html
+type PrintBox.ext += Embed_html of toplevel_html
 
 let prelude =
   let l =
@@ -107,6 +107,16 @@ module Config = struct
   let tree_summary x c = { c with tree_summary = x }
 end
 
+let extensions : (string, Config.t -> PrintBox.ext -> toplevel_html) Hashtbl.t =
+  Hashtbl.create 4
+
+let register_extension ~key handler =
+  if Hashtbl.mem extensions key then
+    invalid_arg @@ "PrintBox_html.register_extension: already registered " ^ key;
+  Hashtbl.add extensions key handler
+
+let embed_html html = B.extension ~key:"Embed_html" (Embed_html html)
+
 let sep_spans sep l =
   let len = List.length l in
   List.concat
@@ -130,8 +140,6 @@ let br_lines ~bold l =
   @@ List.concat
   @@ List.map (String.split_on_char '\n') l
 
-let get_handler = PrintBox.get_extension_handler ~backend_name:"html"
-
 let to_html_rec ~config (b : B.t) =
   let open Config in
   let br_text_to_html ?(border = false) ~l ~style () =
@@ -264,14 +272,13 @@ let to_html_rec ~config (b : B.t) =
       | B.Empty -> H.a ~a:[ H.a_id id ] []
       | _ ->
         H.a ~a:[ H.a_id id; H.a_href @@ "#" ^ id ] [ to_html_nondet_rec inner ])
+    | B.Ext { key = _; ext = Embed_html result } -> result
     | B.Ext { key; ext } ->
-      let nested b = Render_html (to_html_rec b) in
-      (match get_handler ~key ext ~nested with
-      | PrintBox.Unrecognized_extension -> assert false
-      | PrintBox.Same_as b -> to_html_rec b
-      | Render_html result -> result
-      | _ ->
-        failwith "PrintBox_html.to_html: unrecognized extension handler result")
+      (match Hashtbl.find_opt extensions key with
+      | Some handler -> handler config ext
+      | None ->
+        failwith @@ "PrintBox_html.to_html: missing extension handler for "
+        ^ key)
     | _ -> loop to_html_rec b
   and to_html_nondet_rec b =
     match B.view b with

src/printbox-html/PrintBox_html.mli

@@ -6,7 +6,14 @@ open Tyxml
 
 type 'a html = 'a Html.elt
 type toplevel_html = Html_types.li_content_fun html
-type PrintBox.ext_backend_result += Render_html of toplevel_html
+
+type PrintBox.ext +=
+  | Embed_html of toplevel_html
+        (** Injects HTML into a box. It is handled natively by [PrintBox_html].
+            NOTE: this extension is unlikely to be supported by other backends! *)
+
+val embed_html : toplevel_html -> PrintBox.t
+(** Injects HTML into a box. NOTE: this is unlikely to be supported by other backends! *)
 
 val prelude : [> Html_types.style ] html
 (** HTML text to embed in the "<head>", defining the style for tables *)
@@ -36,6 +43,10 @@ module Config : sig
       using the [<detalis>] HTML5 element. *)
 end
 
+val register_extension :
+  key:string -> (Config.t -> PrintBox.ext -> toplevel_html) -> unit
+(** Add support for the extension with the given key to this rendering backend. *)
+
 val to_html : ?config:Config.t -> PrintBox.t -> [ `Div ] html
 (** HTML for one box *)