diff --git a/src/libraries/utils/markdown.ml b/src/libraries/utils/markdown.ml
index b3dee1aa4397b30430e863f8950d9ce687db2274..7dfc82b72a14638171ce8098e675d4a926f1ca0d 100644
--- a/src/libraries/utils/markdown.ml
+++ b/src/libraries/utils/markdown.ml
@@ -137,6 +137,7 @@ let quote text = if text = [] then [] else [Block [Block_quote [Block [Text text
let block block = if block = [] then [] else [Block block]
let list items = if items = [] then [] else [UL items]
let enum items = if items = [] then [] else [OL items]
+let table table = if table.content = [] then [] else [Table table]
let description items = if items = [] then [] else [DL items]
(* -------------------------------------------------------------------------- *)
diff --git a/src/libraries/utils/markdown.mli b/src/libraries/utils/markdown.mli
index 7e2ca85932b59c76d2ef0dd020cd4be33b03c7b6..08bbe4125414b1adbb252caf89c91b6dd259cb18 100644
--- a/src/libraries/utils/markdown.mli
+++ b/src/libraries/utils/markdown.mli
@@ -167,6 +167,9 @@ val quote : text -> elements
(** Block element *)
val block : block -> elements
+(** Table element *)
+val table : table -> elements
+
(** Get the content of a file as raw markdown.
@raise Sys_error if there's no such file.
*)
diff --git a/src/plugins/server/package.ml b/src/plugins/server/package.ml
index 1d0af882b033f3fa78ce2175b21d0d52a41fd124..a63460cc2ca74b3ad6eb3830a64c6450ae694aa1 100644
--- a/src/plugins/server/package.ml
+++ b/src/plugins/server/package.ml
@@ -158,7 +158,7 @@ type jtype =
| Jnumber
| Jstring
| Jtag of string
- | Jkind of string
+ | Jindex of string (* kind of a string used for indexing *)
| Joption of jtype
| Jassoc of string * jtype
| Jarray of jtype
@@ -178,6 +178,12 @@ type fieldInfo = {
fd_descr: Markdown.text;
}
+type tagInfo = {
+ tg_name: string;
+ tg_label: Markdown.text;
+ tg_descr: Markdown.text;
+}
+
type paramInfo =
| P_value of jtype
| P_named of fieldInfo list
@@ -191,6 +197,7 @@ type requestInfo = {
type declKindInfo =
| D_signal
| D_type of jtype
+ | D_enum of tagInfo list
| D_record of fieldInfo list
| D_request of requestInfo
@@ -213,7 +220,7 @@ type packageInfo = {
let rec visit_jtype fn = function
| Jany | Jself | Jnull | Jboolean | Jnumber
- | Jstring | Jkind _ | Jtag _ -> ()
+ | Jstring | Jindex _ | Jtag _ -> ()
| Joption js | Jassoc(_,js) | Jarray js -> visit_jtype fn js
| Jtuple js | Junion js -> List.iter (visit_jtype fn) js
| Jrecord fjs -> List.iter (fun (_,js) -> visit_jtype fn js) fjs
@@ -230,6 +237,7 @@ let visit_request f { rq_input ; rq_output } =
let visit_dkind f = function
| D_signal -> ()
+ | D_enum _ -> ()
| D_type js -> visit_jtype f js
| D_record fds -> List.iter (visit_field f) fds
| D_request rq -> visit_request f rq
@@ -349,7 +357,7 @@ let escaped tag = Md.code (Printf.sprintf "\"%s\"" @@ String.escaped tag)
type pp = {
self: Md.text ;
data: ident -> Md.text ;
- kind: string -> Md.text ;
+ index: string -> Md.text ;
}
let rec md_jtype pp = function
@@ -360,7 +368,7 @@ let rec md_jtype pp = function
| Jboolean -> Md.emph "boolean"
| Jstring -> Md.emph "string"
| Jtag tag -> escaped tag
- | Jkind kd -> pp.kind kd
+ | Jindex kd -> pp.index kd
| Jdata id -> pp.data id
| Joption js -> protect pp js @ Md.code "?"
| Jtuple js -> Md.code "[" @ md_jlist pp "," js @ Md.code "]"
@@ -368,7 +376,7 @@ let rec md_jtype pp = function
| Jarray js -> protect pp js @ Md.code "[]"
| Jrecord fjs -> Md.code "{" @ fields pp fjs @ Md.code "}"
| Jassoc (id,js) ->
- Md.code "{[" @ pp.kind id @ Md.code "]:" @ md_jtype pp js @ Md.code "}"
+ Md.code "{[" @ pp.index id @ Md.code "]:" @ md_jtype pp js @ Md.code "}"
and md_jlist pp sep js =
Md.glue ~sep:(Md.plain sep) (List.map (md_jtype pp) js)
@@ -387,13 +395,47 @@ and protect names js =
| Junion _ -> Md.code "(" @ md_jtype names js @ Md.code ")"
| _ -> md_jtype names js
+(* -------------------------------------------------------------------------- *)
+(* --- Tags & Fields --- *)
+(* -------------------------------------------------------------------------- *)
+
+let md_tags ?(title="Tags") (tags : tagInfo list) =
+ let header = Md.[
+ plain title, Left;
+ plain "Value", Left;
+ plain "Description", Left
+ ] in
+ let row tg = [
+ tg.tg_label ;
+ escaped tg.tg_name ;
+ tg.tg_descr ;
+ ] in
+ Md.{ caption = None ; header ; content = List.map row tags }
+
+let md_fields ?(title="Field") pp (fields : fieldInfo list) =
+ let header = Md.[
+ plain title, Left;
+ plain "Format", Center;
+ plain "Description", Left;
+ ] in
+ let row f = [
+ escaped f.fd_name ;
+ md_jtype pp f.fd_type ;
+ f.fd_descr ;
+ ] in
+ Md.{ caption = None ; header ; content = List.map row fields }
+
+(* -------------------------------------------------------------------------- *)
+(* --- Printer --- *)
+(* -------------------------------------------------------------------------- *)
+
let pp_jtype fmt js =
let scope = Scope.create Kernel in
visit_jtype (Scope.use scope) js ;
let ns = Scope.resolve scope in
let self = Md.emph "self" in
- let kind id = Md.code (Printf.sprintf "#%s" id) in
let data id = Md.emph (IdMap.find id ns) in
- Markdown.pp_text fmt (md_jtype { kind ; data ; self } js)
+ let index id = Md.code (Printf.sprintf "#%s" id) in
+ Markdown.pp_text fmt (md_jtype { index ; data ; self } js)
(* -------------------------------------------------------------------------- *)
diff --git a/src/plugins/server/package.mli b/src/plugins/server/package.mli
index af0e0527c8eb8f9699261fc42fc77b58c2bc60e1..b55f19a5feb746561438b62e12d356342036a541 100644
--- a/src/plugins/server/package.mli
+++ b/src/plugins/server/package.mli
@@ -35,7 +35,7 @@ type jtype =
| Jnumber
| Jstring
| Jtag of string (** Enum constant tag *)
- | Jkind of string (** Kind of ids (actually strings) *)
+ | Jindex of string (** Kind of ids (actually strings) *)
| Joption of jtype (** Value or 'null' *)
| Jassoc of string * jtype (** Dictionary for kind of ids *)
| Jarray of jtype
@@ -51,6 +51,12 @@ type fieldInfo = {
fd_descr: Markdown.text;
}
+type tagInfo = {
+ tg_name: string;
+ tg_label: Markdown.text;
+ tg_descr: Markdown.text;
+}
+
type paramInfo =
| P_value of jtype
| P_named of fieldInfo list
@@ -64,6 +70,7 @@ type requestInfo = {
type declKindInfo =
| D_signal
| D_type of jtype
+ | D_enum of tagInfo list
| D_record of fieldInfo list
| D_request of requestInfo
@@ -151,11 +158,13 @@ val resolve : ?keywords: string list -> packageInfo -> string IdMap.t
type pp = {
self: Markdown.text ;
data: ident -> Markdown.text ;
- kind: string -> Markdown.text ;
+ index: string -> Markdown.text ;
}
val escaped : string -> Markdown.text
val md_jtype : pp -> jtype -> Markdown.text
+val md_tags : ?title:string -> tagInfo list -> Markdown.table
+val md_fields : ?title:string -> pp -> fieldInfo list -> Markdown.table
(* -------------------------------------------------------------------------- *)
diff --git a/src/plugins/server/server_doc.ml b/src/plugins/server/server_doc.ml
index 55608090ec57b5e86eaf972a6ce5865a34113cb4..3c200306863555f3637b2a203258771144efeea7 100644
--- a/src/plugins/server/server_doc.ml
+++ b/src/plugins/server/server_doc.ml
@@ -142,34 +142,21 @@ let fullname_of_ident id =
let kind_of_decl = function
| D_signal -> "SIGNAL"
- | D_type _ | D_record _ -> "DATA"
+ | D_type _ | D_record _ | D_enum _ -> "DATA"
| D_request { rq_kind=`GET } -> "GET"
| D_request { rq_kind=`SET } -> "SET"
| D_request { rq_kind=`EXEC } -> "EXEC"
+let md_index kind = Md.code (Printf.sprintf "#%s" kind)
+
let pp_for ?decl names =
let self = match decl with Some d -> d.d_ident.name | None -> "self" in
- {
+ Package.{
self = Md.emph self ;
data = href_of_ident names ;
- kind = (fun tag -> Md.code (Printf.sprintf "#%s" tag)) ;
+ index = md_index ;
}
-let descr_of_fields ?(title="Field") pp (fields : fieldInfo list) =
- let header = [
- Md.plain title, Md.Left;
- Md.plain "Format", Md.Center;
- Md.plain "Description", Md.Left;
- ] in
- let row f = [
- Package.escaped f.fd_name ;
- Package.md_jtype pp f.fd_type ;
- f.fd_descr ;
- ] in
- [Md.Table {
- caption = None ; header ; content = List.map row fields ;
- }]
-
let descr_of_decl names decl =
match decl.d_kind with
| D_signal -> []
@@ -179,7 +166,11 @@ let descr_of_decl names decl =
| D_record fields ->
let pp = pp_for ~decl names in
Md.quote (pp.self @ Md.code "::= { … }") @
- descr_of_fields pp fields
+ Md.table (Package.md_fields pp fields)
+ | D_enum tags ->
+ let pp = pp_for ~decl names in
+ Md.quote (pp.self @ Md.code "::=" @ Md.emph "tags…") @
+ Md.table (Package.md_tags tags)
| _ -> []
let declaration page names decl =