[server] generator for enumerated values

Application to logs, properties kind & status

src/plugins/server/data.mli

@@ -94,10 +94,6 @@ module Jtext : S with type t = json (** Rich text encoding, see [Jbuffer] *)
 (** {2 Records} *)
 (* -------------------------------------------------------------------------- *)
 
-type 'a record (** Records of type 'a *)
-type 'a signature  (** Opened signature for record of type ['a] *)
-type ('a,'b) field (** Field of type ['b] for a record of type ['a] *)
-
 (** Record factory.
 
     You shall start by declaring a (ghost) type [r] and call
@@ -122,6 +118,10 @@ type ('a,'b) field (** Field of type ['b] for a record of type ['a] *)
 module Record :
 sig
 
+  type 'a record (** Records of type 'a *)
+  type 'a signature  (** Opened signature for record of type ['a] *)
+  type ('a,'b) field (** Field of type ['b] for a record of type ['a] *)
+
   (** Data with [type t = r record].
       Also contains getters and setters for fields. *)
   module type S =
@@ -149,7 +149,72 @@ sig
     ('r,'a option) field
 
   (** Publish and close an opened record *)
-  val publish : 'a signature -> (module S with type r = 'a)
+  val publish : 'a signature ->
+    (module S with type r = 'a)
+
+end
+
+(* -------------------------------------------------------------------------- *)
+(** {2 Enums} *)
+(* -------------------------------------------------------------------------- *)
+
+(** Enum factory.
+
+    You shall start by declaring a dictionnary with
+    [Enum.dictionary] for your values.
+    Then, populate the dictionary with [Enum.tag] values.
+    Finally, you shall call [Enum.publish] to obtain a new data module
+    for your type.
+
+    You have two options for computing tags: either you provide values
+    when declaring tags, and these tags will be associated to registered
+    values for both directions;
+    alternatively you might provide a [~tag] function to [Enum.publish].
+
+    The difficulty when providing values only at tag definition is to ensure
+    that all possible value has been registered.
+
+    The conversion values from and to json may fail when no value has been
+    registered with tags.
+*)
+
+module Enum :
+sig
+
+  type 'a dictionary
+  type 'a tag
+  type 'a prefix = string -> 'a tag
+
+  val name : 'a tag -> string
+
+  (** Creates an opened, empty dictionnary. *)
+  val dictionary :
+    page:Doc.page -> name:string -> descr:Markdown.text ->
+    unit -> 'a dictionary
+
+  (** Register a new tag in the dictionnary.
+      The provided value, if any, will be used for decoding json tags.
+      If would be used also for encoding values to json tags if no [~tag]
+      function is provided when publishing the dictionnary.
+      Registered values must be hashable with [Hashtbl.hash] function. *)
+  val tag : 'a dictionary ->
+    name:string -> descr:Markdown.text -> ?value:'a ->
+    unit -> 'a tag
+
+  (** Register a new prefix tag in the dictionnary.
+      To decoding from json is provided to prefix tags.
+      Encoding is done by emitting tags with form ['prefix:*'].
+      The variable part of the prefix is documented as ['prefix:xxx']
+      when [~var:"xxx"] is provided. *)
+  val prefix : 'a dictionary ->
+    prefix:string -> ?var:string -> descr:Markdown.text -> unit -> 'a prefix
+
+  (** Publish the dictionnary. To more tag nor prefix can be added after.
+      If no [~tag] function is provided, registered values with tags
+      are used. *)
+  val publish : 'a dictionary ->
+    ?tag:('a -> 'a tag) ->
+    unit -> (module S with type t = 'a)
 
 end
 
@@ -196,19 +261,6 @@ end
 (** Builds a {i projectified} index on types with {i unique} identifiers *)
 module Identified(A : IdentifiedType) : Index with type t = A.t
 
-(* -------------------------------------------------------------------------- *)
-(** {2 Dictionary} *)
-(* -------------------------------------------------------------------------- *)
-
-module type Enum =
-sig
-  type t
-  val values : (t * string * Markdown.text) list
-  include Info
-end
-
-module Dictionary(E : Enum) : S_collection with type t = E.t
-
 (* -------------------------------------------------------------------------- *)
 (** {2 Error handling} *)
 (* -------------------------------------------------------------------------- *)

src/plugins/server/kernel_ast.ml

@@ -163,58 +163,6 @@ let () = Request.register ~page
     ~input:(module Kf) ~output:(module Jtext)
     (fun kf -> Jbuffer.to_json PP.pp_global (Kernel_function.get_global kf))
 
-(* -------------------------------------------------------------------------- *)
-(* --- Properties                                                         --- *)
-(* -------------------------------------------------------------------------- *)
-
-module Property = struct
-  type p
-  let signature =
-    Record.signature ~page ~name:"property"
-      ~descr:(Md.plain "logical property") ()
-
-  let name = Record.field signature ~name:"name"
-      ~descr:(Md.plain "name") (module Jstring)
-  let property = Record.field signature ~name:"property"
-      ~descr:(Md.plain "logical property") (module Jstring)
-  let status = Record.field signature ~name:"status"
-      ~descr:(Md.plain "logical status") (module Jstring)
-  let file = Record.field signature ~name:"file"
-      ~descr:(Md.plain "file") (module Jstring)
-  let kf = Record.field signature ~name:"function"
-      ~descr:(Md.plain "kernel function") (module Kf.Joption)
-  let kinstr = Record.field signature ~name:"kinstr"
-      ~descr:(Md.plain "kinstr") (module Ki)
-
-  module R = (val (Record.publish signature) : Record.S with type r = p)
-  include R
-
-  let make ip =
-    let st = Property_status.Feedback.get ip in
-    let st = Format.asprintf "%a" Property_status.Feedback.pretty st in
-    let p = Format.asprintf "%a" Property.pretty ip in
-    let loc = Property.location ip in
-    let path = Filepath.(Normalized.to_pretty_string (fst loc).pos_path) in
-    default |> set property p |> set status st
-    |> set kf (Property.get_kf ip)
-    |> set kinstr (Property.get_kinstr ip)
-    |> set name (Property.Names.get_prop_name_id ip)
-    |> set file path
-end
-
-let get_properties () =
-  Property_status.fold (fun ip acc -> Property.make ip :: acc) []
-
-let () =
-  Request.register
-    ~page
-    ~kind:`GET
-    ~name:"kernel.ast.getProperties"
-    ~descr:(Md.plain "Collect all logical properties")
-    ~input:(module Junit)
-    ~output:(module Jlist (Property))
-    get_properties
-
 (* -------------------------------------------------------------------------- *)
 (* --- Files                                                              --- *)
 (* -------------------------------------------------------------------------- *)

src/plugins/server/kernel_main.ml

@@ -110,21 +110,35 @@ module LogSource = Collection(RawSource)
 
 module RawKind =
 struct
-  type t = Log.kind
-  let page = page
-  let name = "kind"
-  let descr = Md.plain "Frama-C message category."
-  let values = [
-    Log.Error,    "ERROR",    Md.plain "User Error" ;
-    Log.Warning,  "WARNING",  Md.plain "User Warning" ;
-    Log.Feedback, "FEEDBACK", Md.plain "Analyzer Feedback" ;
-    Log.Result,   "RESULT",   Md.plain "Analyzer Result" ;
-    Log.Failure,  "FAILURE",  Md.plain "Analyzer Failure" ;
-    Log.Debug,    "DEBUG",    Md.plain "Analyser Debug" ;
-  ]
+  let kinds = Enum.dictionary ~page
+      ~name:"kind"
+      ~descr:(Md.plain "Frama-C message category.")
+      ()
+
+  let t_kind value name descr =
+    Enum.tag kinds ~name ~descr:(Md.plain descr) ~value ()
+
+  let t_error = t_kind Log.Error "ERROR" "User Error"
+  let t_warning = t_kind Log.Warning "WARNING" "User Warning"
+  let t_feedback = t_kind Log.Feedback "FEEDBACK" "Plugin Feedback"
+  let t_result = t_kind Log.Result "RESULT" "Plugin Result"
+  let t_failure = t_kind Log.Failure "FAILURE" "Plugin Failure"
+  let t_debug = t_kind Log.Debug "DEBUG" "Analyser Debug"
+
+  let tag = function
+    | Log.Error -> t_error
+    | Log.Warning -> t_warning
+    | Log.Feedback -> t_feedback
+    | Log.Result -> t_result
+    | Log.Failure -> t_failure
+    | Log.Debug -> t_debug
+
+  let data = Enum.publish kinds ~tag ()
+
+  include (val data : S with type t = Log.kind)
 end
 
-module LogKind = Dictionary(RawKind)
+module LogKind = Collection(RawKind)
 
 (* -------------------------------------------------------------------------- *)
 (* --- Log Events                                                         --- *)
@@ -135,7 +149,7 @@ struct
 
   type rlog
 
-  let jlog : rlog signature = Record.signature ~page
+  let jlog : rlog Record.signature = Record.signature ~page
       ~name:"log" ~descr:(Md.plain "Message event record.") ()
 
   let kind = Record.field jlog ~name:"kind"

src/plugins/server/kernel_properties.ml

@@ -36,43 +36,159 @@ let page = Doc.page `Kernel ~title:"Property Services" ~filename:"properties.md"
 
 module PropKind =
 struct
-  type t = string
-  let syntax = Sy.publish ~page
+  let kinds = Enum.dictionary ~page
       ~name:"propkind"
       ~descr:(Md.plain "Property Kind")
-      ~synopsis:Sy.string ()
+      ()
+
+  let t_kind name descr = Enum.tag kinds ~name ~descr:(Md.plain descr) ()
+  let t_clause name = t_kind name (Printf.sprintf "Clause `@%s`" name)
+  let t_loop name =
+    t_kind ("loop-" ^ name) (Printf.sprintf "Clause `@loop %s`" name)
+
+  let t_behavior = t_kind "behavior" "Contract behavior"
+  let t_complete = t_kind "complete" "Complete behaviors clause"
+  let t_disjoint = t_kind "disjoint" "Disjoint behaviors clause"
+
+  let t_assumes = t_clause "assumes"
+  let t_requires = t_clause "requires"
+  let t_breaks = t_clause "breaks"
+  let t_continues = t_clause "continues"
+  let t_returns = t_clause "returns"
+  let t_exits = t_clause "exits"
+  let t_ensures = t_clause "ensures"
+  let t_terminates = t_clause "terminates"
+  let t_allocates = t_clause "allocates"
+  let t_decreases = t_clause "decreases"
+  let t_assigns = t_clause "assigns"
+  let t_froms = t_kind "froms" "Clause `@assigns … \\from …`"
+  let t_ext = Enum.prefix kinds ~prefix:"ext" ~var:"<clause>"
+      ~descr:(Md.plain "ACSL extension `<clause>`") ()
+
+  let t_assert = t_clause "assert"
+  let t_loop_invariant = t_loop "invariant"
+  let t_loop_assigns = t_loop "assigns"
+  let t_loop_variant = t_loop "variant"
+  let t_loop_allocates = t_loop "allocates"
+  let t_loop_pragma = t_loop "pragma"
+  let t_loop_ext = Enum.prefix kinds ~prefix:"loop-ext" ~var:"<clause>"
+      ~descr:(Md.plain "ACSL loop extension `loop <clause>`") ()
+
+  let t_reachable = t_kind "reachable" "Reachable statement"
+  let t_code_contract = t_kind "code-contract" "Statement Contract"
+  let t_code_invariant = t_kind "code-invariant" "Generalized loop invariant"
+  let t_type_invariant = t_kind "type-invariant" "Type invariant"
+  let t_global_invariant = t_kind "global-invariant" "Global invariant"
+
+  let t_axiomatic = t_kind "axiomatic" "Axiomatic definitions"
+  let t_axiom = t_kind "axiom" "Logical axiom"
+  let t_lemma = t_kind "lemma" "Logical lemma"
+  let t_other = Enum.prefix kinds ~prefix:"prop" ~var:"<prop>"
+      ~descr:(Md.plain "Plugin Specific properties") ()
+
   open Property
-  let kind = function
-    | IPPredicate _ -> "predicate"
-    | IPExtended { ie_ext={ ext_name } } -> ext_name
-    | IPAxiomatic _ -> "axiomatic"
-    | IPAxiom _ -> "axiom"
-    | IPLemma _ -> "lemma"
-    | IPBehavior _ -> "behavior"
-    | IPComplete _ -> "complete"
-    | IPDisjoint _ -> "disjoint"
+
+  let rec tag = function
+    | IPPredicate { ip_kind } ->
+      begin match ip_kind with
+        | PKRequires _ -> t_requires
+        | PKAssumes _ -> t_assumes
+        | PKEnsures(_,Normal) -> t_ensures
+        | PKEnsures(_,Exits) -> t_exits
+        | PKEnsures(_,Breaks) -> t_breaks
+        | PKEnsures(_,Continues) -> t_continues
+        | PKEnsures(_,Returns) -> t_returns
+        | PKTerminates -> t_terminates
+      end
+    | IPExtended { ie_ext={ ext_name } } -> t_ext ext_name
+    | IPAxiomatic _ -> t_axiomatic
+    | IPAxiom _ -> t_axiom
+    | IPLemma _ -> t_lemma
+    | IPBehavior _ -> t_behavior
+    | IPComplete _ -> t_complete
+    | IPDisjoint _ -> t_disjoint
     | IPCodeAnnot { ica_ca={ annot_content } } ->
       begin match annot_content with
-        | AAssert _ -> "assert"
-        | AStmtSpec _ -> "stmt-contract"
-        | AInvariant(_,false,_) -> "code-invariant"
-        | AInvariant(_,true,_) -> "loop-invariant"
-        | AVariant _ -> "loop-variant"
-        | AAssigns _ -> "loop-assigns"
-        | AAllocation _ -> "loop-allocatation"
-        | APragma _ -> "loop-pragma"
-        | AExtended(_,_,{ext_name}) -> "loop-" ^ ext_name
+        | AAssert _ -> t_assert
+        | AStmtSpec _ -> t_code_contract
+        | AInvariant(_,false,_) -> t_code_invariant
+        | AInvariant(_,true,_) -> t_loop_invariant
+        | AVariant _ -> t_loop_variant
+        | AAssigns _ -> t_loop_assigns
+        | AAllocation _ -> t_loop_allocates
+        | APragma _ -> t_loop_pragma
+        | AExtended(_,_,{ext_name}) -> t_loop_ext ext_name
       end
-    | IPAllocation _ -> "allocation"
-    | IPAssigns _ -> "assigns"
-    | IPFrom _ -> "froms"
-    | IPDecrease _ -> "decrease"
-    | IPReachable _ -> "reachable"
-    | IPPropertyInstance _ -> "instance"
-    | IPTypeInvariant _ -> "type-invariant"
-    | IPGlobalInvariant _ -> "invariant"
-    | IPOther { io_name } -> io_name
-  let to_json = Jstring.to_json
+    | IPAllocation _ -> t_allocates
+    | IPAssigns _ -> t_assigns
+    | IPFrom _ -> t_froms
+    | IPDecrease _ -> t_decreases
+    | IPReachable _ -> t_reachable
+    | IPPropertyInstance { ii_ip } -> tag ii_ip
+    | IPTypeInvariant _ -> t_type_invariant
+    | IPGlobalInvariant _ -> t_global_invariant
+    | IPOther { io_name } -> t_other io_name
+
+
+  let data = Enum.publish kinds ~tag ()
+
+  include (val data : S with type t = Property.t)
+end
+
+(* -------------------------------------------------------------------------- *)
+(* --- Property Status                                                    --- *)
+(* -------------------------------------------------------------------------- *)
+
+module PropStatus =
+struct
+
+  let status = Enum.dictionary ~page ~name:"status"
+      ~descr:(Md.plain "Property Status (consolidated)") ()
+
+  let t_status value name descr =
+    Enum.tag status ~name ~descr:(Md.plain descr) ~value ()
+
+  open Property_status.Feedback
+
+  let t_unknown =
+    t_status Unknown "unknown" "Unknown status"
+  let t_never_tried =
+    t_status Never_tried "never-tried" "Unknown status (never tried)"
+  let t_inconsistent =
+    t_status Inconsistent "inconsistent" "Inconsistent status"
+  let t_valid =
+    t_status Valid "valid" "Valid property"
+  let t_valid_under_hyp =
+    t_status Valid_under_hyp "valid_under_hyp" "Valid (under hypotheses)"
+  let t_considered_valid =
+    t_status Considered_valid "considered_valid" "Valid (external assumption)"
+  let t_invalid =
+    t_status Invalid "invalid" "Invalid property (counter example found)"
+  let t_invalid_under_hyp =
+    t_status Invalid_under_hyp "invalid_under_hyp" "Invalid property (under hypotheses)"
+  let t_invalid_but_dead =
+    t_status Invalid_but_dead "invalid_but_dead" "Dead property (but invalid)"
+  let t_valid_but_dead =
+    t_status Valid_but_dead "valid_but_dead" "Dead property (but valid)"
+  let t_unknown_but_dead =
+    t_status Unknown_but_dead "unknown_but_dead" "Dead property (but unknown)"
+
+  let tag = function
+    | Valid -> t_valid
+    | Invalid -> t_invalid
+    | Unknown -> t_unknown
+    | Never_tried -> t_never_tried
+    | Valid_under_hyp -> t_valid_under_hyp
+    | Valid_but_dead -> t_valid_but_dead
+    | Considered_valid -> t_considered_valid
+    | Invalid_under_hyp -> t_invalid_under_hyp
+    | Invalid_but_dead -> t_invalid_but_dead
+    | Unknown_but_dead -> t_unknown_but_dead
+    | Inconsistent -> t_inconsistent
+
+  let data = Enum.publish status ~tag ()
+
+  include (val data : S with type t = Property_status.Feedback.t)
 end
 
 (* -------------------------------------------------------------------------- *)
@@ -89,14 +205,12 @@ let () = States.column ~model ~name:"descr"
 let () = States.column ~model ~name:"kind"
     ~descr:(Md.plain "Kind")
     ~data:(module PropKind)
-    ~get:(PropKind.kind) ()
+    ~get:(fun ip -> ip) ()
 
 let () = States.column ~model ~name:"status"
     ~descr:(Md.plain "Status")
-    ~data:(module Jstring)
-    ~get:(fun ip ->
-        let st = Property_status.Feedback.get ip
-        in Format.asprintf "%a" Property_status.Feedback.pretty st) ()
+    ~data:(module PropStatus)
+    ~get:(Property_status.Feedback.get) ()
 
 let () = States.column ~model ~name:"function"
     ~descr:(Md.plain "Function")

src/plugins/server/request.ml

@@ -205,7 +205,11 @@ let param (type a b) (s : (unit,b) signature) ~name ~descr
     ?default (input : a input) : a param =
   let module D = (val input) in
   let syntax = if default = None then D.syntax else Syntax.option D.syntax in
-  let fd = Syntax.{ name ; syntax ; descr } in
+  let fd = Syntax.{
+      fd_name = name ;
+      fd_syntax = syntax ;
+      fd_descr = descr ;
+    } in
   s.input <- Pfields (fd :: fds_input s) ;
   fun rq ->
     try D.of_json (Fmap.find name rq.param)
@@ -217,7 +221,11 @@ let param (type a b) (s : (unit,b) signature) ~name ~descr
 let param_opt (type a b) (s : (unit,b) signature) ~name ~descr
     (input : a input) : a option param =
   let module D = (val input) in
-  let fd = Syntax.{ name ; syntax = Syntax.option D.syntax ; descr } in
+  let fd = Syntax.{
+      fd_name = name ;
+      fd_syntax = Syntax.option D.syntax ;
+      fd_descr = descr ;
+    } in
   s.input <- Pfields (fd :: fds_input s) ;
   fun rq ->
     try Some(D.of_json (Fmap.find name rq.param))
@@ -238,7 +246,11 @@ let fds_output s : Syntax.field list =
 let result (type a b) (s : (a,unit) signature) ~name ~descr
     ?default (output : b output) : b result =
   let module D = (val output) in
-  let fd = Syntax.{ name ; syntax = D.syntax ; descr } in
+  let fd = Syntax.{
+      fd_name = name ;
+      fd_syntax = D.syntax ;
+      fd_descr = descr ;
+    } in
   s.output <- Rfields (fd :: fds_output s) ;
   begin
     match default with
@@ -250,7 +262,11 @@ let result (type a b) (s : (a,unit) signature) ~name ~descr
 let result_opt (type a b) (s : (a,unit) signature) ~name ~descr
     (output : b output) : b option result =
   let module D = (val output) in
-  let fd = Syntax.{ name ; syntax = option D.syntax ; descr } in
+  let fd = Syntax.{
+      fd_name = name ;
+      fd_syntax = option D.syntax ;
+      fd_descr = descr ;
+    } in
   s.output <- Rfields (fd :: fds_output s) ;
   fun rq opt ->
     match opt with None -> () | Some v ->

src/plugins/server/states.ml

@@ -98,9 +98,13 @@ let column (type a b) ~(model : a model) ~name ~descr
   let module D = (val data) in
   if name = "key" || name = "index" then
     raise (Invalid_argument "Server.States.column: invalid name") ;
-  if List.exists (fun (fd,_) -> fd.Syntax.name = name) !model then
+  if List.exists (fun (fd,_) -> fd.Syntax.fd_name = name) !model then
     raise (Invalid_argument "Server.States.column: duplicate name") ;
-  let fd = Syntax.{ name ; syntax = D.syntax ; descr } in
+  let fd = Syntax.{
+      fd_name = name ;
+      fd_syntax = D.syntax ;
+      fd_descr = descr ;
+    } in
   model := (fd , fun a -> D.to_json (get a)) :: !model
 
 module Kmap = Map.Make(String)
@@ -257,12 +261,12 @@ let register_array ~page ~name ~descr ?(details=[]) ~key
   let columns = !model in
   let description = [
     Block [Text descr] ;
-    Syntax.fields ~title:(Printf.sprintf "Array %s" name)
+    Syntax.fields ~title:"Columns"
       begin
         Syntax.{
-          name="key" ;
-          syntax=Syntax.ident ;
-          descr=plain "entry identifier" ;
+          fd_name = "key" ;
+          fd_syntax = Syntax.ident ;
+          fd_descr = plain "entry identifier" ;
         } :: List.rev (List.map fst columns)
       end ;
     Block details
@@ -270,7 +274,7 @@ let register_array ~page ~name ~descr ?(details=[]) ~key
   let mref = Doc.publish ~page:page ~name:name ~title ~index description [] in
   let signal = Request.signal ~page ~name:(name ^ ".sig")
       ~descr:(plain "Signal for array " @ href mref) () in
-  let getter = List.map (fun (fd,to_js) -> fd.Syntax.name , to_js) columns in
+  let getter = List.map Syntax.(fun (fd,to_js) -> fd.fd_name , to_js) columns in
   let array = {
     key ; iter ; getter ; signal ;
     current = None ; projects = Hashtbl.create 0

src/plugins/server/syntax.ml

@@ -74,6 +74,8 @@ let publish ~page ~name ~descr ~synopsis ?(details = []) () =
   let _href = Doc.publish ~page ~name:id ~title ~index content [] in
   atom dlink
 
+(* -------------------------------------------------------------------------- *)
+
 let unit = atom @@ Markdown.plain "-"
 let any = atom @@ Markdown.emph "any"
 let int = atom @@ Markdown.emph "int"
@@ -101,30 +103,50 @@ let union ts = flow @@ Markdown.(glue ~sep:(plain "|") (List.map protect ts))
 
 let option t = atom @@ Markdown.(protect t @ code "?")
 
-let field (a,t) = Markdown.( escaped a @ code ":" @ t.text )
+(* -------------------------------------------------------------------------- *)
+
+type tag = {
+  tag_name : string ;
+  tag_descr : Markdown.text ;
+}
+
+let tags ?(title="Tag") (tgs : tag list) =
+  let open Markdown in
+  let header = [
+    plain title, Left;
+    plain "Description", Left
+  ] in
+  let row tg = [ escaped tg.tag_name ; tg.tag_descr ] in
+  Markdown.Table {
+    caption = None ; header ; content = List.map row tgs ;
+  }
+
+(* -------------------------------------------------------------------------- *)
+
+let mfield (a,t) = Markdown.( escaped a @ code ":" @ t.text )
 
 let record fds =
   let fields =
     if fds = [] then Markdown.plain "…" else
-      Markdown.(glue ~sep:(code ";") (List.map field fds))
+      Markdown.(glue ~sep:(code ";") (List.map mfield fds))
   in atom @@ Markdown.(code "{" @ fields @ code "}")
 
 type field = {
-  name : string ;
-  syntax : t ;
-  descr : Markdown.text ;
+  fd_name : string ;
+  fd_syntax : t ;
+  fd_descr : Markdown.text ;
 }
 
-let fields ~title (fds : field list) =
+let fields ?(title="Field") (fds : field list) =
   let open Markdown in
   let header = [
     plain title, Left;
     plain "Format", Center;
     plain "Description", Left
   ] in
-  let column f = [ code f.name ; f.syntax.text ; f.descr ] in
+  let row f = [ code f.fd_name ; f.fd_syntax.text ; f.fd_descr ] in
   Markdown.Table {
-    caption = None ; header ; content = List.map column fds ;
+    caption = None ; header ; content = List.map row fds ;
   }
 
 (* -------------------------------------------------------------------------- *)

src/plugins/server/syntax.mli

@@ -51,10 +51,18 @@ val option : t -> t
 val record : (string * t) list -> t
 val data : string -> Markdown.href -> t
 
-type field = { name : string ; syntax : t ; descr : Markdown.text }
+type tag = { tag_name : string ; tag_descr : Markdown.text }
 
-(** Builds a table with fields column named with [~title]
-    (shall be capitalized) *)
-val fields : title:string -> field list -> Markdown.element
+(** Builds a table with tags description.
+    The [~title] is applied to the tag name column
+    (shall be capitalized, defaults to ["Tag"]). *)
+val tags : ?title:string -> tag list -> Markdown.element
+
+type field = { fd_name : string ; fd_syntax : t ; fd_descr : Markdown.text }
+
+(** Builds a table with fields description.
+    The [~title] is applied to the field name column
+    (shall be capitalized, defaults to ["Field"]). *)
+val fields : ?title:string -> field list -> Markdown.element
 
 (* -------------------------------------------------------------------------- *)