Remove document/Utils in favor of Odoc_utils

Remove list operations that were not needed and move skip_until and
split_at into Odoc_utils.

Document related utils could be moved to Codefmt.

This makes the code more consistent regarding List and String
manipulations.

Author: Julow

src/document/codefmt.ml

@@ -42,6 +42,27 @@ module State = struct
       flush state)
 end
 
+let rec compute_length_source (t : Types.Source.t) : int =
+  let f (acc : int) = function
+    | Types.Source.Elt t -> acc + compute_length_inline t
+    | Types.Source.Tag (_, t) -> acc + compute_length_source t
+  in
+  List.fold_left f 0 t
+
+and compute_length_inline (t : Types.Inline.t) : int =
+  let f (acc : int) { Types.Inline.desc; _ } =
+    match desc with
+    | Text s -> acc + String.length s
+    | Entity _e -> acc + 1
+    | Linebreak -> 0 (* TODO *)
+    | Styled (_, t) | Link { content = t; _ } -> acc + compute_length_inline t
+    | Source s -> acc + compute_length_source s
+    | Math _ -> assert false
+    | Raw_markup _ -> assert false
+    (* TODO *)
+  in
+  List.fold_left f 0 t
+
 (** Modern implementation using semantic tags, Only for 4.08+ *)
 
 (*
@@ -79,7 +100,7 @@ module Tag = struct
 
   let elt ppf elt =
     Format.pp_open_stag ppf (Elt elt);
-    Format.pp_print_as ppf (Utils.compute_length_inline elt) "";
+    Format.pp_print_as ppf (compute_length_inline elt) "";
     Format.pp_close_stag ppf ()
 
   let ignore ppf txt =
@@ -140,7 +161,7 @@ module Tag = struct
 
   let elt ppf (elt : Inline.t) =
     Format.fprintf ppf "@{<tag:%s>%t@}" (Marshal.to_string elt []) (fun fmt ->
-        Format.pp_print_as fmt (Utils.compute_length_inline elt) "")
+        Format.pp_print_as fmt (compute_length_inline elt) "")
 
   let ignore ppf txt = Format.fprintf ppf "@{<ignore-tag>%t@}" txt
 end

src/document/comment.ml

@@ -14,6 +14,7 @@
  * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  *)
 
+open Odoc_utils
 open Types
 module Comment = Odoc_model.Comment
 open Odoc_model.Names
@@ -67,7 +68,7 @@ module Reference = struct
       | `TAbsolutePath -> "/"
       | `TCurrentPackage -> "//"
     in
-    tag ^ String.concat "/" cs
+    tag ^ String.concat ~sep:"/" cs
 
   let rec render_unresolved : Reference.t -> string =
     let open Reference in
@@ -412,11 +413,11 @@ let synopsis ~decl_doc ~expansion_doc =
   match Comment.synopsis docs with Some p -> [ paragraph p ] | None -> []
 
 let standalone docs =
-  Utils.flatmap ~f:item_element
+  List.concat_map item_element
   @@ List.map (fun x -> x.Odoc_model.Location_.value) docs
 
 let to_ir (docs : Comment.elements) =
-  Utils.flatmap ~f:block_element
+  List.concat_map block_element
   @@ List.map (fun x -> x.Odoc_model.Location_.value) docs
 
 let has_doc docs = docs <> []

src/document/doctree.ml

@@ -1,3 +1,4 @@
+open Odoc_utils
 open Types
 
 module Take = struct
@@ -97,19 +98,23 @@ module Subpages : sig
   val compute : Page.t -> Subpage.t list
 end = struct
   let rec walk_documentedsrc (l : DocumentedSrc.t) =
-    Utils.flatmap l ~f:(function
-      | DocumentedSrc.Code _ -> []
-      | Documented _ -> []
-      | Nested { code; _ } -> walk_documentedsrc code
-      | Subpage p -> [ p ]
-      | Alternative (Expansion r) -> walk_documentedsrc r.expansion)
+    List.concat_map
+      (function
+        | DocumentedSrc.Code _ -> []
+        | Documented _ -> []
+        | Nested { code; _ } -> walk_documentedsrc code
+        | Subpage p -> [ p ]
+        | Alternative (Expansion r) -> walk_documentedsrc r.expansion)
+      l
 
   let rec walk_items (l : Item.t list) =
