Separate commands for html generation of page+units and implementation

CHANGES.md

@@ -6,7 +6,7 @@
   `count-occurrences` flag and command to count occurrences of every identifiers
   (@panglesd, #976)
 - Separate compilation of interface and implementation files, using a new
-  `compile-src` command (@panglesd, #1067).
+  `compile-src` command (@panglesd, #1067, #1188).
 - Add clock emoji before `@since` tag (@yawaramin, #1089)
 - Navigation for the search bar : use '/' to enter search, up and down arrows to
   select a result, and enter to follow the selected link. (@EmileTrotignon, #1088)

src/document/ML.mli

@@ -21,8 +21,6 @@ val compilation_unit : Lang.Compilation_unit.t -> Types.Document.t
 val page : Lang.Page.t -> Types.Document.t
 (** Convert compilation unit or page models into a document *)
 
-val source_tree : Lang.SourceTree.t -> Types.Document.t list
-
 val implementation :
   Lang.Implementation.t ->
   Syntax_highlighter.infos ->

src/document/generator.ml

@@ -1748,8 +1748,6 @@ module Make (Syntax : SYNTAX) = struct
 
     val page : Lang.Page.t -> Document.t
 
-    val source_tree : Lang.SourceTree.t -> Document.t list
-
     val implementation :
       Lang.Implementation.t ->
       Syntax_highlighter.infos ->
@@ -1798,93 +1796,6 @@ module Make (Syntax : SYNTAX) = struct
       let source_anchor = None in
       Document.Page { Page.preamble; items; url; source_anchor }
 
-    let source_tree t =
-      let dir_pages = t.Odoc_model.Lang.SourceTree.source_children in
-      let open Paths.Identifier in
-      let module Set = Set.Make (SourceDir) in
-      let module M = Map.Make (SourceDir) in
-      (* mmap is a from a [SourceDir.t] to its [SourceDir.t] and [SourcePage.t]
-         children *)
-      let mmap =
-        let add parent f mmap =
-          let old_value =
-            try M.find parent mmap with Not_found -> (Set.empty, [])
-          in
-          M.add parent (f old_value) mmap
-        and add_file file (set, lp) = (set, file :: lp)
-        and add_dir dir (set, lp) = (Set.add dir set, lp) in
-        let rec dir_ancestors_add dir mmap =
-          match dir.iv with
-          | `SourceDir (parent, _) ->
-              let mmap = add parent (add_dir dir) mmap in
-              dir_ancestors_add parent mmap
-          | `Page _ -> mmap
-        in
-        let file_ancestors_add ({ iv = `SourcePage (parent, _); _ } as file)
-            mmap =
-          let mmap = add parent (add_file file) mmap in
-          dir_ancestors_add parent mmap
-        in
-        List.fold_left
-          (fun mmap file -> file_ancestors_add file mmap)
-          M.empty dir_pages
-      in
-      let page_of_dir (dir : SourceDir.t) (dir_children, file_children) =
-        let url = Url.Path.from_identifier dir in
-        let block ?(attr = []) desc = Block.{ attr; desc } in
-        let inline ?(attr = []) desc = Inline.[ { attr; desc } ] in
-        let header =
-          let title = inline (Text (name dir)) in
-          Item.Heading
-            Heading.{ label = None; level = 0; title; source_anchor = None }
-        in
-        let li ?(attr = []) name url =
-          let link url desc =
-            let content = [ Inline.{ attr = []; desc } ] and tooltip = None in
-            Inline.InternalLink
-              { InternalLink.target = Resolved url; content; tooltip }
-          in
-          [ block ~attr @@ Block.Inline (inline @@ link url (Text name)) ]
-        in
-        let li_of_child child =
-          match child with
-          | { iv = `Page _; _ } ->
-              assert false (* No [`Page] is child of a [`SourceDir] *)
-          | { iv = `SourceDir (_, name); _ } ->
-              let url = child |> Url.Path.from_identifier |> Url.from_path in
-              (name, url)
-        in
-        let li_of_file_child ({ iv = `SourcePage (_, name); _ } as child) =
-          let url = child |> Url.Path.from_identifier |> Url.from_path in
-          (name, url)
-        in
-        let items =
-          let text ?(attr = []) desc = Item.Text [ { attr; desc } ] in
-          let list l = Block.List (Block.Unordered, l) in
-          let list_of_children =
-            let dir_list =
-              Set.fold
-                (fun child acc -> li_of_child child :: acc)
-                dir_children []
-            and file_list =
-              List.map (fun child -> li_of_file_child child) file_children
-            in
-            let sort ?(attr = []) l =
-              l
-              |> List.sort (fun (n1, _) (n2, _) -> String.compare n1 n2)
-              |> List.map (fun (name, url) -> li ~attr name url)
-            in
-            sort ~attr:[ "odoc-directory" ] dir_list
-            @ sort ~attr:[ "odoc-file" ] file_list
-          in
-          header
-          :: [ text ~attr:[ "odoc-folder-list" ] @@ list list_of_children ]
-        in
-        Document.Page
-          { Types.Page.preamble = []; items; url; source_anchor = None }
-      in
-      M.fold (fun dir children acc -> page_of_dir dir children :: acc) mmap []
-
     let implementation (v : Odoc_model.Lang.Implementation.t) syntax_info
         source_code =
       match v.id with

src/document/generator_signatures.ml

@@ -106,8 +106,6 @@ module type GENERATOR = sig
 
   val page : Lang.Page.t -> Document.t
 
-  val source_tree : Lang.SourceTree.t -> Document.t list
-
   val implementation :
     Odoc_model.Lang.Implementation.t ->
     Syntax_highlighter.infos ->

src/document/reason.mli

@@ -21,8 +21,6 @@ val compilation_unit : Lang.Compilation_unit.t -> Types.Document.t
 val page : Lang.Page.t -> Types.Document.t
 (** Convert compilation unit or page models into a document *)
 
-val source_tree : Lang.SourceTree.t -> Types.Document.t list
-
 val implementation :
   Lang.Implementation.t ->
   Syntax_highlighter.infos ->

src/document/renderer.ml

@@ -30,9 +30,6 @@ type 'a t = {
 let document_of_page ~syntax v =
   match syntax with Reason -> Reason.page v | OCaml -> ML.page v
 
-let documents_of_source_tree ~syntax v =
-  match syntax with Reason -> Reason.source_tree v | OCaml -> ML.source_tree v
-
 let documents_of_implementation ~syntax v =
   match syntax with
   | Reason -> Reason.implementation v

src/document/url.ml

@@ -87,10 +87,7 @@ module Path = struct
     | Identifier.ClassSignature.t_pv ]
 
   type any_pv =
-    [ nonsrc_pv
-    | Identifier.SourcePage.t_pv
-    | Identifier.SourceDir.t_pv
-    | Identifier.AssetFile.t_pv ]
+    [ nonsrc_pv | Identifier.SourcePage.t_pv | Identifier.AssetFile.t_pv ]
 
   and any = any_pv Odoc_model.Paths.Identifier.id
 
@@ -179,10 +176,6 @@ module Path = struct
         let name = TypeName.to_string name in
         mk ~parent kind name
     | { iv = `Result p; _ } -> from_identifier (p :> any)
-    | { iv = `SourceDir (parent, name); _ } ->
-        let parent = from_identifier (parent :> any) in
-        let kind = `Page in
-        mk ~parent kind name
     | { iv = `SourcePage (parent, name); _ } ->
         let parent = from_identifier (parent :> any) in
         let kind = `SourcePage in
@@ -402,7 +395,7 @@ module Anchor = struct
     | { iv = `SourceLocationMod parent; _ } ->
         let page = Path.from_identifier (parent :> Path.any) in
         Ok { page; kind = `SourceAnchor; anchor = "" }
-    | { iv = `SourcePage _ | `SourceDir _; _ } as p ->
+    | { iv = `SourcePage _; _ } as p ->
         let page = Path.from_identifier (p :> Path.any) in
         Ok { page; kind = `Page; anchor = "" }
     | { iv = `AssetFile _; _ } as p ->

src/document/url.mli

@@ -34,7 +34,6 @@ module Path : sig
     | Identifier.Signature.t_pv
     | Identifier.ClassSignature.t_pv
     | Identifier.SourcePage.t_pv
-    | Identifier.SourceDir.t_pv
     | Identifier.AssetFile.t_pv ]
 
   and any = any_pv Odoc_model.Paths.Identifier.id

src/driver/compile.ml

@@ -236,7 +236,7 @@ let html_generate output_dir linked =
     match l.kind with
     | `Intf { hidden = true; _ } -> ()
     | `Impl { src_path; _ } ->
-        Odoc.html_generate ~search_uris:[] ~output_dir ~input_file
+        Odoc.html_generate_source ~search_uris:[] ~output_dir ~input_file
           ~source:src_path ();
         Atomic.incr Stats.stats.generated_units
     | _ ->

src/driver/odoc.ml

@@ -130,11 +130,8 @@ let compile_index ?(ignore_output = false) ~output_file ~json ~docs ~libs () =
       add_prefixed_output cmd link_output (Fpath.to_string output_file) lines)
 
 let html_generate ~output_dir ?index ?(ignore_output = false) ?(assets = [])
