diff --git a/src/libraries/utils/markdown.ml b/src/libraries/utils/markdown.ml
index 0295d8007b6588eac586be4811bc619ef65947d2..7ba2e768fe1742008c87f6a94c73b0f552b7cd15 100644
--- a/src/libraries/utils/markdown.ml
+++ b/src/libraries/utils/markdown.ml
@@ -1,136 +1,71 @@
-(**************************************************************************)
-(* *)
-(* This file is part of Frama-C. *)
-(* *)
-(* Copyright (C) 2007-2019 *)
-(* CEA (Commissariat à l'énergie atomique et aux énergies *)
-(* alternatives) *)
-(* *)
-(* you can redistribute it and/or modify it under the terms of the GNU *)
-(* Lesser General Public License as published by the Free Software *)
-(* Foundation, version 2.1. *)
-(* *)
-(* It is distributed in the hope that it will be useful, *)
-(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
-(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *)
-(* GNU Lesser General Public License for more details. *)
-(* *)
-(* See the GNU Lesser General Public License version 2.1 *)
-(* for more details (enclosed in the file licenses/LGPLv2.1). *)
-(* *)
-(**************************************************************************)
-
-(* -------------------------------------------------------------------------- *)
-(* --- Markdown Documentation Generation Utility --- *)
-(* -------------------------------------------------------------------------- *)
-
-type md = Format.formatter -> unit
-type text = md
-type block = md
-type section = md
-
-let pretty fmt w = w fmt
-let pp_text = pretty
-let pp_block = pretty
-let pp_section = pretty
-
-(* -------------------------------------------------------------------------- *)
-(* --- Context --- *)
-(* -------------------------------------------------------------------------- *)
-
-type toc = level:int -> name:string -> title:string -> unit
-
-type context = {
- page: string ;
- path: string list ;
- names: bool ;
- level: int ;
- toc: toc option ;
-}
-
-let context = ref {
- page = "" ;
- path = [] ;
- names = false ;
- level = 0 ;
- toc = None ;
+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 * href (** [Link(text,url)] *)
+ | Image of string * string (** [Image(alt,location)] *)
+
+and text = inline list
+
+type block_element =
+ | Text of text (** single paragraph of text. *)
+ | Block_quote of element list
+ | UL of block list
+ | OL of block list
+ | DL of (text * text) list (** definition list *)
+ | EL of (string option * text) list (** example list *)
+ | Code_block of string * string list
+
+and block = block_element list
+
+and element =
+ | Block of block
+ | Raw of string list
+ (** non-markdown. Each element of the list is printed as-is on its own line.
+ A blank line separates the [Raw] node from the next one. *)
+ | Comment of string (** markdown comment, printed <!-- like this --> *)
+ | H1 of text * string option (** optional label. *)
+ | H2 of text * string option
+ | H3 of text * string option
+ | H4 of text * string option
+ | H5 of text * string option
+ | H6 of text * string option
+ | Table of { caption: text option; header: (text * align) list;
+ content: text list list; }
+
+type pandoc_markdown =
+ { title: text;
+ authors: text list;
+ date: text;
+ elements: element list
}
-let local ctxt job data =
- let current = !context in
- try context := ctxt ; job data ; context := current
- with err -> context := current ; raise err
+let plain s = [ Plain s]
-(* -------------------------------------------------------------------------- *)
-(* --- Combinators --- *)
-(* -------------------------------------------------------------------------- *)
+let plain_format txt = Format.kasprintf plain txt
-let nil _fmt = ()
-let empty= nil
-let space fmt = Format.pp_print_space fmt ()
-let newline fmt = Format.pp_print_newline fmt ()
+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 merge sep ds fmt =
- match List.filter (fun d -> d != nil) ds with
- | [] -> ()
- | d::ds -> d fmt ; List.iter (fun d -> sep fmt ; d fmt) ds
-
-let glue ?sep ds fmt =
- match sep with
- | None -> List.iter (fun d -> d fmt) ds
- | Some s -> merge s ds fmt
-
-let (<@>) a b =
- if a == empty then b else
- if b == empty then a else
- fun fmt -> a fmt ; b fmt
-
-let (<+>) a b =
- if a == empty then b else
- if b == empty then a else
- fun fmt -> a fmt ; space fmt ; b fmt
-
-let (</>) a b =
- if a == empty then b else
- if b == empty then a else
- fun fmt -> a fmt ; newline fmt ; b fmt
-
-let fmt_text k fmt = Format.fprintf fmt "@[<h 0>%t@]" k
-let fmt_block k fmt = Format.fprintf fmt "@[<v 0>%t@]@\n" k
-
-(* -------------------------------------------------------------------------- *)
-(* --- Elementary Text --- *)
-(* -------------------------------------------------------------------------- *)
-
-let raw s fmt = Format.pp_print_string fmt s
-let rm s fmt = Format.pp_print_string fmt s
-let it s fmt = Format.fprintf fmt "_%s_" s
-let bf s fmt = Format.fprintf fmt "**%s**" s
-let tt s fmt = Format.fprintf fmt "`%s`" s
-let text = merge space
-let praw s = fmt_block (raw s)
-
-(* -------------------------------------------------------------------------- *)
-(* --- Links --- *)
-(* -------------------------------------------------------------------------- *)
-
-type href = [
- | `URL of string
- | `Page of string
- | `Name of string
- | `Section of string * string
-]
-
-let filepath m = String.split_on_char '/' m
-
-let rec relative source target =
- match source , target with
- | p::ps , q::qs when p = q -> relative ps qs
- | [] , _ -> target
- | _::d , _ -> List.map (fun _ -> "..") d @ target
-
-let lnk target =
- String.concat "/" (relative !context.path (filepath target))
+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
@@ -149,185 +84,176 @@ let id m =
| _ -> ()) m ;
Buffer.contents buffer
-let href ?title (h : href) fmt =
- match title , h with
- | None , `URL url -> Format.fprintf fmt "%s" url
- | Some w , `URL url -> Format.fprintf fmt "[%s](%s)" w url
- | None , `Page p -> Format.fprintf fmt "[%s](%s)" p (lnk p)
- | Some w , `Page p -> Format.fprintf fmt "[%s](%s)" w (lnk p)
- | None , `Section(p,s) -> Format.fprintf fmt "[%s](%s#%s)" s (lnk p) (id s)
- | Some w , `Section(p,s) -> Format.fprintf fmt "[%s](%s#%s)" w (lnk p) (id s)
- | None , `Name a -> Format.fprintf fmt "[%s](#%s)" a (id a)
- | Some w , `Name a -> Format.fprintf fmt "[%s](#%s)" w (id a)
-
-(* -------------------------------------------------------------------------- *)
-(* --- Blocks --- *)
-(* -------------------------------------------------------------------------- *)
-
-let aname anchor fmt =
- Format.fprintf fmt "<a name=\"%s\"></a>@\n" (id anchor)
-
-let title h ?name title fmt =
- begin
- let { level ; names ; toc } = !context in
- let level = max 0 (min 5 (level + h - 1)) in
- Format.fprintf fmt "%s %s" (String.make level '#') title ;
- if names || name <> None || toc <> None then
- begin
- let anchor = match name with None -> title | Some a -> a in
- Format.fprintf fmt " {#%s}" (id anchor) ;
- (match toc with
- | None -> ()
- | Some callback ->
- callback ~level ~name:anchor ~title) ;
- end ;
- Format.pp_print_newline fmt () ;
- end
-
-let h1 = title 1
-let h2 = title 2
-let h3 = title 3
-let h4 = title 4
-
-let indent h w fmt = local { !context with level = !context.level + h } w fmt
-
-let in_h1 = indent 1
-let in_h2 = indent 2
-let in_h3 = indent 3
-let in_h4 = indent 4
-
-let hrule fmt = Format.pp_print_string fmt "-------------------------@."
-
-let par w fmt = Format.fprintf fmt "@[<hov 0>%t@]@." w
-
-let list ws fmt =
- List.iter
- (fun w -> Format.fprintf fmt "@[<hov 2>- %t@]@." w) ws
-
-let enum ws fmt =
- let k = ref 0 in
- List.iter
- (fun w -> incr k ; Format.fprintf fmt "@[<hov 3>%d. %t@]@." !k w) ws
-
-let description items fmt =
- List.iter
- (fun (a,w) -> Format.fprintf fmt "@[<hov 2>- **%s** %t@]@." a w) items
-
-let code ?(lang="") pp fmt =
- begin
- Format.fprintf fmt "@[<v 0>```%s" lang ;
- let buffer = Buffer.create 80 in
- let bfmt = Format.formatter_of_buffer buffer in
- pp bfmt ; Format.pp_print_flush bfmt () ;
- let content = Buffer.contents buffer in
- let lines = String.split_on_char '\n' content in
- let rec clean = function [] -> [] | ""::w -> clean w | w -> w in
+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](%a)@]@ " pp_text text pp_href url
+ | Image (alt,url) -> Format.fprintf fmt "@[<h>@]@ " alt url
+
+and pp_text fmt l =
+ match l with
+ | [] -> ()
+ | [ elt ] -> pp_inline fmt elt
+ | elt :: text -> Format.fprintf fmt "%a@ %a" pp_inline elt pp_text text
+
+let pp_lab fmt = function
+ | None -> ()
+ | Some lab -> Format.fprintf fmt " {#%s}" lab
+
+let test_size txt = String.length (Format.asprintf "%a" pp_text txt)
+
+let pp_dashes fmt size =
+ let dashes = String.make (size + 2) '-' in
+ Format.fprintf fmt "%s+" dashes
+
+let pp_sep_line fmt sizes =
+Format.fprintf fmt "@[<h>+";
+List.iter (pp_dashes fmt) sizes;
+Format.fprintf fmt "@]@\n"
+
+let pp_header fmt (t,_) size =
+ let real_size = test_size t in
+ let spaces = String.make (size - real_size) ' ' in
+ Format.fprintf fmt " %a%s |" pp_text t spaces
+
+let pp_headers fmt l sizes =
+ Format.fprintf fmt "@[<h>|";
+ List.iter2 (pp_header fmt) l sizes;
+ Format.fprintf fmt "@]@\n"
+
+let compute_sizes headers contents =
+ let check_line i m line =
+ try max m (test_size (List.nth line i) + 2)
+ with Failure _ -> m
+ in
+ let column_size (i,l) (h,_) =
+ let max = List.fold_left (check_line i) (test_size h) contents in
+ (i+1, max :: l)
+ in
+ let (_,sizes) = List.fold_left column_size (0,[]) headers in
+ List.rev sizes
+
+let pp_align fmt align size =
+ let sep = String.make size '=' in
+ match align with
+ | (_,Left) -> Format.fprintf fmt ":%s=+" sep
+ | (_,Center) -> Format.fprintf fmt ":%s:+" sep
+ | (_,Right) -> Format.fprintf fmt "%s=:+" sep
+
+let pp_aligns fmt headers sizes =
+ Format.fprintf fmt "@[<h>+";
+ List.iter2 (pp_align fmt) headers sizes;
+ Format.fprintf fmt "@]@\n"
+
+let pp_table_cell fmt size t =
+ let real_size = test_size t in
+ let spaces = String.make (size - real_size) ' ' in
+ Format.fprintf fmt " %a%s |" pp_text t spaces
+
+let pp_table_line fmt sizes l =
+ Format.fprintf fmt "@[<h>|";
+ List.iter2 (pp_table_cell fmt) sizes l;
+ Format.fprintf fmt "@]@\n";
+ pp_sep_line fmt sizes
+
+let pp_table_content fmt l sizes =
+ Format.fprintf fmt "@[<v>";
+ List.iter (pp_table_line fmt sizes) l;
+ Format.fprintf fmt "@]"
+
+let rec pp_block_element fmt = function
+ | Text t -> Format.fprintf fmt "@[<hov>%a@]@\n" pp_text t
+ | Block_quote l -> pp_quote fmt l
+ | UL l -> pp_list "*" fmt l
+ | OL l -> pp_list "#." fmt l
+ | DL l ->
List.iter
- (fun l -> Format.fprintf fmt "@\n%s" l)
- (List.rev (clean (List.rev (clean lines)))) ;
- Format.fprintf fmt "@\n```@]@."
- end
-
-type column = [
- | `Left of string
- | `Right of string
- | `Center of string
-]
-
-let table columns rows fmt =
- begin
- Format.fprintf fmt "@[<v 0>" ;
+ (fun (term,def) ->
+ Format.fprintf fmt "@[<h>%a@]@\n@\n@[<hov 2>: %a@]@\n@\n"
+ pp_text term pp_text def)
+ l
+ | EL l ->
List.iter
- (function `Left h | `Right h | `Center h -> Format.fprintf fmt "| %s " h)
- columns ;
- Format.fprintf fmt "|@\n" ;
- List.iter (fun column ->
- let dash h k = String.make (max 3 (String.length h + k)) '-' in
- match column with
- | `Left h -> Format.fprintf fmt "|:%s" (dash h 1)
- | `Right h -> Format.fprintf fmt "|%s:" (dash h 1)
- | `Center h -> Format.fprintf fmt "|:%s:" (dash h 0)
- ) columns ;
- Format.fprintf fmt "|@\n" ;
- List.iter (fun row ->
- List.iter (fun col -> Format.fprintf fmt "| @[<h 0>%t@] " col) row ;
- Format.fprintf fmt "|@\n" ;
- ) rows ;
- Format.fprintf fmt "@]@." ;
- end
-
-let concat ps = merge newline (List.filter (fun p -> p != empty) ps)
-
-(* -------------------------------------------------------------------------- *)
-(* --- Refs --- *)
-(* -------------------------------------------------------------------------- *)
-
-let mk f fmt = (f ()) fmt
-let mk_text = mk
-let mk_block = mk
-
-(* -------------------------------------------------------------------------- *)
-(* --- Sections --- *)
-(* -------------------------------------------------------------------------- *)
-
-let document s = s
-
-let subsections section subsections = section </> in_h1 (merge newline subsections)
-
-let section ?name ~title content subsections =
- h1 ?name title </> content </> in_h1 (merge newline subsections)
-
-(* -------------------------------------------------------------------------- *)
-(* --- Include File --- *)
-(* -------------------------------------------------------------------------- *)
-
-let from_file path fmt =
- let inc = open_in path in
- try
- while true do
- let line = input_line inc in
- Format.pp_print_string fmt line ;
- Format.pp_print_newline fmt () ;
- done
- with
- | End_of_file -> close_in inc
- | exn -> close_in inc ; raise exn
-
-let read_block = from_file
-let read_section = from_file
-let read_text path fmt = Format.fprintf fmt "@[<h 0>%t@]" (from_file path)
-
-(* -------------------------------------------------------------------------- *)
-(* --- Dump to File --- *)
-(* -------------------------------------------------------------------------- *)
-
-let rec mkdir root page =
- let dir = Filename.dirname page in
- if dir <> "." && dir <> ".." then
- let path = Printf.sprintf "%s/%s" root dir in
- if not (Sys.file_exists path) then
- begin
- mkdir root dir ;
- try Unix.mkdir path 0o755
- with Unix.Unix_error _ ->
- failwith (Printf.sprintf "Can not create direcoty '%s'" dir)
- end
-
-let dump ~root ~page ?(names=false) ?toc doc =
- local
- { page ; path = filepath page ; level = 1 ; toc ; names = names }
- begin fun () ->
- mkdir root page ;
- let out = open_out (Printf.sprintf "%s/%s" root page) in
- let fmt = Format.formatter_of_out_channel out in
- try
- doc fmt ;
- Format.pp_print_newline fmt () ;
- close_out out ;
- with err ->
- Format.pp_print_newline fmt () ;
- close_out out ;
- raise err
- end ()
-
-(* -------------------------------------------------------------------------- *)
+ (fun (lab,txt) ->
+ match lab with
+ | None -> Format.fprintf fmt "@[<hov 4>(@@) %a@]@\n" pp_text txt
+ | Some s -> Format.fprintf fmt "@[<hov 4>(@@%s) %a@]@\n" s pp_text txt)
+ l
+ | Code_block (language, lines) ->
+ Format.fprintf fmt "@[<h>```%s@]@\n" language;
+ List.iter (fun line -> Format.fprintf fmt "@[<h>%s@]@\n" line) lines;
+ Format.fprintf fmt "```@\n"
+
+and pp_list prefix fmt l =
+ List.iter
+ (fun item ->
+ Format.fprintf fmt "@[<v 4>@[<hov>%s %a@]@]" prefix pp_block item)
+ l
+
+and pp_block fmt l =
+ match l with
+ | [ elt ] -> pp_block_element fmt elt
+ | _ ->
+ Format.fprintf fmt "%a@\n"
+ (Format.pp_print_list ~pp_sep:Format.pp_force_newline pp_block_element) l
+
+and pp_quote fmt l =
+ List.iter
+ (fun elt -> Format.fprintf fmt "@[<v>> %a@]" pp_element elt) l
+
+and pp_element fmt = function
+ | Block b -> Format.fprintf fmt "@[<v>%a@]" pp_block b
+ | Raw l ->
+ Format.(
+ fprintf fmt "%a"
+ (pp_print_list ~pp_sep:pp_force_newline pp_print_string) l)
+ | Comment s ->
+ Format.fprintf fmt
+ "@[<hv>@[<hov 5><!-- %a@]@ -->@]" Format.pp_print_text s
+ | H1(t,lab) -> Format.fprintf fmt "@[<h># %a%a@]" pp_text t pp_lab lab
+ | H2(t,lab) -> Format.fprintf fmt "@[<h>## %a%a@]" pp_text t pp_lab lab
+ | H3(t,lab) -> Format.fprintf fmt "@[<h>### %a%a@]" pp_text t pp_lab lab
+ | H4(t,lab) -> Format.fprintf fmt "@[<h>#### %a%a@]" pp_text t pp_lab lab
+ | H5(t,lab) -> Format.fprintf fmt "@[<h>##### %a%a@]" pp_text t pp_lab lab
+ | H6(t,lab) -> Format.fprintf fmt "@[<h>###### %a%a@]" pp_text t pp_lab lab
+ | Table { caption; header; content } ->
+ (match caption with
+ | None -> ()
+ | Some t -> Format.fprintf fmt "@[<h>Table: %a@]@\n@\n" pp_text t);
+ let sizes = compute_sizes header content in
+ pp_sep_line fmt sizes;
+ pp_headers fmt header sizes;
+ pp_aligns fmt header sizes;
+ pp_table_content fmt content sizes
+
+let pp_elements fmt l =
+ let pp_sep fmt () =
+ Format.pp_print_newline fmt ();
+ Format.pp_print_newline fmt ()
+ in
+ Format.pp_print_list ~pp_sep pp_element fmt l
+
+let pp_authors fmt l =
+ List.iter (fun t -> Format.fprintf fmt "@[<h>- %a@]@\n" pp_text t) l
+
+let pp_pandoc fmt { title; authors; date; elements } =
+ Format.fprintf fmt "@[<v>";
+ if title <> [] || authors <> [] || date <> [] then begin
+ Format.fprintf fmt "@[<h>---@]@\n";
+ Format.fprintf fmt "@[<h>title: %a@]@\n" pp_text title;
+ Format.fprintf fmt "@[<h>author:@]@\n%a" pp_authors authors;
+ Format.fprintf fmt "@[<h>date: %a@]@\n" pp_text date;
+ Format.fprintf fmt "@[<h>...@]@\n";
+ Format.pp_print_newline fmt ();
+ end;
+ pp_elements fmt elements;
+ Format.fprintf fmt "@]%!"
diff --git a/src/libraries/utils/markdown.mli b/src/libraries/utils/markdown.mli
index 34b955919fcc8696722172e66ad43680b689335c..5580883687bda1d784ca95c2bc7a35f36013e298 100644
--- a/src/libraries/utils/markdown.mli
+++ b/src/libraries/utils/markdown.mli
@@ -1,183 +1,76 @@
-(**************************************************************************)
-(* *)
-(* This file is part of Frama-C. *)
-(* *)
-(* Copyright (C) 2007-2019 *)
-(* CEA (Commissariat à l'énergie atomique et aux énergies *)
-(* alternatives) *)
-(* *)
-(* you can redistribute it and/or modify it under the terms of the GNU *)
-(* Lesser General Public License as published by the Free Software *)
-(* Foundation, version 2.1. *)
-(* *)
-(* It is distributed in the hope that it will be useful, *)
-(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
-(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *)
-(* GNU Lesser General Public License for more details. *)
-(* *)
-(* See the GNU Lesser General Public License version 2.1 *)
-(* for more details (enclosed in the file licenses/LGPLv2.1). *)
-(* *)
-(**************************************************************************)
-
-(* -------------------------------------------------------------------------- *)
-(* --- Markdown Documentation Generation Utility --- *)
-(* -------------------------------------------------------------------------- *)
-
-(** {2 Markdown}
-
- A lightweight helper for generating Markdown documentation.
- Two levels of formatters are defined to help managing indentation and
- spaces: [text] for inline markdown, and [block] for markdown paragraphs.
-
-*)
-
-type text
-type block
-type section
-
-val (<@>) : text -> text -> text (** Infix operator for [glue] *)
-val (<+>) : text -> text -> text (** Infix operator for [text] *)
-val (</>) : block -> block -> block (** Infix operator for [concat] *)
-
-(** {2 Text Constructors} *)
-
-val nil : text (** Empty *)
-val raw : string -> text (** inlined markdown format *)
-val rm : string -> text (** roman (normal) style *)
-val it : string -> text (** italic style *)
-val bf : string -> text (** bold style *)
-val tt : string -> text (** typewriter style *)
-
-val glue : ?sep:text -> text list -> text (** Glue text fragments *)
-val text : text list -> text (** Glue text fragments with spaces *)
-
-(** {2 Block Constructors} *)
-
-val empty : block (** Empty *)
-val hrule : block (** Horizontal rule *)
-
-val h1 : ?name:string -> string -> block (** Title level 1 *)
-val h2 : ?name:string -> string -> block (** Title level 2 *)
-val h3 : ?name:string -> string -> block (** Title level 3 *)
-val h4 : ?name:string -> string -> block (** Title level 4 *)
-
-val in_h1 : block -> block (** Increment title levels by 1 *)
-val in_h2 : block -> block (** Increment title levels by 2 *)
-val in_h3 : block -> block (** Increment title levels by 3 *)
-val in_h4 : block -> block (** Increment title levels by 4 *)
-
-val par : text -> block (** Simple text paragraph *)
-val praw : string -> block (** Simple raw paragraph *)
-val list : text list -> block (** Itemized list *)
-val enum : text list -> block (** Enumerated list *)
-val description : (string * text) list -> block (** Description list *)
-
-(** Formatted code.
-
- The code content is pretty-printed in a vertical [<v0>] box
- with default [Format] formatter.
- Leading and trailing empty lines are removed and indentation is
- preserved. *)
-val code : ?lang:string -> (Format.formatter -> unit) -> block
-
-val concat : block list -> block (** Glue paragraphs with empty lines *)
-
-(** {2 Hyperlinks}
-
- [`Page], [`Name] and [`Section] links refers to the current document,
- see [dump] function below.
-
- In [`Section(p,t)], [p] is the page path relative to the
- document {i root}, and [t] is the section title {i or} name.
-
- For [`Name a], the links refers to name or title [a]
- in the {i current} page.
-
- Hence, everywhere throughout a self-content document directory [~root],
- local page [~page] inside [~root] can be referenced
- by [`Page page], and its sections can by [`Section(page,title)]
- or [`Section(page,name)].
-
-*)
-
-type href = [
- | `URL of string
- | `Page of string
- | `Name of string
- | `Section of string * string
-]
-
-(** Default [~title] is taken from [href]. When printed,
- actual link will be relativized with respect to current page. *)
-val href : ?title:string -> href -> text
-
-(** Define a local anchor *)
-val aname : string -> block
-
-(** {2 Tables} *)
-
-type column = [
- | `Left of string
- | `Right of string
- | `Center of string
-]
-
-val table : column list -> text list list -> block
-
-(** {2 Markdown Generator}
- Generating function are called each time the markdown
- fragment is printed. *)
-
-val mk_text : (unit -> text) -> text
-val mk_block : (unit -> block) -> block
-
-(** {2 Sections}
-
- Sections are an alternative to [h1-h4] constructors to build
- properly nested sub-sections. Deep sections at depth 5 and more are
- flattened.
-*)
-
-val section : ?name:string -> title:string -> block -> section list -> section
-val subsections : section -> section list -> section
-val document : section -> block
-
-(** {2 Dump to file}
-
- Generate the markdown [~page] in directory [~root] with the given content.
- The [~root] directory shall be absolute or relative to the current working
- directory. The [~page] file-path shall be relative to the [~root] directory
- and will be used to relocate hyperlinks to other [`Page] and [`Section]
- properly.
-
- Hence, everywhere throughout the document, [dump ~root ~page doc]
- is referenced by [`Page page], and its sections are referenced by
- [`Section(page,title)].
-
-*)
-
-(** Callback to listen for actual sections when printing a page. *)
-type toc = level:int -> name:string -> title:string -> unit
-
-(** Create a markdown page.
- - [~root] document directory (relocatable)
- - [~page] relative file-path of the page in [~root] (non relocatable)
- - [~names] generate explicit [<a name=...>] tags for all titles
- - [~toc] optional callback to register table of contents
-*)
-val dump : root:string -> page:string -> ?names:bool -> ?toc:toc -> block -> unit
-
-(** {2 Miscellaneous} *)
-
-val read_text : string -> text
-val read_block : string -> block
-val read_section : string -> section
-
-val fmt_text : (Format.formatter -> unit) -> text
-val fmt_block : (Format.formatter -> unit) -> block
-val pp_text : Format.formatter -> text -> unit
-val pp_block : Format.formatter -> block -> unit
-val pp_section : Format.formatter -> section -> unit
-
-(* -------------------------------------------------------------------------- *)
+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 * href
+ | Image of string * string (** [Image(alt,location)] *)
+
+and text = inline list
+
+type block_element =
+ | Text of text (** single paragraph of text. *)
+ | Block_quote of element list
+ | UL of block list
+ | OL of block list
+ | DL of (text * text) list (** definition list *)
+ | EL of (string option * text) list (** example list *)
+ | Code_block of string * string list
+
+and block = block_element list
+
+and element =
+ | Block of block
+ | Raw of string list
+ (** non-markdown. Each element of the list is printed as-is on its own line.
+ A blank line separates the [Raw] node from the next one. *)
+ | Comment of string (** markdown comment, printed <!-- like this --> *)
+ | H1 of text * string option (** optional label. *)
+ | H2 of text * string option
+ | H3 of text * string option
+ | H4 of text * string option
+ | H5 of text * string option
+ | H6 of text * string option
+ | Table of { caption: text option; header: (text * align) list;
+ content: text list list; }
+
+type pandoc_markdown =
+ { title: text;
+ authors: text list;
+ date: text;
+ elements: element list
+ }
+
+val plain: string -> text
+
+val plain_format: ('a, Format.formatter, unit, text) format4 -> 'a
+
+(** gives a link whose text is the URL itself. *)
+val plain_link: string -> inline
+
+(** [codelines lang pp code] returns a [Code_block] for [code], written
+in [lang], as pretty-printed by [pp]. *)
+val codelines:
+ string -> (Format.formatter -> 'a -> unit) -> 'a -> block_element
+
+val pp_inline: Format.formatter -> inline -> unit
+
+val pp_text: Format.formatter -> text -> unit
+
+val pp_block_element: Format.formatter -> block_element -> unit
+
+val pp_block: Format.formatter -> block -> unit
+
+val pp_element: Format.formatter -> element -> unit
+
+val pp_elements: Format.formatter -> element list -> unit
+
+val pp_pandoc: Format.formatter -> pandoc_markdown -> unit
diff --git a/src/libraries/utils/markdown_old.ml b/src/libraries/utils/markdown_old.ml
new file mode 100644
index 0000000000000000000000000000000000000000..0295d8007b6588eac586be4811bc619ef65947d2
--- /dev/null
+++ b/src/libraries/utils/markdown_old.ml
@@ -0,0 +1,333 @@
+(**************************************************************************)
+(* *)
+(* This file is part of Frama-C. *)
+(* *)
+(* Copyright (C) 2007-2019 *)
+(* CEA (Commissariat à l'énergie atomique et aux énergies *)
+(* alternatives) *)
+(* *)
+(* you can redistribute it and/or modify it under the terms of the GNU *)
+(* Lesser General Public License as published by the Free Software *)
+(* Foundation, version 2.1. *)
+(* *)
+(* It is distributed in the hope that it will be useful, *)
+(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
+(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *)
+(* GNU Lesser General Public License for more details. *)
+(* *)
+(* See the GNU Lesser General Public License version 2.1 *)
+(* for more details (enclosed in the file licenses/LGPLv2.1). *)
+(* *)
+(**************************************************************************)
+
+(* -------------------------------------------------------------------------- *)
+(* --- Markdown Documentation Generation Utility --- *)
+(* -------------------------------------------------------------------------- *)
+
+type md = Format.formatter -> unit
+type text = md
+type block = md
+type section = md
+
+let pretty fmt w = w fmt
+let pp_text = pretty
+let pp_block = pretty
+let pp_section = pretty
+
+(* -------------------------------------------------------------------------- *)
+(* --- Context --- *)
+(* -------------------------------------------------------------------------- *)
+
+type toc = level:int -> name:string -> title:string -> unit
+
+type context = {
+ page: string ;
+ path: string list ;
+ names: bool ;
+ level: int ;
+ toc: toc option ;
+}
+
+let context = ref {
+ page = "" ;
+ path = [] ;
+ names = false ;
+ level = 0 ;
+ toc = None ;
+ }
+
+let local ctxt job data =
+ let current = !context in
+ try context := ctxt ; job data ; context := current
+ with err -> context := current ; raise err
+
+(* -------------------------------------------------------------------------- *)
+(* --- Combinators --- *)
+(* -------------------------------------------------------------------------- *)
+
+let nil _fmt = ()
+let empty= nil
+let space fmt = Format.pp_print_space fmt ()
+let newline fmt = Format.pp_print_newline fmt ()
+
+let merge sep ds fmt =
+ match List.filter (fun d -> d != nil) ds with
+ | [] -> ()
+ | d::ds -> d fmt ; List.iter (fun d -> sep fmt ; d fmt) ds
+
+let glue ?sep ds fmt =
+ match sep with
+ | None -> List.iter (fun d -> d fmt) ds
+ | Some s -> merge s ds fmt
+
+let (<@>) a b =
+ if a == empty then b else
+ if b == empty then a else
+ fun fmt -> a fmt ; b fmt
+
+let (<+>) a b =
+ if a == empty then b else
+ if b == empty then a else
+ fun fmt -> a fmt ; space fmt ; b fmt
+
+let (</>) a b =
+ if a == empty then b else
+ if b == empty then a else
+ fun fmt -> a fmt ; newline fmt ; b fmt
+
+let fmt_text k fmt = Format.fprintf fmt "@[<h 0>%t@]" k
+let fmt_block k fmt = Format.fprintf fmt "@[<v 0>%t@]@\n" k
+
+(* -------------------------------------------------------------------------- *)
+(* --- Elementary Text --- *)
+(* -------------------------------------------------------------------------- *)
+
+let raw s fmt = Format.pp_print_string fmt s
+let rm s fmt = Format.pp_print_string fmt s
+let it s fmt = Format.fprintf fmt "_%s_" s
+let bf s fmt = Format.fprintf fmt "**%s**" s
+let tt s fmt = Format.fprintf fmt "`%s`" s
+let text = merge space
+let praw s = fmt_block (raw s)
+
+(* -------------------------------------------------------------------------- *)
+(* --- Links --- *)
+(* -------------------------------------------------------------------------- *)
+
+type href = [
+ | `URL of string
+ | `Page of string
+ | `Name of string
+ | `Section of string * string
+]
+
+let filepath m = String.split_on_char '/' m
+
+let rec relative source target =
+ match source , target with
+ | p::ps , q::qs when p = q -> relative ps qs
+ | [] , _ -> target
+ | _::d , _ -> List.map (fun _ -> "..") d @ target
+
+let lnk target =
+ String.concat "/" (relative !context.path (filepath target))
+
+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 href ?title (h : href) fmt =
+ match title , h with
+ | None , `URL url -> Format.fprintf fmt "%s" url
+ | Some w , `URL url -> Format.fprintf fmt "[%s](%s)" w url
+ | None , `Page p -> Format.fprintf fmt "[%s](%s)" p (lnk p)
+ | Some w , `Page p -> Format.fprintf fmt "[%s](%s)" w (lnk p)
+ | None , `Section(p,s) -> Format.fprintf fmt "[%s](%s#%s)" s (lnk p) (id s)
+ | Some w , `Section(p,s) -> Format.fprintf fmt "[%s](%s#%s)" w (lnk p) (id s)
+ | None , `Name a -> Format.fprintf fmt "[%s](#%s)" a (id a)
+ | Some w , `Name a -> Format.fprintf fmt "[%s](#%s)" w (id a)
+
+(* -------------------------------------------------------------------------- *)
+(* --- Blocks --- *)
+(* -------------------------------------------------------------------------- *)
+
+let aname anchor fmt =
+ Format.fprintf fmt "<a name=\"%s\"></a>@\n" (id anchor)
+
+let title h ?name title fmt =
+ begin
+ let { level ; names ; toc } = !context in
+ let level = max 0 (min 5 (level + h - 1)) in
+ Format.fprintf fmt "%s %s" (String.make level '#') title ;
+ if names || name <> None || toc <> None then
+ begin
+ let anchor = match name with None -> title | Some a -> a in
+ Format.fprintf fmt " {#%s}" (id anchor) ;
+ (match toc with
+ | None -> ()
+ | Some callback ->
+ callback ~level ~name:anchor ~title) ;
+ end ;
+ Format.pp_print_newline fmt () ;
+ end
+
+let h1 = title 1
+let h2 = title 2
+let h3 = title 3
+let h4 = title 4
+
+let indent h w fmt = local { !context with level = !context.level + h } w fmt
+
+let in_h1 = indent 1
+let in_h2 = indent 2
+let in_h3 = indent 3
+let in_h4 = indent 4
+
+let hrule fmt = Format.pp_print_string fmt "-------------------------@."
+
+let par w fmt = Format.fprintf fmt "@[<hov 0>%t@]@." w
+
+let list ws fmt =
+ List.iter
+ (fun w -> Format.fprintf fmt "@[<hov 2>- %t@]@." w) ws
+
+let enum ws fmt =
+ let k = ref 0 in
+ List.iter
+ (fun w -> incr k ; Format.fprintf fmt "@[<hov 3>%d. %t@]@." !k w) ws
+
+let description items fmt =
+ List.iter
+ (fun (a,w) -> Format.fprintf fmt "@[<hov 2>- **%s** %t@]@." a w) items
+
+let code ?(lang="") pp fmt =
+ begin
+ Format.fprintf fmt "@[<v 0>```%s" lang ;
+ let buffer = Buffer.create 80 in
+ let bfmt = Format.formatter_of_buffer buffer in
+ pp bfmt ; Format.pp_print_flush bfmt () ;
+ let content = Buffer.contents buffer in
+ let lines = String.split_on_char '\n' content in
+ let rec clean = function [] -> [] | ""::w -> clean w | w -> w in
+ List.iter
+ (fun l -> Format.fprintf fmt "@\n%s" l)
+ (List.rev (clean (List.rev (clean lines)))) ;
+ Format.fprintf fmt "@\n```@]@."
+ end
+
+type column = [
+ | `Left of string
+ | `Right of string
+ | `Center of string
+]
+
+let table columns rows fmt =
+ begin
+ Format.fprintf fmt "@[<v 0>" ;
+ List.iter
+ (function `Left h | `Right h | `Center h -> Format.fprintf fmt "| %s " h)
+ columns ;
+ Format.fprintf fmt "|@\n" ;
+ List.iter (fun column ->
+ let dash h k = String.make (max 3 (String.length h + k)) '-' in
+ match column with
+ | `Left h -> Format.fprintf fmt "|:%s" (dash h 1)
+ | `Right h -> Format.fprintf fmt "|%s:" (dash h 1)
+ | `Center h -> Format.fprintf fmt "|:%s:" (dash h 0)
+ ) columns ;
+ Format.fprintf fmt "|@\n" ;
+ List.iter (fun row ->
+ List.iter (fun col -> Format.fprintf fmt "| @[<h 0>%t@] " col) row ;
+ Format.fprintf fmt "|@\n" ;
+ ) rows ;
+ Format.fprintf fmt "@]@." ;
+ end
+
+let concat ps = merge newline (List.filter (fun p -> p != empty) ps)
+
+(* -------------------------------------------------------------------------- *)
+(* --- Refs --- *)
+(* -------------------------------------------------------------------------- *)
+
+let mk f fmt = (f ()) fmt
+let mk_text = mk
+let mk_block = mk
+
+(* -------------------------------------------------------------------------- *)
+(* --- Sections --- *)
+(* -------------------------------------------------------------------------- *)
+
+let document s = s
+
+let subsections section subsections = section </> in_h1 (merge newline subsections)
+
+let section ?name ~title content subsections =
+ h1 ?name title </> content </> in_h1 (merge newline subsections)
+
+(* -------------------------------------------------------------------------- *)
+(* --- Include File --- *)
+(* -------------------------------------------------------------------------- *)
+
+let from_file path fmt =
+ let inc = open_in path in
+ try
+ while true do
+ let line = input_line inc in
+ Format.pp_print_string fmt line ;
+ Format.pp_print_newline fmt () ;
+ done
+ with
+ | End_of_file -> close_in inc
+ | exn -> close_in inc ; raise exn
+
+let read_block = from_file
+let read_section = from_file
+let read_text path fmt = Format.fprintf fmt "@[<h 0>%t@]" (from_file path)
+
+(* -------------------------------------------------------------------------- *)
+(* --- Dump to File --- *)
+(* -------------------------------------------------------------------------- *)
+
+let rec mkdir root page =
+ let dir = Filename.dirname page in
+ if dir <> "." && dir <> ".." then
+ let path = Printf.sprintf "%s/%s" root dir in
+ if not (Sys.file_exists path) then
+ begin
+ mkdir root dir ;
+ try Unix.mkdir path 0o755
+ with Unix.Unix_error _ ->
+ failwith (Printf.sprintf "Can not create direcoty '%s'" dir)
+ end
+
+let dump ~root ~page ?(names=false) ?toc doc =
+ local
+ { page ; path = filepath page ; level = 1 ; toc ; names = names }
+ begin fun () ->
+ mkdir root page ;
+ let out = open_out (Printf.sprintf "%s/%s" root page) in
+ let fmt = Format.formatter_of_out_channel out in
+ try
+ doc fmt ;
+ Format.pp_print_newline fmt () ;
+ close_out out ;
+ with err ->
+ Format.pp_print_newline fmt () ;
+ close_out out ;
+ raise err
+ end ()
+
+(* -------------------------------------------------------------------------- *)
diff --git a/src/libraries/utils/markdown_old.mli b/src/libraries/utils/markdown_old.mli
new file mode 100644
index 0000000000000000000000000000000000000000..34b955919fcc8696722172e66ad43680b689335c
--- /dev/null
+++ b/src/libraries/utils/markdown_old.mli
@@ -0,0 +1,183 @@
+(**************************************************************************)
+(* *)
+(* This file is part of Frama-C. *)
+(* *)
+(* Copyright (C) 2007-2019 *)
+(* CEA (Commissariat à l'énergie atomique et aux énergies *)
+(* alternatives) *)
+(* *)
+(* you can redistribute it and/or modify it under the terms of the GNU *)
+(* Lesser General Public License as published by the Free Software *)
+(* Foundation, version 2.1. *)
+(* *)
+(* It is distributed in the hope that it will be useful, *)
+(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
+(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *)
+(* GNU Lesser General Public License for more details. *)
+(* *)
+(* See the GNU Lesser General Public License version 2.1 *)
+(* for more details (enclosed in the file licenses/LGPLv2.1). *)
+(* *)
+(**************************************************************************)
+
+(* -------------------------------------------------------------------------- *)
+(* --- Markdown Documentation Generation Utility --- *)
+(* -------------------------------------------------------------------------- *)
+
+(** {2 Markdown}
+
+ A lightweight helper for generating Markdown documentation.
+ Two levels of formatters are defined to help managing indentation and
+ spaces: [text] for inline markdown, and [block] for markdown paragraphs.
+
+*)
+
+type text
+type block
+type section
+
+val (<@>) : text -> text -> text (** Infix operator for [glue] *)
+val (<+>) : text -> text -> text (** Infix operator for [text] *)
+val (</>) : block -> block -> block (** Infix operator for [concat] *)
+
+(** {2 Text Constructors} *)
+
+val nil : text (** Empty *)
+val raw : string -> text (** inlined markdown format *)
+val rm : string -> text (** roman (normal) style *)
+val it : string -> text (** italic style *)
+val bf : string -> text (** bold style *)
+val tt : string -> text (** typewriter style *)
+
+val glue : ?sep:text -> text list -> text (** Glue text fragments *)
+val text : text list -> text (** Glue text fragments with spaces *)
+
+(** {2 Block Constructors} *)
+
+val empty : block (** Empty *)
+val hrule : block (** Horizontal rule *)
+
+val h1 : ?name:string -> string -> block (** Title level 1 *)
+val h2 : ?name:string -> string -> block (** Title level 2 *)
+val h3 : ?name:string -> string -> block (** Title level 3 *)
+val h4 : ?name:string -> string -> block (** Title level 4 *)
+
+val in_h1 : block -> block (** Increment title levels by 1 *)
+val in_h2 : block -> block (** Increment title levels by 2 *)
+val in_h3 : block -> block (** Increment title levels by 3 *)
+val in_h4 : block -> block (** Increment title levels by 4 *)
+
+val par : text -> block (** Simple text paragraph *)
+val praw : string -> block (** Simple raw paragraph *)
+val list : text list -> block (** Itemized list *)
+val enum : text list -> block (** Enumerated list *)
+val description : (string * text) list -> block (** Description list *)
+
+(** Formatted code.
+
+ The code content is pretty-printed in a vertical [<v0>] box
+ with default [Format] formatter.
+ Leading and trailing empty lines are removed and indentation is
+ preserved. *)
+val code : ?lang:string -> (Format.formatter -> unit) -> block
+
+val concat : block list -> block (** Glue paragraphs with empty lines *)
+
+(** {2 Hyperlinks}
+
+ [`Page], [`Name] and [`Section] links refers to the current document,
+ see [dump] function below.
+
+ In [`Section(p,t)], [p] is the page path relative to the
+ document {i root}, and [t] is the section title {i or} name.
+
+ For [`Name a], the links refers to name or title [a]
+ in the {i current} page.
+
+ Hence, everywhere throughout a self-content document directory [~root],
+ local page [~page] inside [~root] can be referenced
+ by [`Page page], and its sections can by [`Section(page,title)]
+ or [`Section(page,name)].
+
+*)
+
+type href = [
+ | `URL of string
+ | `Page of string
+ | `Name of string
+ | `Section of string * string
+]
+
+(** Default [~title] is taken from [href]. When printed,
+ actual link will be relativized with respect to current page. *)
+val href : ?title:string -> href -> text
+
+(** Define a local anchor *)
+val aname : string -> block
+
+(** {2 Tables} *)
+
+type column = [
+ | `Left of string
+ | `Right of string
+ | `Center of string
+]
+
+val table : column list -> text list list -> block
+
+(** {2 Markdown Generator}
+ Generating function are called each time the markdown
+ fragment is printed. *)
+
+val mk_text : (unit -> text) -> text
+val mk_block : (unit -> block) -> block
+
+(** {2 Sections}
+
+ Sections are an alternative to [h1-h4] constructors to build
+ properly nested sub-sections. Deep sections at depth 5 and more are
+ flattened.
+*)
+
+val section : ?name:string -> title:string -> block -> section list -> section
+val subsections : section -> section list -> section
+val document : section -> block
+
+(** {2 Dump to file}
+
+ Generate the markdown [~page] in directory [~root] with the given content.
+ The [~root] directory shall be absolute or relative to the current working
+ directory. The [~page] file-path shall be relative to the [~root] directory
+ and will be used to relocate hyperlinks to other [`Page] and [`Section]
+ properly.
+
+ Hence, everywhere throughout the document, [dump ~root ~page doc]
+ is referenced by [`Page page], and its sections are referenced by
+ [`Section(page,title)].
+
+*)
+
+(** Callback to listen for actual sections when printing a page. *)
+type toc = level:int -> name:string -> title:string -> unit
+
+(** Create a markdown page.
+ - [~root] document directory (relocatable)
+ - [~page] relative file-path of the page in [~root] (non relocatable)
+ - [~names] generate explicit [<a name=...>] tags for all titles
+ - [~toc] optional callback to register table of contents
+*)
+val dump : root:string -> page:string -> ?names:bool -> ?toc:toc -> block -> unit
+
+(** {2 Miscellaneous} *)
+
+val read_text : string -> text
+val read_block : string -> block
+val read_section : string -> section
+
+val fmt_text : (Format.formatter -> unit) -> text
+val fmt_block : (Format.formatter -> unit) -> block
+val pp_text : Format.formatter -> text -> unit
+val pp_block : Format.formatter -> block -> unit
+val pp_section : Format.formatter -> section -> unit
+
+(* -------------------------------------------------------------------------- *)
diff --git a/src/plugins/markdown-report/markdown.ml b/src/plugins/markdown-report/markdown.ml
deleted file mode 100644
index 7ba2e768fe1742008c87f6a94c73b0f552b7cd15..0000000000000000000000000000000000000000
--- a/src/plugins/markdown-report/markdown.ml
+++ /dev/null
@@ -1,259 +0,0 @@
-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 * href (** [Link(text,url)] *)
- | Image of string * string (** [Image(alt,location)] *)
-
-and text = inline list
-
-type block_element =
- | Text of text (** single paragraph of text. *)
- | Block_quote of element list
- | UL of block list
- | OL of block list
- | DL of (text * text) list (** definition list *)
- | EL of (string option * text) list (** example list *)
- | Code_block of string * string list
-
-and block = block_element list
-
-and element =
- | Block of block
- | Raw of string list
- (** non-markdown. Each element of the list is printed as-is on its own line.
- A blank line separates the [Raw] node from the next one. *)
- | Comment of string (** markdown comment, printed <!-- like this --> *)
- | H1 of text * string option (** optional label. *)
- | H2 of text * string option
- | H3 of text * string option
- | H4 of text * string option
- | H5 of text * string option
- | H6 of text * string option
- | Table of { caption: text option; header: (text * align) list;
- content: text list list; }
-
-type pandoc_markdown =
- { title: text;
- authors: text list;
- date: text;
- elements: element list
- }
-
-let plain s = [ Plain s]
-
-let plain_format txt = Format.kasprintf plain txt
-
-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](%a)@]@ " pp_text text pp_href url
- | Image (alt,url) -> Format.fprintf fmt "@[<h>@]@ " alt url
-
-and pp_text fmt l =
- match l with
- | [] -> ()
- | [ elt ] -> pp_inline fmt elt
- | elt :: text -> Format.fprintf fmt "%a@ %a" pp_inline elt pp_text text
-
-let pp_lab fmt = function
- | None -> ()
- | Some lab -> Format.fprintf fmt " {#%s}" lab
-
-let test_size txt = String.length (Format.asprintf "%a" pp_text txt)
-
-let pp_dashes fmt size =
- let dashes = String.make (size + 2) '-' in
- Format.fprintf fmt "%s+" dashes
-
-let pp_sep_line fmt sizes =
-Format.fprintf fmt "@[<h>+";
-List.iter (pp_dashes fmt) sizes;
-Format.fprintf fmt "@]@\n"
-
-let pp_header fmt (t,_) size =
- let real_size = test_size t in
- let spaces = String.make (size - real_size) ' ' in
- Format.fprintf fmt " %a%s |" pp_text t spaces
-
-let pp_headers fmt l sizes =
- Format.fprintf fmt "@[<h>|";
- List.iter2 (pp_header fmt) l sizes;
- Format.fprintf fmt "@]@\n"
-
-let compute_sizes headers contents =
- let check_line i m line =
- try max m (test_size (List.nth line i) + 2)
- with Failure _ -> m
- in
- let column_size (i,l) (h,_) =
- let max = List.fold_left (check_line i) (test_size h) contents in
- (i+1, max :: l)
- in
- let (_,sizes) = List.fold_left column_size (0,[]) headers in
- List.rev sizes
-
-let pp_align fmt align size =
- let sep = String.make size '=' in
- match align with
- | (_,Left) -> Format.fprintf fmt ":%s=+" sep
- | (_,Center) -> Format.fprintf fmt ":%s:+" sep
- | (_,Right) -> Format.fprintf fmt "%s=:+" sep
-
-let pp_aligns fmt headers sizes =
- Format.fprintf fmt "@[<h>+";
- List.iter2 (pp_align fmt) headers sizes;
- Format.fprintf fmt "@]@\n"
-
-let pp_table_cell fmt size t =
- let real_size = test_size t in
- let spaces = String.make (size - real_size) ' ' in
- Format.fprintf fmt " %a%s |" pp_text t spaces
-
-let pp_table_line fmt sizes l =
- Format.fprintf fmt "@[<h>|";
- List.iter2 (pp_table_cell fmt) sizes l;
- Format.fprintf fmt "@]@\n";
- pp_sep_line fmt sizes
-
-let pp_table_content fmt l sizes =
- Format.fprintf fmt "@[<v>";
- List.iter (pp_table_line fmt sizes) l;
- Format.fprintf fmt "@]"
-
-let rec pp_block_element fmt = function
- | Text t -> Format.fprintf fmt "@[<hov>%a@]@\n" pp_text t
- | Block_quote l -> pp_quote fmt l
- | UL l -> pp_list "*" fmt l
- | OL l -> pp_list "#." fmt l
- | DL l ->
- List.iter
- (fun (term,def) ->
- Format.fprintf fmt "@[<h>%a@]@\n@\n@[<hov 2>: %a@]@\n@\n"
- pp_text term pp_text def)
- l
- | EL l ->
- List.iter
- (fun (lab,txt) ->
- match lab with
- | None -> Format.fprintf fmt "@[<hov 4>(@@) %a@]@\n" pp_text txt
- | Some s -> Format.fprintf fmt "@[<hov 4>(@@%s) %a@]@\n" s pp_text txt)
- l
- | Code_block (language, lines) ->
- Format.fprintf fmt "@[<h>```%s@]@\n" language;
- List.iter (fun line -> Format.fprintf fmt "@[<h>%s@]@\n" line) lines;
- Format.fprintf fmt "```@\n"
-
-and pp_list prefix fmt l =
- List.iter
- (fun item ->
- Format.fprintf fmt "@[<v 4>@[<hov>%s %a@]@]" prefix pp_block item)
- l
-
-and pp_block fmt l =
- match l with
- | [ elt ] -> pp_block_element fmt elt
- | _ ->
- Format.fprintf fmt "%a@\n"
- (Format.pp_print_list ~pp_sep:Format.pp_force_newline pp_block_element) l
-
-and pp_quote fmt l =
- List.iter
- (fun elt -> Format.fprintf fmt "@[<v>> %a@]" pp_element elt) l
-
-and pp_element fmt = function
- | Block b -> Format.fprintf fmt "@[<v>%a@]" pp_block b
- | Raw l ->
- Format.(
- fprintf fmt "%a"
- (pp_print_list ~pp_sep:pp_force_newline pp_print_string) l)
- | Comment s ->
- Format.fprintf fmt
- "@[<hv>@[<hov 5><!-- %a@]@ -->@]" Format.pp_print_text s
- | H1(t,lab) -> Format.fprintf fmt "@[<h># %a%a@]" pp_text t pp_lab lab
- | H2(t,lab) -> Format.fprintf fmt "@[<h>## %a%a@]" pp_text t pp_lab lab
- | H3(t,lab) -> Format.fprintf fmt "@[<h>### %a%a@]" pp_text t pp_lab lab
- | H4(t,lab) -> Format.fprintf fmt "@[<h>#### %a%a@]" pp_text t pp_lab lab
- | H5(t,lab) -> Format.fprintf fmt "@[<h>##### %a%a@]" pp_text t pp_lab lab
- | H6(t,lab) -> Format.fprintf fmt "@[<h>###### %a%a@]" pp_text t pp_lab lab
- | Table { caption; header; content } ->
- (match caption with
- | None -> ()
- | Some t -> Format.fprintf fmt "@[<h>Table: %a@]@\n@\n" pp_text t);
- let sizes = compute_sizes header content in
- pp_sep_line fmt sizes;
- pp_headers fmt header sizes;
- pp_aligns fmt header sizes;
- pp_table_content fmt content sizes
-
-let pp_elements fmt l =
- let pp_sep fmt () =
- Format.pp_print_newline fmt ();
- Format.pp_print_newline fmt ()
- in
- Format.pp_print_list ~pp_sep pp_element fmt l
-
-let pp_authors fmt l =
- List.iter (fun t -> Format.fprintf fmt "@[<h>- %a@]@\n" pp_text t) l
-
-let pp_pandoc fmt { title; authors; date; elements } =
- Format.fprintf fmt "@[<v>";
- if title <> [] || authors <> [] || date <> [] then begin
- Format.fprintf fmt "@[<h>---@]@\n";
- Format.fprintf fmt "@[<h>title: %a@]@\n" pp_text title;
- Format.fprintf fmt "@[<h>author:@]@\n%a" pp_authors authors;
- Format.fprintf fmt "@[<h>date: %a@]@\n" pp_text date;
- Format.fprintf fmt "@[<h>...@]@\n";
- Format.pp_print_newline fmt ();
- end;
- pp_elements fmt elements;
- Format.fprintf fmt "@]%!"
diff --git a/src/plugins/markdown-report/markdown.mli b/src/plugins/markdown-report/markdown.mli
deleted file mode 100644
index 5580883687bda1d784ca95c2bc7a35f36013e298..0000000000000000000000000000000000000000
--- a/src/plugins/markdown-report/markdown.mli
+++ /dev/null
@@ -1,76 +0,0 @@
-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 * href
- | Image of string * string (** [Image(alt,location)] *)
-
-and text = inline list
-
-type block_element =
- | Text of text (** single paragraph of text. *)
- | Block_quote of element list
- | UL of block list
- | OL of block list
- | DL of (text * text) list (** definition list *)
- | EL of (string option * text) list (** example list *)
- | Code_block of string * string list
-
-and block = block_element list
-
-and element =
- | Block of block
- | Raw of string list
- (** non-markdown. Each element of the list is printed as-is on its own line.
- A blank line separates the [Raw] node from the next one. *)
- | Comment of string (** markdown comment, printed <!-- like this --> *)
- | H1 of text * string option (** optional label. *)
- | H2 of text * string option
- | H3 of text * string option
- | H4 of text * string option
- | H5 of text * string option
- | H6 of text * string option
- | Table of { caption: text option; header: (text * align) list;
- content: text list list; }
-
-type pandoc_markdown =
- { title: text;
- authors: text list;
- date: text;
- elements: element list
- }
-
-val plain: string -> text
-
-val plain_format: ('a, Format.formatter, unit, text) format4 -> 'a
-
-(** gives a link whose text is the URL itself. *)
-val plain_link: string -> inline
-
-(** [codelines lang pp code] returns a [Code_block] for [code], written
-in [lang], as pretty-printed by [pp]. *)
-val codelines:
- string -> (Format.formatter -> 'a -> unit) -> 'a -> block_element
-
-val pp_inline: Format.formatter -> inline -> unit
-
-val pp_text: Format.formatter -> text -> unit
-
-val pp_block_element: Format.formatter -> block_element -> unit
-
-val pp_block: Format.formatter -> block -> unit
-
-val pp_element: Format.formatter -> element -> unit
-
-val pp_elements: Format.formatter -> element list -> unit
-
-val pp_pandoc: Format.formatter -> pandoc_markdown -> unit