Something went wrong. Try again.
Odoc docs forked from jon.recoil.org/odd
Something went wrong. Try again.
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197(* Print the documentation of an item named by an odoc reference, as Markdown.
The resolution and loading is {!Refs}; this module is the rendering on top: given the located item (or the whole module/page), turn it into Markdown via odoc's document model and the markdown backend. *)
module Url = Odoc_document.Url
let config = Odoc_markdown.Config.make ~root_url:None ~allow_html:false ()
(* A single leaf item's doc comment, on its own. *)let render_docs (docs : Odoc_model.Comment.docs) = let blocks = Odoc_document.Comment.standalone docs.elements |> Odoc_markdown.Generator.items ~config ~resolve:(Odoc_markdown.Link.Base "") in Odoc_markdown.Renderer.to_string (Odoc_markdown.Renderer.Block.Blocks blocks)
let render_page_content (p : Odoc_document.Renderer.page) = let b = Buffer.create 4096 in let fmt = Format.formatter_of_buffer b in p.content fmt; Format.pp_print_flush fmt (); Buffer.contents b
(* Render a document to its tree of Markdown pages, then return the content of the page whose path is [target]. A compilation unit becomes its own page plus a child page per nested module/class, so this picks out the referenced module's full page (not just its top-comment); a doc page becomes a single page. *)let render_document doc target = let pages = Odoc_markdown.Generator.render ~config doc in let same a b = Url.Path.to_list a = Url.Path.to_list b in let rec find pages = List.find_map (fun (p : Odoc_document.Renderer.page) -> if same p.path target then Some p else find p.children) pages in Option.map render_page_content (find pages)
let render_module_page cu target = render_document (Odoc_document.Renderer.document_of_compilation_unit ~syntax:Odoc_document.Renderer.OCaml cu) target
let render_doc_page page target = render_document (Odoc_document.Renderer.document_of_page ~syntax:Odoc_document.Renderer.OCaml page) target
(* A module's own declaration is frequently undocumented, the prose living in the top-comment of its signature instead (the [(** ... *)] just inside [sig]). Prefer the attached doc, fall back to that top-comment. *)let doc_of : Refs.located -> Odoc_model.Comment.docs = function | Lmodule (doc, sg) -> if doc.elements <> [] then doc else ( match sg with Some sg -> sg.Refs.Lang.Signature.doc | None -> doc) | Lclass (doc, _) | Ltype (doc, _) | Lleaf doc -> doc
(* The leaf-item fallback: just the doc comment. *)let docstring_of ref_str id cu = match Option.map doc_of (Refs.find id cu) with | None | Some { elements = []; _ } -> Error (`Msg (Printf.sprintf "no documentation found for %s" ref_str)) | Some docs -> Ok (render_docs docs)
(* The package and library an item lives in, from its URL path. odoc lays the path out as <pkg>/<lib>/<Module>/...; the package is the first component and the library is the page directly before the first module component (a doc page has no module component, hence no library). *)let provenance url = let comps = Url.Path.to_list url.Url.Anchor.page in let is_code = function | `Module | `ModuleType | `Parameter _ | `Class | `ClassType -> true | _ -> false in match comps with | [] -> None | (_, pkg) :: rest -> let rec lib_before prev = function | (k, _) :: _ when is_code k -> prev | (_, n) :: tl -> lib_before (Some n) tl | [] -> None in Some (pkg, lib_before None rest)
(* A one-line header naming the item and where it comes from, prepended to every rendering — e.g. [**Stdlib.List.map** — *stdlib (ocaml-compiler)*]. *)let header id url = let name = String.concat "." (Refs.Id.fullname id) in match provenance url with | Some (pkg, Some lib) when lib <> pkg -> Printf.sprintf "**%s** — *%s (%s)*\n\n" name lib pkg | Some (pkg, _) -> Printf.sprintf "**%s** — *%s*\n\n" name pkg | None -> Printf.sprintf "**%s**\n\n" name
(* A reference's root name can match several files across the switch (the classic case is a bare [index] page, present in every package). Rather than silently render whichever the resolver picked, list the package-qualified alternatives so the user can choose. *)
let starts_with ~prefix s = let lp = String.length prefix in String.length s >= lp && String.sub s 0 lp = prefix
(* The unit/page name a [.odocl] file defines: [page-x.odocl] -> [x], [foo.odocl] -> [Foo]. *)let name_of_file file = let stem = Filename.remove_extension file in if starts_with ~prefix:"page-" stem then String.sub stem 5 (String.length stem - 5) else String.capitalize_ascii stem
(* The package-qualified reference to the unit/page in [path], derived from its location under the [odoc/] root: e.g. odoc/astring/page-index.odocl -> /astring/index, odoc/zed/zed/page-index.odocl -> /zed/zed/index. *)let qualified_ref odoc_root path = match Fpath.relativize ~root:odoc_root path with | None -> None | Some rel -> ( match List.rev (Fpath.segs rel) with | file :: rdirs -> Some ("/" ^ String.concat "/" (List.rev rdirs @ [ name_of_file file ])) | [] -> None)
(* The part of a reference after its root component (its first top-level [.]), e.g. ".bar" of "Foo.bar"; "" for a bare name. Re-attached to each qualified root so the suggestion points at the same item. *)let tail_after_root s = let n = String.length s in let rec loop i depth q = if i >= n then "" else let c = s.[i] in if q then loop (i + 1) depth (c <> '"') else match c with | '"' -> loop (i + 1) depth true | '(' -> loop (i + 1) (depth + 1) false | ')' -> loop (i + 1) (max 0 (depth - 1)) false | '.' when depth = 0 -> String.sub s i (n - i) | _ -> loop (i + 1) depth false in loop 0 0 false
let ambiguities scan ref_str id = (* A path reference (/pkg/…) is already explicit. *) if String.contains ref_str '/' then [] else let tail = tail_after_root ref_str in Refs.root_candidates scan id |> List.filter_map (qualified_ref scan.Refs.odoc) |> List.map (fun r -> r ^ tail) |> List.sort_uniq compare
let doc sw ref_str = let scan = Refs.scan sw in Result.bind (Refs.resolve_to_id scan ref_str) @@ fun id -> match ambiguities scan ref_str id with | _ :: _ :: _ as alts -> Error (`Msg (Printf.sprintf "%S is ambiguous; qualify it as one of:\n%s" ref_str (String.concat "\n" (List.map (fun a -> " " ^ a) alts)))) | _ -> let url = Url.from_identifier ~stop_before:false id in let target = url.Url.Anchor.page in Result.bind (Refs.owning_content scan ~ref_str id) @@ fun content -> let body = match content with | Page_content page -> ( (* A documentation (mld) page: render the whole page. *) match render_doc_page page target with | Some s -> Ok s | None -> Error (`Msg (Printf.sprintf "could not render page %s" ref_str))) | Unit_content cu -> ( (* An identifier whose URL has no anchor is its own page (a module, module type, class or the unit itself): render that whole page. Anything with an anchor is an item living inside a page (a value, type, exception, …): show just its doc comment. *) match url.Url.Anchor.anchor with | "" -> ( match render_module_page cu target with | Some s -> Ok s | None -> docstring_of ref_str id cu) | _ -> docstring_of ref_str id cu) | Impl_content _ | Asset_content _ -> Error (`Msg (Printf.sprintf "%s does not refer to documentation" ref_str)) in Result.map (fun body -> header id url ^ body) body