From eb862a5a90140bf884e38e7aa5bde99bb0193ce0 Mon Sep 17 00:00:00 2001
From: Virgile Prevosto <virgile.prevosto@m4x.org>
Date: Tue, 15 Oct 2019 16:56:22 +0200
Subject: [PATCH] [mdr] prepare merge of the two Markdown libraries

---
 src/plugins/markdown-report/Makefile     |  4 ---
 src/plugins/markdown-report/markdown.ml  | 42 ++++++++++++++++++++++--
 src/plugins/markdown-report/markdown.mli |  8 ++++-
 3 files changed, 46 insertions(+), 8 deletions(-)

diff --git a/src/plugins/markdown-report/Makefile b/src/plugins/markdown-report/Makefile
index da516324671..d9b339efd9a 100644
--- a/src/plugins/markdown-report/Makefile
+++ b/src/plugins/markdown-report/Makefile
@@ -24,15 +24,11 @@ $(Report_markdown_DIR)/mdr_version.ml: $(Report_markdown_DIR)/Makefile
 
 $(Report_markdown_DIR)/Report_markdown.mli: \
   $(Report_markdown_DIR)/mdr_params.mli \
-  $(Report_markdown_DIR)/markdown.mli \
   $(Report_markdown_DIR)/md_gen.mli \
   $(Report_markdown_DIR)/Makefile
 	echo "module Mdr_params: sig" > $@
 	cat $(Report_markdown_DIR)/mdr_params.mli >> $@
 	echo "end" >> $@
-	echo "module Markdown: sig" >> $@
-	cat $(Report_markdown_DIR)/markdown.mli >> $@
-	echo "end" >> $@
 	echo "module Md_gen: sig" >> $@
 	cat $(Report_markdown_DIR)/md_gen.mli >> $@
 	echo "end" >> $@
diff --git a/src/plugins/markdown-report/markdown.ml b/src/plugins/markdown-report/markdown.ml
index 8e91d501c0a..7ba2e768fe1 100644
--- a/src/plugins/markdown-report/markdown.ml
+++ b/src/plugins/markdown-report/markdown.ml
@@ -1,11 +1,17 @@
 type align = Left | Center | Right
 
+type href =
+  | URL of string
+  | Page of string
+  | Name of string
+  | Section of string * string
+
 type inline =
   | Plain of string
   | Emph of string
   | Bold of string
   | Inline_code of string
-  | Link of text * string (** [Link(text,url)] *)
+  | Link of text * href (** [Link(text,url)] *)
   | Image of string * string (** [Image(alt,location)] *)
 
 and text = inline list
@@ -47,20 +53,50 @@ let plain s = [ Plain s]
 
 let plain_format txt = Format.kasprintf plain txt
 
-let plain_link s = Link ([Inline_code s],s)
+let plain_link h =
+  let s = match h with
+    | URL url -> url
+    | Page p -> p
+    | Section (_,s) -> s
+    | Name a -> a
+  in
+  Link ([Inline_code s], URL s)
 
 let codelines lang pp code =
   let s = Format.asprintf "@[%a@]" pp code in
   let lines = String.split_on_char '\n' s in
   Code_block (lang, lines)
 
+let id m =
+  let buffer = Buffer.create (String.length m) in
+  let lowercase = Char.lowercase_ascii in
+  let dash = ref false in
+  let emit c =
+    if !dash then (Buffer.add_char buffer '-' ; dash := false) ;
+    Buffer.add_char buffer c in
+  String.iter
+    (function
+      | '0'..'9' as c -> emit c
+      | 'a'..'z' as c -> emit c
+      | 'A'..'Z' as c -> emit (lowercase c)
+      | '.' | '_' as c -> emit c
+      | ' ' | '\t' | '\n' | '-' -> dash := (Buffer.length buffer > 0)
+      | _ -> ()) m ;
+  Buffer.contents buffer
+
+let pp_href fmt = function
+  | URL s | Page s -> Format.pp_print_string fmt s
+  | Section (p,s) -> Format.fprintf fmt "%s#%s" p (id s)
+  | Name a -> Format.fprintf fmt "#%s" (id a)
+
 let rec pp_inline fmt =
   function
   | Plain s -> Format.pp_print_string fmt s
   | Emph s -> Format.fprintf fmt "_%s_" (String.trim s)
   | Bold s -> Format.fprintf fmt "**%s**" (String.trim s)
   | Inline_code s -> Format.fprintf fmt "`%s`" (String.trim s)
-  | Link (text,url) -> Format.fprintf fmt "@[<h>[%a](%s)@]@ " pp_text text url
+  | Link (text,url) ->
+    Format.fprintf fmt "@[<h>[%a](%a)@]@ " pp_text text pp_href url
   | Image (alt,url) -> Format.fprintf fmt "@[<h>![%s](%s)@]@ " alt url
 
 and pp_text fmt l =
diff --git a/src/plugins/markdown-report/markdown.mli b/src/plugins/markdown-report/markdown.mli
index 08b1f67fd0e..5580883687b 100644
--- a/src/plugins/markdown-report/markdown.mli
+++ b/src/plugins/markdown-report/markdown.mli
@@ -1,11 +1,17 @@
 type align = Left | Center | Right
 
+type href =
+  | URL of string
+  | Page of string
+  | Name of string
+  | Section of string * string
+
 type inline =
   | Plain of string
   | Emph of string
   | Bold of string
   | Inline_code of string
-  | Link of text * string (** [Link(text,url)] *)
+  | Link of text * href
   | Image of string * string (** [Image(alt,location)] *)
 
 and text = inline list
-- 
GitLab