-    ?source ?(search_uris = []) ~input_file:file () =
+    ?(search_uris = []) ~input_file:file () =
   let open Cmd in
-  let source =
-    match source with None -> empty | Some source -> v "--source" % p source
-  in
   let index =
     match index with None -> empty | Some idx -> v "--index" % p idx
   in
@@ -147,15 +144,34 @@ let html_generate ~output_dir ?index ?(ignore_output = false) ?(assets = [])
       empty search_uris
   in
   let cmd =
-    !odoc % "html-generate" %% source % p file %% assets %% index %% search_uris
-    % "-o" % output_dir
+    !odoc % "html-generate" % p file %% assets %% index %% search_uris % "-o"
+    % output_dir
   in
   let desc = Printf.sprintf "Generating HTML for %s" (Fpath.to_string file) in
   let lines = Cmd_outputs.submit desc cmd None in
   if not ignore_output then
     Cmd_outputs.(
       add_prefixed_output cmd generate_output (Fpath.to_string file) lines)
 
+let html_generate_source ~output_dir ?(ignore_output = false) ~source
+    ?(search_uris = []) ~input_file:file () =
+  let open Cmd in
+  let file = v "--impl" % p file in
+  let search_uris =
+    List.fold_left
+      (fun acc filename -> acc % "--search-uri" % p filename)
+      empty search_uris
+  in
+  let cmd =
+    !odoc % "html-generate-impl" %% file % p source %% search_uris % "-o"
+    % output_dir
+  in
+  let desc = Printf.sprintf "Generating HTML for %s" (Fpath.to_string source) in
+  let lines = Cmd_outputs.submit desc cmd None in
+  if not ignore_output then
+    Cmd_outputs.(
+      add_prefixed_output cmd generate_output (Fpath.to_string source) lines)
+
 let support_files path =
   let open Cmd in
   let cmd = !odoc % "support-files" % "-o" % Fpath.to_string path in

