[utils/markdown] use smart constructors for text

src/libraries/utils/markdown.ml

@@ -97,17 +97,17 @@ let format txt = Format.kasprintf plain txt
 
 let image ~alt ~file = [Image(alt,file)]
 
-let mklink ?text href =
+let href ?text href =
   let txt =
     match text with Some txt -> txt | None ->
       let tt = match href with URL u -> u | Page p -> p | Section(_,s) -> s in
       [Inline_code tt]
   in [Link(txt, href)]
 
-let url ?text href = mklink ?text (URL href)
+let url ?text addr = href ?text (URL addr)
 
 let link ?text ?page ?name () =
-  mklink ?text @@ match page, name with
+  href ?text @@ match page, name with
   | None, None -> Page ""
   | Some p, None -> Page p
   | None, Some a -> Section("",a)

src/libraries/utils/markdown.mli

@@ -109,6 +109,9 @@ val code: string -> text
 (** Image *)
 val image: alt:string -> file:string -> text
 
+(** Href link *)
+val href: ?text:text -> href -> text
+
 (** Local links *)
 val link: ?text:text -> ?page:string -> ?name:string -> unit -> text
 

src/plugins/markdown-report/md_gen.ml

@@ -74,7 +74,7 @@ let plural l s =
 let get_eva_domains () =
   Extlib.filter_map
     (fun (x,_) -> Dynamic.Parameter.Bool.get x ())
-    (fun (x,y) -> ([Plain "option"; Bold x], plain y))
+    (fun (x,y) -> (plain "option" @ bold x), plain y)
     all_eva_domains
 
 let section_domains env =
@@ -138,7 +138,7 @@ let section_stubs env =
                  Printer.pp_funspec (Annotations.funspec kf) in
              Block ( intro @ funspec ) :: insert_remark env anchor
          in
-         H4 ([Inline_code s], Some anchor) :: content)
+         H4 (code s, Some anchor) :: content)
       l
   in
   let describe_func kf =
@@ -155,7 +155,7 @@ let section_stubs env =
             Printer.pp_global (GFun (Kernel_function.get_definition kf,loc)) in
         Block ( intro @ fundecl ) :: insert_remark env anchor
     in
-    H4 ([Inline_code name], Some anchor) :: content
+    H4 (code name, Some anchor) :: content
   in
   let content =
     if stubbed_kf <> [] then begin
@@ -240,7 +240,7 @@ let gen_inputs env =
          plain "that have been considered during the analysis \
                 are the following:"
         );
-      UL (List.map (fun x -> [Text [ Inline_code x ]]) (get_files()));
+      UL (List.map (fun x -> text @@ code x) (get_files()));
     ]]
 
 let gen_config env =
@@ -339,12 +339,7 @@ let make_events_table print_kind caption events =
     in
     let line =
       [ plain (string_of_pos_opt evt_source);
-        [ Inline_code evt_message;
-          Plain "(emitted by";
-          Inline_code evt_plugin;
-          Plain ")"
-        ]
-      ]
+        format "`%s` (emitted by `%s`)" evt_message evt_plugin ]
     in
     if print_kind then plain (kind evt_kind) :: line else line
   in
@@ -412,15 +407,14 @@ let gen_section_warnings env =
           [ Comment "you can comment on each individual error" ]
         else
           [
-            Block [
-              Text [Bold "Important warning:";
-                    Plain "Frama-C did not complete its execution ";
-                    Plain "successfully. Analysis results may be inaccurate.";
-                    Plain ((plural errs "The error") ^ " listed below must be");
-                    Plain "fixed first before examining other ";
-                    Plain "warnings and alarms."
-                   ];
-            ];
+            Block ( text @@ glue [
+                bold "Important warning:";
+                plain "Frama-C did not complete its execution ";
+                plain "successfully. Analysis results may be inaccurate.";
+                plain ((plural errs "The error") ^ " listed below must be");
+                plain "fixed first before examining other ";
+                plain "warnings and alarms."
+              ] ) ;
             make_errors_table errs
           ]
       in
@@ -434,22 +428,20 @@ let gen_section_warnings env =
       if env.is_draft then
         [Comment "you can comment on each individual error"]
       else
