Flat files

commits-to-take

@@ -0,0 +1,2 @@
+bea122919d799 d6ef4ca0f0a2cf6d74
+59d171ed

src/document/renderer.ml

@@ -17,11 +17,7 @@ let traverse ~f t =
   in
   aux t
 
-type 'a t = {
-  name : string;
-  render : 'a -> Types.Page.t -> page;
-  files_of_url : Url.Path.t -> Fpath.t list;
-}
+type 'a t = { name : string; render : 'a -> Types.Page.t -> page }
 
 let document_of_page ~syntax v =
   match syntax with Reason -> Reason.page v | OCaml -> ML.page v

src/html/generator.ml

@@ -370,27 +370,30 @@ module Page = struct
         | `Closed | `Open | `Default -> None
         | `Inline -> Some 0)
 
-  let rec include_ ?theme_uri indent { Subpage.content; _ } =
-    [ page ?theme_uri indent content ]
+  let rec include_ ?theme_uri extra_suffix indent { Subpage.content; _ } =
+    [ page ?theme_uri extra_suffix indent content ]
 
-  and subpages ?theme_uri indent i =
-    Utils.list_concat_map ~f:(include_ ?theme_uri indent)
+  and subpages ?theme_uri extra_suffix indent i =
+    Utils.list_concat_map ~f:(include_ ?theme_uri extra_suffix indent)
     @@ Doctree.Subpages.compute i
 
-  and page ?theme_uri indent ({ Page.title; header; items = i; url } as p) =
+  and page ?theme_uri ?support_uri extra_suffix indent
+      ({ Page.title; header; items = i; url } as p) =
     let resolve = Link.Current url in
     let i = Doctree.Shift.compute ~on_sub i in
     let toc = Toc.from_items ~resolve ~path:url i in
-    let subpages = subpages ?theme_uri indent p in
+    let subpages = subpages ?theme_uri extra_suffix indent p in
     let header = items ~resolve header in
     let content = (items ~resolve i :> any Html.elt list) in
     let page =
-      Tree.make ?theme_uri ~indent ~header ~toc ~url title content subpages
+      Tree.make ?theme_uri ?support_uri ~indent ~header ~toc ~url ~extra_suffix
+        title content subpages
     in
     page
 end
 
-let render ?theme_uri ~indent page = Page.page ?theme_uri indent page
+let render ?theme_uri ?support_uri ~indent ~extra_suffix page =
+  Page.page ?theme_uri ?support_uri extra_suffix indent page
 
 let doc ~xref_base_uri b =
   let resolve = Link.Base xref_base_uri in

src/html/generator.mli

@@ -1,6 +1,12 @@
 open Odoc_document
 
-val render : ?theme_uri:Tree.uri -> indent:bool -> Types.Page.t -> Renderer.page
+val render :
+  ?theme_uri:Tree.uri ->
+  ?support_uri:Tree.uri ->
+  indent:bool ->
+  extra_suffix:string ->
+  Types.Page.t ->
+  Renderer.page
 
 val doc :
   xref_base_uri:string ->

src/html/link.ml

@@ -1,5 +1,7 @@
 module Url = Odoc_document.Url
 
+let flat = ref true
+
 (* Translation from Url.Path *)
 module Path = struct
   let to_list url =
@@ -10,23 +12,43 @@ module Path = struct
     in
     loop [] url
 
+  let of_list l =
+    let rec inner parent = function
+      | [] -> parent
+      | (kind, name) :: xs -> inner (Some { Url.Path.parent; name; kind }) xs
+    in
+    inner None l
+
   let for_printing url = List.map snd @@ to_list url
 
   let segment_to_string (kind, name) =
     match kind with
     | "module" | "container-page" -> name
     | _ -> Printf.sprintf "%s-%s" kind name
 