src/driver/odoc.mli

@@ -49,11 +49,20 @@ val html_generate :
   ?index:Fpath.t ->
   ?ignore_output:bool ->
   ?assets:string list ->
-  ?source:Fpath.t ->
   ?search_uris:Fpath.t list ->
   input_file:Fpath.t ->
   unit ->
   unit
+
+val html_generate_source :
+  output_dir:string ->
+  ?ignore_output:bool ->
+  source:Fpath.t ->
+  ?search_uris:Fpath.t list ->
+  input_file:Fpath.t ->
+  unit ->
+  unit
+
 val support_files : Fpath.t -> string list
 
 val count_occurrences : Fpath.t -> string list

src/loader/implementation.ml

@@ -198,7 +198,6 @@ let anchor_of_identifier id =
     | `Module (parent, name) ->
         let anchor = anchor `Module (ModuleName.to_string name) in
         continue anchor parent
-    | `SourceDir _ -> assert false
     | `ModuleType (parent, name) ->
         let anchor = anchor `ModuleType (ModuleTypeName.to_string name) in
         continue anchor parent

src/model/lang.ml

@@ -559,16 +559,6 @@ module rec Index : sig
 end =
   Index
 
-module rec SourceTree : sig
-  type t = {
-    name : Identifier.Page.t;
-    root : Root.t;
-    source_children : Identifier.SourcePage.t list;
-    digest : Digest.t;
-  }
-end =
-  SourceTree
-
 module rec Asset : sig
   type t = { name : Identifier.AssetFile.t; root : Root.t }
 end =

src/model/paths.ml

@@ -53,9 +53,6 @@ module Identifier = struct
     | `InstanceVariable (_, name) -> InstanceVariableName.to_string name
     | `Label (_, name) -> LabelName.to_string name
     | `SourcePage (dir, name) -> name_aux (dir :> t) ^ name