-    Utils.flatmap l ~f:(function
-      | Item.Text _ -> []
-      | Heading _ -> []
-      | Declaration { content; _ } -> walk_documentedsrc content
-      | Include i -> walk_items i.content.content)
+    List.concat_map
+      (function
+        | Item.Text _ -> []
+        | Heading _ -> []
+        | Declaration { content; _ } -> walk_documentedsrc content
+        | Include i -> walk_items i.content.content)
+      l
 
   let compute (p : Page.t) = walk_items (p.preamble @ p.items)
 end

src/document/generator.ml

@@ -14,6 +14,7 @@
  * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  *)
 
+open Odoc_utils
 open Odoc_model.Names
 module Location = Odoc_model.Location_
 module Paths = Odoc_model.Paths
@@ -76,7 +77,7 @@ let mk_heading ?(level = 1) ?label text =
     rest is inserted into [items]. *)
 let prepare_preamble comment items =
   let preamble, first_comment =
-    Utils.split_at
+    List.split_at
       ~f:(function
         | { Odoc_model.Location_.value = `Heading _; _ } -> true | _ -> false)
       comment
@@ -213,7 +214,7 @@ module Make (Syntax : SYNTAX) = struct
         let in_bound x = min (max x 0) (String.length src) in
         let a = in_bound a and b = in_bound b in
         let a, b = (min a b, max a b) in
-        String.sub src a (b - a)
+        String.with_range src ~first:a ~len:(b - a)
       in
       let plain_code = function
         | "" -> []
@@ -358,7 +359,7 @@ module Make (Syntax : SYNTAX) = struct
            | Open -> O.txt "[> " ++ elements ++ O.txt " ]"
            | Closed [] -> O.txt "[< " ++ elements ++ O.txt " ]"
            | Closed lst ->
-               let constrs = String.concat " " lst in
+               let constrs = String.concat ~sep:" " lst in
                O.txt "[< " ++ elements ++ O.txt (" " ^ constrs ^ " ]"))
 
     and te_object (t : Odoc_model.Lang.TypeExpr.Object.t) =
@@ -461,7 +462,7 @@ module Make (Syntax : SYNTAX) = struct
           format_type_path ~delim:`brackets args
             (Link.from_path (path :> Paths.Path.t))
       | Poly (polyvars, t) ->
-          O.txt ("'" ^ String.concat " '" polyvars ^ ". ") ++ type_expr t
+          O.txt ("'" ^ String.concat ~sep:" '" polyvars ^ ". ") ++ type_expr t
       | Package pkg ->
           enclose ~l:"(" ~r:")"
             (O.keyword "module" ++ O.txt " "
@@ -747,7 +748,7 @@ module Make (Syntax : SYNTAX) = struct
         | Closed [] ->
             (O.documentedSrc (O.txt "[< "), O.documentedSrc (O.txt " ]"))
         | Closed lst ->
-            let constrs = String.concat " " lst in
+            let constrs = String.concat ~sep:" " lst in
             ( O.documentedSrc (O.txt "[< "),
               O.documentedSrc (O.txt (" " ^ constrs ^ " ]")) )
       in
@@ -773,14 +774,14 @@ module Make (Syntax : SYNTAX) = struct
           | Some Odoc_model.Lang.TypeDecl.Neg -> "-" :: desc
         in
         let final = if injectivity then "!" :: var_desc else var_desc in
-        String.concat "" final
+        String.concat ~sep:"" final
       in
       O.txt
         (match params with
         | [] -> ""
         | [ x ] -> format_param x |> Syntax.Type.handle_format_params
         | lst -> (
-            let params = String.concat ", " (List.map format_param lst) in
+            let params = String.concat ~sep:", " (List.map format_param lst) in
             (match delim with `parens -> "(" | `brackets -> "[")
             ^ params
             ^ match delim with `parens -> ")" | `brackets -> "]"))
@@ -1077,7 +1078,7 @@ module Make (Syntax : SYNTAX) = struct
             | Constraint cst -> continue @@ constraint_ cst
             | Comment `Stop ->
                 let rest =
-                  Utils.skip_until rest ~p:(function
+                  List.skip_until rest ~p:(function
                     | Lang.ClassSignature.Comment `Stop -> true
                     | _ -> false)
                 in
@@ -1268,7 +1269,7 @@ module Make (Syntax : SYNTAX) = struct
                 loop rest (List.rev_append items acc_items)
             | Comment `Stop ->
                 let rest =
-                  Utils.skip_until rest ~p:(function
+                  List.skip_until rest ~p:(function
                     | Lang.Signature.Comment `Stop -> true
                     | _ -> false)
                 in
@@ -1376,18 +1377,19 @@ module Make (Syntax : SYNTAX) = struct
       | Some params, sg ->
           let sg_doc, content = signature sg in
           let params =
-            Utils.flatmap params ~f:(fun arg ->
-                let content = functor_parameter arg in
-                let attr = [ "parameter" ] in
-                let anchor =
-                  Some
-                    (Url.Anchor.from_identifier (arg.id :> Paths.Identifier.t))
-                in
-                let doc = [] in
-                [
-                  Item.Declaration
-                    { content; anchor; attr; doc; source_anchor = None };
-                ])
+            let decl_of_arg arg =
+              let content = functor_parameter arg in
+              let attr = [ "parameter" ] in
+              let anchor =
+                Some (Url.Anchor.from_identifier (arg.id :> Paths.Identifier.t))
+              in
+              let doc = [] in
+              [
+                Item.Declaration
+                  { content; anchor; attr; doc; source_anchor = None };
+              ]
+            in
+            List.concat_map decl_of_arg params
           in
           let prelude = mk_heading ~label:"parameters" "Parameters" :: params
           and content = mk_heading ~label:"signature" "Signature" :: content in

src/document/utils.ml

@@ -1,3 +1,4 @@
+open Odoc_utils
 module ManLink = Link
 open Odoc_document
 open Types
@@ -299,7 +300,7 @@ and inline (l : Inline.t) =
               | { Inline.desc = Text s; _ } -> Accum [ s ]
               | _ -> Stop_and_keep)
           in