-  let is_leaf_page url = url.Url.Path.kind = "page"
+  let is_leaf_page url =
+    url.Url.Path.kind = "page" || url.Url.Path.kind = "file"
 
   let rec get_dir { Url.Path.parent; name; kind } =
-    let ppath = match parent with Some p -> get_dir p | None -> [] in
-    match kind with
-    | "page" -> ppath
-    | _ -> ppath @ [ segment_to_string (kind, name) ]
+    if !flat then []
+    else
+      let ppath = match parent with Some p -> get_dir p | None -> [] in
+      match kind with
+      | "page" | "file" -> ppath
+      | _ -> ppath @ [ segment_to_string (kind, name) ]
 
   let get_file : Url.Path.t -> string =
-   fun t -> match t.kind with "page" -> t.name ^ ".html" | _ -> "index.html"
+   fun t ->
+    if !flat then
+      match t.kind with
+      | "file" -> t.name
+      | _ ->
+          String.concat "-" (List.map segment_to_string (to_list t)) ^ ".html"
+    else
+      match t.kind with
+      | "page" -> t.name ^ ".html"
+      | "file" -> t.name
+      | _ -> "index.html"
 
   let for_linking : Url.Path.t -> string list =
    fun url -> get_dir url @ [ get_file url ]

src/html/link.mli

@@ -2,6 +2,8 @@
 
 module Url = Odoc_document.Url
 
+val flat : bool ref
+
 val semantic_uris : bool ref
 (** Whether to generate pretty/semantics links or not. *)
 
@@ -10,6 +12,10 @@ type resolve = Current of Url.Path.t | Base of string
 val href : resolve:resolve -> Url.t -> string
 
 module Path : sig
+  val to_list : Url.Path.t -> (string * string) list
+
+  val of_list : (string * string) list -> Url.Path.t option
+
   val is_leaf_page : Url.Path.t -> bool
 
   val for_printing : Url.Path.t -> string list

src/html/tree.ml

@@ -16,43 +16,28 @@
 
 module Html = Tyxml.Html
 
-type uri = Absolute of string | Relative of string
+type uri = Absolute of string | Relative of Odoc_document.Url.Path.t option
 
-let page_creator ?(theme_uri = Relative "./") ~url name header toc content =
-  let is_leaf_page = Link.Path.is_leaf_page url in
+let page_creator ?(theme_uri = Relative None) ?(support_uri = Relative None)
+    ~url name header toc content =
   let path = Link.Path.for_printing url in
-  let rec add_dotdot ~n acc =
-    if n <= 0 then acc else add_dotdot ~n:(n - 1) ("../" ^ acc)
-  in
-  let resolve_relative_uri uri =
-    (* Remove the first "dot segment". *)
-    let uri =
-      if String.length uri >= 2 && String.sub uri 0 2 = "./" then
-        String.sub uri 2 (String.length uri - 2)
-      else uri
-    in
-    (* How deep is this page? *)
-    let n =
-      List.length path
-      - if (* This is just horrible. *)
-           is_leaf_page then 1 else 0
-    in
-    add_dotdot uri ~n
-  in
 
   let head : Html_types.head Html.elt =
     let title_string = Printf.sprintf "%s (%s)" name (String.concat "." path) in
 
-    let theme_uri =
-      match theme_uri with
-      | Absolute uri -> uri
-      | Relative uri -> resolve_relative_uri uri
+    let file_uri base file =
+      match base with
+      | Absolute uri -> uri ^ "/" ^ file
+      | Relative uri ->
+          let page =
+            Odoc_document.Url.Path.{ kind = "file"; parent = uri; name = file }
+          in
+          Link.href ~resolve:(Current url)
+            Odoc_document.Url.Anchor.{ page; anchor = ""; kind = "file" }
     in
 
