From a685b19a0141669778f194f39c705a33a2c312ef Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Loi=CC=88c=20Correnson?= <loic.correnson@cea.fr>
Date: Fri, 13 Dec 2019 16:32:00 +0100
Subject: [PATCH] [server] index by categories
---
src/plugins/server/doc.ml | 50 +++++++++++++++++++++++++++++----------
1 file changed, 38 insertions(+), 12 deletions(-)
diff --git a/src/plugins/server/doc.ml b/src/plugins/server/doc.ml
index e73db6d5c10..f09e17a0237 100644
--- a/src/plugins/server/doc.ml
+++ b/src/plugins/server/doc.ml
@@ -120,17 +120,42 @@ let table_of_contents () =
(fun p -> table_of_chapter (`Plugin p))
(List.sort String.compare !plugins))
+module Cmap = Map.Make
+ (struct
+ type t = string list
+ let compare = Pervasives.compare
+ end)
+
+let index_entry (title,href) =
+ text @@ Markdown.href ~text:(plain title) href
+
let index () =
- List.map
- (fun (title,entry) -> Markdown.href ~text:(plain title) entry)
- (List.sort
- (fun (e1, _) (e2, _) ->
- let entry e =
- match List.rev (String.split_on_char '.' e) with
- | [] -> [],e
- | a::rpath -> List.rev rpath , a
- in Pervasives.compare (entry e1) (entry e2))
- !entries)
+ let category name =
+ match List.rev (String.split_on_char '.' name) with
+ | [] -> []
+ | _::rpath -> List.rev rpath in
+ let cmap =
+ List.fold_left
+ (fun cs entry ->
+ let c = category (fst entry) in
+ let es = try Cmap.find c cs with Not_found -> [] in
+ Cmap.add c (entry :: es) cs)
+ Cmap.empty !entries in
+ let by_name (a,_) (b,_) = String.compare a b in
+ let categories = Cmap.fold
+ (fun c es ces -> ( c , List.sort by_name es ) :: ces)
+ cmap [] in
+ begin
+ List.fold_left
+ (fun elements (c,es) ->
+ let entries = Block (list @@ List.map index_entry es) :: elements in
+ if c = [] then entries
+ else
+ let cname = String.concat "." c in
+ let title = Printf.sprintf "Index of `%s`" cname in
+ H3(plain title,None) :: entries
+ ) [] categories
+ end
let link ~toc ~title ~href : json =
let link = [ "title" , `String title ; "href" , `String href ] in
@@ -200,8 +225,9 @@ let dump ~root ?(meta=true) () =
@
table_of_contents ()
@
- [H2 (plain "Index", None);
- Block (list (List.map text (index ())))]
+ [H2 (plain "Index", None)]
+ @
+ index ()
in
let title = "Documentation" in
pp_one_page ~root ~page:"readme.md" ~title body
--
GitLab