-        [
-          Block [
-            Text [
-              Plain ("The table below lists the " ^ plural warnings "warning");
-              Plain "that have been emitted by the analyzer.";
-              Plain "They might put additional assumptions on the relevance";
-              Plain "of the analysis results and must be reviewed carefully";
-            ];
-            Text (
-              plain "Note that this does not take into account emitted alarms:"@
-              plain "they are reported in"@
-              Markdown.link ~text:(plain "the next section") ~name:"alarms" ()
-            )
-          ];
-          make_warnings_table warnings
-        ]
+        [Block (
+            (text @@ glue [
+                plain ("The table below lists the " ^ plural warnings "warning");
+                plain "that have been emitted by the analyzer.";
+              plain "They might put additional assumptions on the relevance";
+              plain "of the analysis results and must be reviewed carefully";
+              ]) @
+            (text @@ glue [
+                plain "Note that this does not take into account emitted alarms:";
+                plain "they are reported in";
+                link ~text:(plain "the next section") ~name:"alarms" ()
+              ])
+          );
+         make_warnings_table warnings ]
     in
     error_section @
     H1 (plain "Warnings", Some "warnings")
@@ -492,15 +484,13 @@ let gen_section_alarms env =
       if env.is_draft then
         Comment "No alarm!" :: insert_marks env anchor
       else
-        Block [
-          Text
-            [ Bold "No alarm"; Plain "was found during the analysis";
-              Plain "Any execution starting from";
-              Inline_code (Kernel.MainFunction.get_function_name ());
-              Plain "in a context matching the one used for the analysis";
-              Plain "will be immune from any undefined behavior."
-            ]
-        ]
+        Block (text @@ glue [
+            bold "No alarm"; plain "was found during the analysis";
+            plain "Any execution starting from";
+            code (Kernel.MainFunction.get_function_name ());
+            plain "in a context matching the one used for the analysis";
+            plain "will be immune from any undefined behavior."
+          ])
         :: insert_remark env anchor
     in
     H1 (plain "Results of the analysis", Some anchor) :: text_content
@@ -521,18 +511,16 @@ let gen_section_alarms env =
       if env.is_draft then begin
         sections
       end else begin
-        Block [
-          Text
-            [ Plain ("The table below lists the " ^ alarm);
-              Plain "that have been emitted during the analysis.";
-              Plain "Any execution starting from";
-              Inline_code (Kernel.MainFunction.get_function_name());
-              Plain "in a context matching the one used for the analysis";
-              Plain "will be immune from any other undefined behavior.";
-              Plain "More information on each individual alarm is";
-              Plain "given in the remainder of this section"
-            ]
-        ] ::
+        Block (text @@ glue [
+            plain ("The table below lists the " ^ alarm);
+            plain "that have been emitted during the analysis.";
+            plain "Any execution starting from";
+            code (Kernel.MainFunction.get_function_name());
+            plain "in a context matching the one used for the analysis";
+            plain "will be immune from any other undefined behavior.";
+            plain "More information on each individual alarm is";
+            plain "given in the remainder of this section"
+          ]) ::
         Table { content; caption; header } ::
         sections
       end

src/plugins/server/data.ml

@@ -513,8 +513,7 @@ struct
     let header = [ plain E.name, Left; plain "Description", Left ] in
     let content =
       List.map
-        (fun (_,tag,descr) ->
-           [ [Markdown.Inline_code (Printf.sprintf "%S" tag)] ; descr ])
+        (fun (_,tag,descr) -> [ format "`%S`" tag ; descr ])
         E.values
     in
     Table { caption; header; content }

src/plugins/server/doc.ml