-    let support_files_uri = resolve_relative_uri "./" in
-
-    let odoc_css_uri = theme_uri ^ "odoc.css" in
-    let highlight_js_uri = support_files_uri ^ "highlight.pack.js" in
+    let odoc_css_uri = file_uri theme_uri "odoc.css" in
+    let highlight_js_uri = file_uri support_uri "highlight.pack.js" in
 
     Html.head
       (Html.title (Html.txt title_string))
@@ -75,33 +60,43 @@ let page_creator ?(theme_uri = Relative "./") ~url name header toc content =
   in
 
   let breadcrumbs =
-    let dot = if !Link.semantic_uris then "" else "index.html" in
-    let dotdot = add_dotdot ~n:1 dot in
-    let up_href = if is_leaf_page && name <> "index" then dot else dotdot in
-    let has_parent = List.length path > 1 in
+    let rec get_parents x =
+      match x with
+      | [] -> []
+      | x :: xs -> (
+          match Link.Path.of_list (List.rev (x :: xs)) with
+          | Some x -> x :: get_parents xs
+          | None -> get_parents xs)
+    in
+    let parents = get_parents (List.rev (Link.Path.to_list url)) |> List.rev in
+    let has_parent = List.length parents > 1 in
+    let href page =
+      Link.href ~resolve:(Current url)
+        Odoc_document.Url.Anchor.{ page; anchor = ""; kind = "" }
+    in
     if has_parent then
+      let up_url = List.hd (List.tl (List.rev parents)) in
       let l =
         [
-          Html.a ~a:[ Html.a_href up_href ] [ Html.txt "Up" ]; Html.txt " – ";
+          Html.a ~a:[ Html.a_href (href up_url) ] [ Html.txt "Up" ];
+          Html.txt " – ";
         ]
         @
         (* Create breadcrumbs *)
         let space = Html.txt " " in
-        let breadcrumb_spec =
-          if is_leaf_page then fun n x -> (n, dot, x)
-          else fun n x -> (n, add_dotdot ~n dot, x)
-        in
-        let rev_path =
-          if is_leaf_page && name = "index" then List.tl (List.rev path)
-          else List.rev path
-        in
-        rev_path |> List.mapi breadcrumb_spec |> List.rev
+        parents
         |> Utils.list_concat_map
              ?sep:(Some [ space; Html.entity "#x00BB"; space ])