-    | `SourceDir (({ iv = `SourceDir _; _ } as p), n) ->
-        name_aux (p :> t) ^ n ^ "/"
-    | `SourceDir (_, n) -> "./" ^ n ^ "/"
     | `SourceLocation (x, anchor) ->
         name_aux (x :> t) ^ "#" ^ DefName.to_string anchor
     | `SourceLocationMod x -> name_aux (x :> t)
@@ -87,7 +84,7 @@ module Identifier = struct
     | `Method (parent, _) -> is_hidden (parent :> t)
     | `InstanceVariable (parent, _) -> is_hidden (parent :> t)
     | `Label (parent, _) -> is_hidden (parent :> t)
-    | `SourceDir _ | `SourceLocationMod _ | `SourceLocation _ | `SourcePage _
+    | `SourceLocationMod _ | `SourceLocation _ | `SourcePage _
     | `SourceLocationInternal _ | `AssetFile _ ->
         false
 
@@ -136,7 +133,6 @@ module Identifier = struct
         InstanceVariableName.to_string name :: full_name_aux (parent :> t)
     | `Label (parent, name) ->
         LabelName.to_string name :: full_name_aux (parent :> t)
-    | `SourceDir (parent, name) -> name :: full_name_aux (parent :> t)
     | `SourceLocation (parent, name) ->
         DefName.to_string name :: full_name_aux (parent :> t)
     | `SourceLocationInternal (parent, name) ->
@@ -377,14 +373,6 @@ module Identifier = struct
     type t_pv = Paths_types.Identifier.non_src_pv
   end
 
-  module SourceDir = struct
-    type t = Id.source_dir
-    type t_pv = Id.source_dir_pv
-    let equal = equal
-    let hash = hash
-    let compare = compare
-  end
-
   module SourcePage = struct
     type t = Id.source_page
     type t_pv = Id.source_page_pv
@@ -501,27 +489,12 @@ module Identifier = struct
     let asset_file : Page.t * AssetName.t -> AssetFile.t =
       mk_parent AssetName.to_string "asset" (fun (p, n) -> `AssetFile (p, n))
 
-    let source_page (container_page, path) =
-      let rec source_dir dir =
-        match dir with
-        | [] -> (container_page : ContainerPage.t :> SourceDir.t)
-        | a :: q ->
-            let parent = source_dir q in
-            mk_parent
-              (fun k -> k)
-              "sd"
-              (fun (p, dir) -> `SourceDir (p, dir))
-              (parent, a)
-      in
-      match List.rev path with
-      | [] -> assert false
-      | file :: dir ->
-          let parent = source_dir dir in
-          mk_parent
-            (fun x -> x)
-            "sp"
-            (fun (p, rp) -> `SourcePage (p, rp))
-            (parent, file)
+    let source_page (container_page, name) =
+      mk_parent
+        (fun x -> x)
+        "sp"
+        (fun (p, rp) -> `SourcePage (p, rp))
+        (container_page, name)
 
     let root :
         ContainerPage.t option * ModuleName.t ->

src/model/paths.mli

@@ -67,9 +67,6 @@ module Identifier : sig
 
   module Type : IdSig with type t = Id.type_ and type t_pv = Id.type_pv
 
-  module SourceDir :
-    IdSig with type t = Id.source_dir and type t_pv = Id.source_dir_pv
-
   module Class : IdSig with type t = Id.class_ and type t_pv = Id.class_pv
 
   module ClassType :
@@ -251,7 +248,7 @@ module Identifier : sig
       ContainerPage.t option * PageName.t ->
       [> `LeafPage of ContainerPage.t option * PageName.t ] id
 
-    val source_page : ContainerPage.t * string list -> SourcePage.t
+    val source_page : ContainerPage.t * string -> SourcePage.t
 
     val asset_file : Page.t * AssetName.t -> AssetFile.t