@@ -108,11 +108,9 @@ let pages_of_chapter c =
 
 let table_of_chapter c =
   [H2 (Markdown.plain (title_of_chapter c), None);
-   Block
-     [UL
-        (List.map
-           (fun p -> [Text [Link(Markdown.plain p.title, Page p.path)]])
-           (pages_of_chapter c))]]
+   Block (list (List.map
+                  (fun p -> text (link ~text:(plain p.title) ~page:p.path ()))
+                  (pages_of_chapter c)))]
 
 let table_of_contents () =
   table_of_chapter `Protocol @
@@ -124,7 +122,7 @@ let table_of_contents () =
 
 let index () =
   List.map
-    (fun (title,entry) -> Markdown.Link(plain title, entry))
+    (fun (title,entry) -> Markdown.href ~text:(plain title) entry)
     (List.sort (fun (a,_) (b,_) -> String.compare a b) !entries)
 
 let link ~toc ~title ~href : json =
@@ -191,12 +189,12 @@ let dump ~root ?(meta=true) () =
       Yojson.Basic.to_file path maindata ;
       let body =
         [ H1 (plain "Documentation", None);
-          Block [Text [Bold "Version"; Plain Config.version]]]
+          Block (text (format "Version %s" Config.version))]
         @
         table_of_contents ()
         @
         [H2 (plain "Index", None);
-         Block [UL (List.map (fun i -> [Text [i]]) (index ()))]]
+         Block (list (List.map text (index ())))]
       in
       let title = "Documentation" in
       pp_one_page ~root ~page:"readme.md" ~title body

src/plugins/server/syntax.ml

@@ -58,57 +58,54 @@ let flow md = { atomic=false ; text=md }
 let text { text } = text
 
 let protect a =
-  if a.atomic then a.text else Markdown.((Plain "(") :: a.text @ [Plain ")"])
+  if a.atomic then a.text else Markdown.(plain "(" @ a.text @ plain ")")
 
 let publish ~page ~name ~descr ~synopsis ?(details = []) () =
   check_name name ;
   check_page page name ;
   let id = Printf.sprintf "data-%s" name in
   let title = Printf.sprintf "`DATA` %s" name in
-  let href = Doc.href page id in
-  let link_title = Markdown.emph name in
-  let data_link = Markdown.Link(link_title, href) in
-  let syntax = Markdown.(Text (
-      Plain "<" :: data_link :: Plain ">" :: Plain ":=" :: synopsis.text
-    )) in
-  let content = Markdown.((Block [Text descr; syntax]) :: details) in
+  let dref = Doc.href page id in
+  let dlink = Markdown.href ~text:(Markdown.emph name) dref in
+  let syntax = Markdown.(glue [
+      plain "<" ; dlink ; plain ">" ; plain ":=" ; synopsis.text ]) in
+  let content = Markdown.(Block ( text descr @ text syntax ) :: details) in
   let _href = Doc.publish ~page ~name:id ~title ~index:[name] content [] in
-  atom [data_link]
+  atom dlink
 
-let unit = atom [Markdown.Plain "-"]
-let any = atom [Markdown.Emph "any"]
-let int = atom [Markdown.Emph "int"]
-let ident = atom [Markdown.Emph "ident"]
-let string = atom [Markdown.Emph "string"]
-let number = atom [Markdown.Emph "number"]
-let boolean = atom [Markdown.Emph "boolean"]
+let unit = atom @@ Markdown.plain "-"
+let any = atom @@ Markdown.emph "any"
+let int = atom @@ Markdown.emph "int"
+let ident = atom @@ Markdown.emph "ident"
+let string = atom @@ Markdown.emph "string"
+let number = atom @@ Markdown.emph "number"
+let boolean = atom @@ Markdown.emph "boolean"
 
 let escaped name =
-  Markdown.Inline_code (Printf.sprintf "'%s'" @@ String.escaped name)
+  Markdown.code (Printf.sprintf "'%s'" @@ String.escaped name)
 
-let tag name = atom @@ [escaped name]
-
-let array a =
-  atom @@ Markdown.(Inline_code "[" :: protect a @ [Inline_code  ", … ]"])
+let tag name = atom @@ escaped name
+let array a = atom @@ Markdown.(code "[" @ protect a @ code  ", … ]")
 
 let tuple ts =
   atom @@
   Markdown.(
-    Inline_code "[" ::
-    glue ~sep:[Inline_code ","] (List.map protect ts) @
-    [Inline_code "]"])
+    code "[" @
+    glue ~sep:(code ",") (List.map protect ts) @
+    code "]"
+  )
 
 let union ts = flow @@ Markdown.(glue ~sep:(plain "|") (List.map protect ts))
 
-let option t = atom @@ Markdown.(protect t @ [Inline_code "?"])
+let option t = atom @@ Markdown.(protect t @ code "?")
 
-let field (a,t) = Markdown.( escaped a :: Inline_code ":" :: t.text )
+let field (a,t) = Markdown.( escaped a @ code ":" @ t.text )
 
 let record fds =
   let fields =
     if fds = [] then Markdown.plain "…" else
-      Markdown.(glue ~sep:[Inline_code ";"] (List.map field fds))
-  in atom @@ Markdown.(Inline_code "{" :: fields @ [Inline_code "}"])
+      Markdown.(glue ~sep:(code ";") (List.map field fds))
+  in atom @@ Markdown.(code "{" @ fields @ code "}")
 
 type field = {
   name : string ;
@@ -118,13 +115,14 @@ type field = {
 
 let fields ~title (fds : field list) =
   let open Markdown in
-  let caption = Some (plain "Fields description") in
   let header = [
     plain title, Left;
     plain "Format", Center;
     plain "Description", Left
   ] in
-  let field f = [[Inline_code f.name]; f.syntax.text ; f.descr] in
-  Markdown.Table { caption; header; content = List.map field fds }
+  let column f = [ code f.name ; f.syntax.text ; f.descr ] in
+  Markdown.Table {
+    caption = None ; header ; content = List.map column fds ;
+  }
 
 (* -------------------------------------------------------------------------- *)