-             ~f:(fun (n, addr, lbl) ->
-               if n > 0 then
-                 [ [ Html.a ~a:[ Html.a_href addr ] [ Html.txt lbl ] ] ]
-               else [ [ Html.txt lbl ] ])
+             ~f:(fun url' ->
+               [
+                 [
+                   (if url = url' then Html.txt url.name
+                   else
+                     Html.a
+                       ~a:[ Html.a_href (href url') ]
+                       [ Html.txt url'.name ]);
+                 ];
+               ])
         |> List.flatten
       in
       [ Html.nav ~a:[ Html.a_class [ "odoc-nav" ] ] l ]
@@ -116,9 +111,12 @@ let page_creator ?(theme_uri = Relative "./") ~url name header toc content =
   in
   Html.html head (Html.body ~a:[ Html.a_class [ "odoc" ] ] body)
 
-let make ?theme_uri ~indent ~url ~header ~toc title content children =
-  let filename = Link.Path.as_filename url in
-  let html = page_creator ?theme_uri ~url title header toc content in
+let make ?theme_uri ?support_uri ~indent ~url ~header ~extra_suffix ~toc title
+    content children =
+  let filename = Fpath.add_ext extra_suffix (Link.Path.as_filename url) in
+  let html =
+    page_creator ?theme_uri ?support_uri ~url title header toc content
+  in
   let content ppf = (Html.pp ~indent ()) ppf html in
   { Odoc_document.Renderer.filename; content; children }
 

src/html/tree.mli

@@ -21,17 +21,19 @@ module Html = Tyxml.Html
 
 type uri =
   | Absolute of string
-  | Relative of string
+  | Relative of Odoc_document.Url.Path.t option
       (** The type for absolute and relative URIs. The relative URIs are resolved
     using the HTML output directory as a target. *)
 
 (** {1 Page creator} *)
 
 val make :
   ?theme_uri:uri ->
+  ?support_uri:uri ->
   indent:bool ->
   url:Url.Path.t ->
   header:Html_types.flow5_without_header_footer Html.elt list ->
+  extra_suffix:string ->
   toc:Html_types.flow5 Html.elt list ->
   string ->
   Html_types.div_content Html.elt list ->

src/latex/generator.ml

@@ -46,25 +46,27 @@ module Link = struct
         | "container-page" -> Fpath.(pdir / url.name)
         | _ -> pdir)
 
-  let file url =
+  let file ~flat url =
     let rec l (url : Odoc_document.Url.Path.t) acc =
       match url.kind with
-      | "container-page" -> acc
+      | "container-page" when not flat -> acc
       | _ -> (
           match url.parent with
           | None ->
-              assert false
-              (* Only container-pages are allowed to have no parent *)
+              (* Only container-pages are allowed to have no parent, so we must be in flat mode *)
+              assert flat;
+              url.name :: acc
           | Some p -> l p (url.name :: acc))
     in
-    String.concat "." (l url [])
-
-  let filename url =
-    let dir = dir url in
-    let file = file url in
-    Format.eprintf "dir=%a file=%s\n%!" Fpath.pp dir file;
-    if file = "" then Fpath.add_ext "tex" dir
-    else Fpath.(add_ext "tex" (dir / file))
+    let result = l url [] in
+    String.concat "." result
+
+  let filename ~flat url =
+    let file = file ~flat url |> Fpath.v in
+    if flat then Fpath.add_ext "tex" file
+    else
+      let dir = dir url in
+      Fpath.(dir // file |> Fpath.add_ext "tex")
 end
 
 let style = function
@@ -438,8 +440,8 @@ module Doc = struct
     in
     Fmt.list input_child ppf children
 
-  let make ~with_children url content children =
-    let filename = Link.filename url in
+  let make ~with_children ~flat ~extra_suffix url content children =
+    let filename = Link.filename ~flat url |> Fpath.add_ext extra_suffix in
     let label = Label (Link.page url) in
     let content =
       match content with
@@ -457,25 +459,27 @@ end
 module Page = struct
   let on_sub = function `Page _ -> Some 1 | `Include _ -> None
 
-  let rec subpage ~with_children (p : Subpage.t) =
+  let rec subpage ~with_children ~flat ~extra_suffix (p : Subpage.t) =
     if Link.should_inline p.status p.content.url then []
-    else [ page ~with_children p.content ]
+    else [ page ~with_children ~flat ~extra_suffix p.content ]
 
-  and subpages ~with_children i =
+  and subpages ~with_children ~flat ~extra_suffix i =
     List.flatten
-    @@ List.map (subpage ~with_children)
+    @@ List.map (subpage ~with_children ~flat ~extra_suffix)
     @@ Doctree.Subpages.compute i
 
-  and page ~with_children ({ Page.title = _; header; items = i; url } as p) =
+  and page ~with_children ~flat ~extra_suffix
+      ({ Page.title = _; header; items = i; url } as p) =
     let i = Doctree.Shift.compute ~on_sub i in
-    let subpages = subpages ~with_children p in
+    let subpages = subpages ~with_children ~flat ~extra_suffix p in
     let header = items header in
     let content = items i in
-    let page = Doc.make ~with_children url (header @ content) subpages in
+    let page =
+      Doc.make ~with_children ~flat ~extra_suffix url (header @ content)
+        subpages
+    in
     page
 end
 
-let render ~with_children page = Page.page ~with_children page
-
-let files_of_url url =
-  if Link.is_class_or_module_path url then [ Link.filename url ] else []
+let render ~with_children ~flat ~extra_suffix page =
+  Page.page ~with_children ~flat ~extra_suffix page