-          str {|%s|} (String.concat "" l) ++ inline rest
+          str {|%s|} (String.concat ~sep:"" l) ++ inline rest
       | Entity e ->
           let x = entity e in
           x ++ inline rest
@@ -343,7 +344,7 @@ let table pp { Table.data; align } =
               | Default -> "l")
             align
     in
-    Align_line (String.concat "" alignment)
+    Align_line (String.concat ~sep:"" alignment)
   in
   env "TS" "TE" ""
     (str "allbox;" ++ alignment
@@ -408,7 +409,7 @@ let next_heading, reset_heading =
     | 1, n :: _ -> [ n + 1 ]
     | i, n :: t -> n :: succ_heading (i - 1) t
   in
-  let print_heading l = String.concat "." @@ List.map string_of_int l in
+  let print_heading l = String.concat ~sep:"." @@ List.map string_of_int l in
   let next level =
     let new_heading = succ_heading level !heading_stack in
     heading_stack := new_heading;
@@ -547,7 +548,7 @@ let page p =
   let i = Shift.compute ~on_sub p.items in
   macro "TH" {|%s 3 "" "Odoc" "OCaml Library"|} p.url.name
   ++ macro "SH" "Name"
-  ++ str "%s" (String.concat "." @@ Link.for_printing p.url)
+  ++ str "%s" (String.concat ~sep:"." @@ Link.for_printing p.url)
   ++ macro "SH" "Synopsis" ++ vspace ++ item ~nested:false header
   ++ macro "SH" "Documentation" ++ vspace ++ macro "nf" ""
   ++ item ~nested:false i
@@ -558,7 +559,7 @@ let rec subpage subp =
 
 and render_page (p : Page.t) =
   let p = Doctree.Labels.disambiguate_page ~enter_subpages:true p
-  and children = Utils.flatmap ~f:subpage @@ Subpages.compute p in
+  and children = List.concat_map subpage (Subpages.compute p) in
   let content ppf = Format.fprintf ppf "%a@." Roff.pp (page p) in
   let filename = Link.as_filename p.url in
   { Renderer.filename; content; children; path = p.url }

src/document/utils.mli

@@ -32,3 +32,15 @@ let rec find_map f = function
 
 (* Since 5.1 *)
 let is_empty = function [] -> true | _ :: _ -> false
+
+let rec skip_until ~p = function
+  | [] -> []
+  | h :: t -> if p h then t else skip_until ~p t
+
+let split_at ~f lst =
+  let rec loop acc = function
+    | hd :: _ as rest when f hd -> (List.rev acc, rest)
+    | [] -> (List.rev acc, [])
+    | hd :: tl -> loop (hd :: acc) tl
+  in
+  loop [] lst