[server] move doc to Server_doc

headers/header_spec.txt

@@ -1112,8 +1112,6 @@ src/plugins/server/Server.mli: .ignore
 src/plugins/server/configure.ac: CEA_LGPL_OR_PROPRIETARY
 src/plugins/server/data.ml: CEA_LGPL_OR_PROPRIETARY
 src/plugins/server/data.mli: CEA_LGPL_OR_PROPRIETARY
-src/plugins/server/doc.ml: CEA_LGPL_OR_PROPRIETARY
-src/plugins/server/doc.mli: CEA_LGPL_OR_PROPRIETARY
 src/plugins/server/jbuffer.ml: CEA_LGPL_OR_PROPRIETARY
 src/plugins/server/jbuffer.mli: CEA_LGPL_OR_PROPRIETARY
 src/plugins/server/kernel_ast.ml: CEA_LGPL_OR_PROPRIETARY
@@ -1130,6 +1128,8 @@ src/plugins/server/package.ml: CEA_LGPL_OR_PROPRIETARY
 src/plugins/server/package.mli: CEA_LGPL_OR_PROPRIETARY
 src/plugins/server/request.ml: CEA_LGPL_OR_PROPRIETARY
 src/plugins/server/request.mli: CEA_LGPL_OR_PROPRIETARY
+src/plugins/server/server_doc.ml: CEA_LGPL_OR_PROPRIETARY
+src/plugins/server/server_doc.mli: CEA_LGPL_OR_PROPRIETARY
 src/plugins/server/server_parameters.ml: CEA_LGPL_OR_PROPRIETARY
 src/plugins/server/server_parameters.mli: CEA_LGPL_OR_PROPRIETARY
 src/plugins/server/server_batch.ml: CEA_LGPL_OR_PROPRIETARY

src/plugins/server/Makefile.in

@@ -40,7 +40,8 @@ PLUGIN_CMO:= \
 	server_parameters \
 	jbuffer \
 	package \
-	doc syntax data \
+	server_doc \
+	syntax data \
 	main request states \
 	server_batch \
 	kernel_main \
@@ -80,7 +81,8 @@ include $(FRAMAC_SHARE)/Makefile.dynamic
 ##############
 
 SERVER_API= \
-	doc.mli syntax.mli data.mli request.mli states.mli \
+	package.mli server_doc.mli \
+	syntax.mli data.mli request.mli states.mli \
 	kernel_main.mli \
 	kernel_ast.mli \
 	kernel_properties.mli

src/plugins/server/data.ml

@@ -40,7 +40,7 @@ end
 
 module type Info =
 sig
-  val page : Doc.page
+  val page : Server_doc.page
   val name : string
   val descr : Markdown.text
 end
@@ -63,7 +63,7 @@ let failure ?json msg =
 let failure_from_type_error msg json =
   failure ~json "%s" msg
 
-let page = Doc.page `Kernel ~title:"Basic Types" ~filename:"data.md"
+let page = Server_doc.page `Kernel ~title:"Basic Types" ~filename:"data.md" ()
 
 (* -------------------------------------------------------------------------- *)
 (* --- Option                                                             --- *)
@@ -221,7 +221,7 @@ module Jident : S_collection with type t = string =
       let to_json s = `String s
     end)
 
-let text_page = Doc.page `Kernel ~title:"Rich Text Format" ~filename:"text.md"
+let text_page = Server_doc.page `Kernel ~title:"Rich Text Format" ~filename:"text.md" ()
 
 module Jtext =
 struct
@@ -248,7 +248,7 @@ struct
   }
 
   type 'a signature = {
-    page : Doc.page ;
+    page : Server_doc.page ;
     name : string ;
     descr : Markdown.text ;
     mutable fields : Syntax.field list ;
@@ -395,7 +395,7 @@ module Enum =
 struct
 
   type 'a dictionary = {
-    page : Doc.page ;
+    page : Server_doc.page ;
     name : string ;
     title : string ;
     descr : Markdown.text ;

src/plugins/server/data.mli

@@ -57,7 +57,7 @@
 
 type json = Json.t
 
-val page : Doc.page (** Documentation page for general purpose data types. *)
+val page : Server_doc.page (** Documentation page for general purpose data types. *)
 val pretty : Format.formatter -> json -> unit
 
 (** Datatype module signature. *)
@@ -73,7 +73,7 @@ end
 (** Datatype informations. *)
 module type Info =
 sig
-  val page : Doc.page
+  val page : Server_doc.page
   val name : string
   val descr : Markdown.text
 end
@@ -167,7 +167,7 @@ sig
   end
 
   (** Create a new, opened record type. *)
-  val signature : page:Doc.page -> name:string -> descr:Markdown.text ->
+  val signature : page:Server_doc.page -> name:string -> descr:Markdown.text ->
     unit -> 'a signature
 
   (** Adds a field to an opened record. *)
@@ -219,7 +219,7 @@ sig
 
   (** Creates an opened, empty dictionary. *)
   val dictionary :
-    page:Doc.page -> name:string -> title:string -> descr:Markdown.text ->
+    page:Server_doc.page -> name:string -> title:string -> descr:Markdown.text ->
     unit -> 'a dictionary
 
   (** Register a new tag in the dictionary.
@@ -267,7 +267,7 @@ sig
   (** Obtain all the tags registered in the dictionary so far. *)
   val tags : 'a dictionary -> Tag.t list
 
-  val page : 'a dictionary -> Doc.page
+  val page : 'a dictionary -> Server_doc.page
   val name : 'a dictionary -> string
   val syntax : 'a dictionary -> Markdown.text
 

src/plugins/server/kernel_ast.ml

@@ -26,7 +26,7 @@ module Md = Markdown
 module Js = Yojson.Basic.Util
 open Cil_types
 
-let page = Doc.page `Kernel ~title:"Ast Services" ~filename:"ast.md"
+let page = Server_doc.page `Kernel ~title:"Ast Services" ~filename:"ast.md" ()
 
 (* -------------------------------------------------------------------------- *)
 (* --- Compute Ast                                                        --- *)

src/plugins/server/kernel_main.ml

@@ -29,7 +29,7 @@ module Senv = Server_parameters
 (* --- Frama-C Kernel Services                                            --- *)
 (* -------------------------------------------------------------------------- *)
 
-let page = Doc.page `Kernel ~title:"Kernel Services" ~filename:"kernel.md"
+let page = Server_doc.page `Kernel ~title:"Kernel Services" ~filename:"kernel.md" ()
 
 (* -------------------------------------------------------------------------- *)
 (* --- Config                                                             --- *)

src/plugins/server/kernel_project.ml

@@ -25,7 +25,7 @@ module Sy = Syntax
 module Md = Markdown
 module Js = Yojson.Basic.Util
 
-let page = Doc.page `Kernel ~title:"Project Management" ~filename:"project.md"
+let page = Server_doc.page `Kernel ~title:"Project Management" ~filename:"project.md" ()
 
 (* -------------------------------------------------------------------------- *)
 (* --- Project Info                                                       --- *)

src/plugins/server/kernel_properties.ml

@@ -26,7 +26,7 @@ open Data
 open Kernel_main
 open Kernel_ast
 
-let page = Doc.page `Kernel ~title:"Property Services" ~filename:"properties.md"
+let page = Server_doc.page `Kernel ~title:"Property Services" ~filename:"properties.md" ()
 
 (* -------------------------------------------------------------------------- *)
 (* --- Property Kind                                                      --- *)

src/plugins/server/package.ml

@@ -260,6 +260,7 @@ type package = {
 
 let registry = ref IdSet.empty (* including packages *)
 let packages = ref [] (* in reverse order *)
+let collection = ref None (* computed *)
 
 let name_re = Str.regexp "^[a-zA-Z0-9]+$"
 let package_re = Str.regexp "^[a-z0-9]+\\(\\.[a-z0-9]+\\)*$"
@@ -280,7 +281,7 @@ let register_ident id =
     Senv.fatal "Duplicate identifier '%a'" pp_ident id ;
   registry := IdSet.add id !registry
 
-let userdoc ~plugin ~title ?(descr=[]) = function
+let userdoc ~plugin ~title ~descr = function
   | None -> Md.section ~title (Md.block descr)
   | Some readme ->
     let file =
@@ -298,13 +299,12 @@ let userdoc ~plugin ~title ?(descr=[]) = function
 (* --- Declarations                                                       --- *)
 (* -------------------------------------------------------------------------- *)
 
-let package ?plugin ?descr ?readme ~name () =
+let package ?(plugin=Kernel) ?(descr=[]) ?readme ~name () =
   check_package name ;
-  let plugin = match plugin with None -> Kernel | Some p -> Plugin p in
   let pkgname = String.split_on_char '.' name in
   let pkgid = { plugin ; package = pkgname ; name = "*"} in
   let title = Printf.sprintf "Package %s" name in
-  let userdoc = userdoc ~plugin ~title ?descr readme in
+  let userdoc = userdoc ~plugin ~title ~descr readme in
   let pkgInfo = {
     d_plugin = plugin ;
     d_package = pkgname ;
@@ -313,6 +313,7 @@ let package ?plugin ?descr ?readme ~name () =
   } in
   let package = { pkgInfo ; revDecl=[] } in
   register_ident pkgid ;
+  collection := None ;
   packages := package :: !packages ;
   package
 
@@ -325,13 +326,16 @@ let declare ~package:pkg ~name ?(descr=[]) decl =
   pkg.revDecl <- decl :: pkg.revDecl
 
 let iter f =
-  begin
-    List.iter f @@
-    List.sort (fun a b -> Std.compare a.d_plugin b.d_plugin) @@
-    List.rev_map
-      (fun pkg -> { pkg.pkgInfo with d_content = List.rev pkg.revDecl })
-      !packages
-  end
+  List.iter f @@
+  match !collection with
+  | Some pkgs -> pkgs
+  | None ->
+    let pkgs =
+      List.sort (fun a b -> Std.compare a.d_plugin b.d_plugin) @@
+      List.rev_map
+        (fun pkg -> { pkg.pkgInfo with d_content = List.rev pkg.revDecl })
+          !packages
+    in collection := Some pkgs ; pkgs
 
 (* -------------------------------------------------------------------------- *)
 (* --- JSON To MarkDown                                                   --- *)

src/plugins/server/package.mli

@@ -120,7 +120,7 @@ val visit_package_used: (ident -> unit) -> packageInfo -> unit
 type package
 
 val package :
-  ?plugin:string ->
+  ?plugin:plugin ->
   ?descr:Markdown.block ->
   ?readme:string ->
   name:string ->

src/plugins/server/request.ml

@@ -74,7 +74,7 @@ let check_plugin plugin name =
       name (String.capitalize_ascii plugin)
 
 let check_page page name =
-  match Doc.chapter page with
+  match Server_doc.chapter page with
   | `Kernel -> check_plugin "kernel" name
   | `Plugin plugin -> check_plugin plugin name
   | `Protocol ->
@@ -82,7 +82,7 @@ let check_page page name =
       "Request '%s' shall not be published in protocol pages" name
 
 let page_prefix page =
-  match Doc.chapter page with
+  match Server_doc.chapter page with
   | `Kernel -> "kernel"
   | `Plugin plugin -> plugin
   | `Protocol -> "protocol"
@@ -100,7 +100,7 @@ let signal ~page ~name ~descr  ?(details=[]) () =
   let title =  Printf.sprintf "`SIG` %s" name in
   let index = [ Printf.sprintf "%s (`SIGNAL`)" name ] in
   let contents = [ Block [Text descr] ; Block details] in
-  let _ = Doc.publish ~page ~name ~title ~index ~contents () in
+  let _ = Server_doc.publish ~page ~name ~title ~index ~contents () in
   Main.signal name
 
 let emit = Main.emit
@@ -175,7 +175,7 @@ let doc_output (type b) (output : b rq_output) =
 (* -------------------------------------------------------------------------- *)
 
 type ('a,'b) signature = {
-  page : Doc.page ;
+  page : Server_doc.page ;
   kind : kind ;
   name : string ;
   descr : Markdown.text ;
@@ -346,7 +346,7 @@ let register_sig (type a b) (s : (a,b) signature) (process : rq -> a -> b) =
     Block ( Text s.descr :: input :: output :: s.details ) ::
     ( doc_input s.input @ doc_output s.output )
   in
-  let _ = Doc.publish ~page:s.page ~name:s.name ~title ~index ~contents () in
+  let _ = Server_doc.publish ~page:s.page ~name:s.name ~title ~index ~contents () in
   Main.register s.kind s.name processor ;
   s.defined <- true
 

src/plugins/server/request.mli

@@ -60,7 +60,7 @@ type signal
 
 (** Register a server signal. The signal [name] must be unique. *)
 val signal :
-  page:Doc.page ->
+  page:Server_doc.page ->
   name:string ->
   descr:Markdown.text ->
   ?details:Markdown.block ->
@@ -87,7 +87,7 @@ val on_signal : signal -> (bool -> unit) -> unit
 
 *)
 val register :
-  page:Doc.page ->
+  page:Server_doc.page ->
   kind:kind ->
   name:string ->
   descr:Markdown.text ->
@@ -133,7 +133,7 @@ type ('a,'b) signature
     you shall define named parameters and results before registering the
     request processing function. *)
 val signature :
-  page:Doc.page ->
+  page:Server_doc.page ->
   kind:kind ->
   name:string ->
   descr:Markdown.text ->

src/plugins/server/server_batch.ml

@@ -52,7 +52,9 @@ module BatchOutputDir = Senv.Empty_string
          directory."
     end)
 
-let _ = Doc.page `Protocol ~title:"Batch Protocol" ~filename:"server_batch.md"
+let () = Server_doc.protocole
+    ~title:"Batch Protocol"
+    ~filename:"server_batch.md"
 
 
 (* -------------------------------------------------------------------------- *)

src/plugins/server/doc.ml → src/plugins/server/server_doc.ml

@@ -60,12 +60,14 @@ let href page name : Markdown.href = Section( page.path , name )
 
 let chapter pg = pg.chapter
 
-let page chapter ~title ~filename =
-  let rootdir,path = match chapter with
-    | `Protocol -> "." , filename
-    | `Kernel -> ".." , Printf.sprintf "kernel/%s" filename
-    | `Plugin name -> "../.." , Printf.sprintf "plugins/%s/%s" name filename
-  in
+let path_for chapter filename =
+  match chapter with
+  | `Protocol -> "." , filename
+  | `Kernel -> ".." , Printf.sprintf "kernel/%s" filename
+  | `Plugin name -> "../.." , Printf.sprintf "plugins/%s/%s" name filename
+
+let page chapter ~title ?(descr=[]) ~filename () =
+  let rootdir , path = path_for chapter filename in
   try
     let other = Pages.find path !pages in
     Senv.failure "Duplicate page '%s' path@." path ; other
@@ -80,8 +82,8 @@ let page chapter ~title ~filename =
         Printf.sprintf "%s/%s/server/%s" Fc_config.datadir name filename in
     let intro =
       if Sys.file_exists intro
-      then Markdown.rawfile intro
-      else Markdown.(section ~title []) in
+      then descr @ Markdown.rawfile intro
+      else Markdown.(section ~title descr) in
     let order = incr order ; !order in
     let page = { order ; rootdir ; path ;
                  chapter ; title ; intro ;
@@ -100,7 +102,43 @@ let publish ~page ?name ?(index=[]) ~title
   List.iter (fun entry -> entries := (entry , href) :: !entries) index ;
   page.sections <- section :: page.sections ; href
 
-let _ = page `Protocol ~title:"Architecture" ~filename:"server.md"
+let protocole ~title ~filename =
+  ignore (page `Protocol ~title ~filename ())
+
+let () = protocole ~title:"Architecture" ~filename:"server.md"
+
+(* -------------------------------------------------------------------------- *)
+(* --- Package Publication                                                --- *)
+(* -------------------------------------------------------------------------- *)
+
+let page_of_package pkg =
+  let open Package in
+  let chapter = match pkg.d_plugin with
+    | Kernel -> `Kernel | Plugin p -> `Plugin p in
+  let filename = String.concat "_" pkg.d_package ^ ".md" in
+  try
+    let _,path = path_for chapter filename in
+    Pages.find path !pages
+  with Not_found ->
+    let path = match pkg.d_plugin with
+      | Kernel -> pkg.d_package
+      | Plugin p -> p :: pkg.d_package in
+    let title = Printf.sprintf "Package %s" (String.concat "." path) in
+    page chapter ~title ~descr:pkg.d_userdoc ~filename ()
+
+let declaration page links decl =
+  let open Package in
+  let name = decl.d_ident.name in
+  let contents = block decl.d_descr in
+  let href = publish ~page ~name ~contents () in
+  links := IdMap.add decl.d_ident href !links
+
+let package pkg =
+  begin
+    let page = page_of_package pkg in
+    let links = ref Package.IdMap.empty in
+    List.iter (declaration page links) pkg.Package.d_content ;
+  end
 
 (* -------------------------------------------------------------------------- *)
 (* --- Tables of Content                                                  --- *)

src/plugins/server/doc.mli → src/plugins/server/server_doc.mli

@@ -44,7 +44,8 @@ val chapter : page -> chapter
     - [frama-c/share/server/kernel/<filename>] for kernel pages,
     - [frama-c/share/<plugin>/server/<filename>] for plugin's pages.
 *)
-val page : chapter -> title:string -> filename:string -> page
+val page : chapter -> title:string -> ?descr:elements -> filename:string ->
+  unit ->page
 
 (** Adds a section in the corresponding page.
     Returns an href to the published section.
@@ -60,6 +61,12 @@ val publish :
   ?generated:(unit -> Markdown.elements) ->
   unit -> Markdown.href
 
+(** Publish a protocole. *)
+val protocole : title:string -> filename:string -> unit
+
+(** Publish a package. *)
+val package : Package.packageInfo -> unit
+
 (** Dumps all published pages of documentations. Unless [~meta:false], also
     generates METADATA for each page in [<filename>.json] for each page. *)
 val dump : root:string -> ?meta:bool -> unit -> unit

src/plugins/server/server_zmq.ml

@@ -58,7 +58,7 @@ module Client = Senv.String
          as first and unique argument."
     end)
 
-let _ = Doc.page `Protocol ~title:"ZeroMQ Protocol" ~filename:"server_zmq.md"
+let _ = Server_doc.protocole ~title:"ZeroMQ Protocol" ~filename:"server_zmq.md"
 
 (* -------------------------------------------------------------------------- *)
 (* --- ZMQ Context                                                        --- *)

src/plugins/server/states.ml

@@ -51,7 +51,7 @@ let register_value (type a) ~page ~name ~descr ?(details=[])
   let title =  Printf.sprintf "`VALUE` %s" name in
   let index = [ Printf.sprintf "%s (`VALUE`)" name ] in
   let contents = [ Block [Text descr] ; Block details] in
-  let h = Doc.publish ~page ~name ~title ~index ~contents () in
+  let h = Server_doc.publish ~page ~name ~title ~index ~contents () in
   let signal = Request.signal ~page ~name:(name ^ ".sig")
       ~descr:(plain "Signal for value " @ href h) () in
   Request.register ~page ~kind:`GET ~name:(name ^ ".get")
@@ -71,7 +71,7 @@ let register_state (type a) ~page ~name ~descr ?(details=[])
   let title =  Printf.sprintf "`STATE` %s" name in
   let index = [ Printf.sprintf "%s (`STATE`)" name ] in
   let contents = [ Block [Text descr] ; Block details] in
-  let h = Doc.publish ~page ~name ~title ~index ~contents () in
+  let h = Server_doc.publish ~page ~name ~title ~index ~contents () in
   let signal = Request.signal ~page ~name:(name ^ ".sig")
       ~descr:(plain "Signal for state " @ href h) () in
   Request.register ~page ~kind:`GET ~name:(name ^ ".get")
@@ -277,7 +277,7 @@ let register_array ~page ~name ~descr ?(details=[]) ~key
       end ;
     Block details
   ] in
-  let mref = Doc.publish ~page:page ~name:name ~title ~index ~contents () in
+  let mref = Server_doc.publish ~page:page ~name:name ~title ~index ~contents () in
   let signal = Request.signal ~page ~name:(name ^ ".sig")
       ~descr:(plain "Signal for array " @ href mref) () in
   let getter = List.map Syntax.(fun (fd,to_js) -> fd.fd_name , to_js) columns in

src/plugins/server/states.mli

@@ -37,7 +37,7 @@ type 'a callback = ('a -> unit) -> unit
     synchronize with this value.
 *)
 val register_value :
-  page:Doc.page ->
+  page:Server_doc.page ->
   name:string ->
   descr:Markdown.text ->
   ?details:Markdown.block ->
@@ -60,7 +60,7 @@ val register_value :
     synchronize with this state.
 *)
 val register_state :
-  page:Doc.page ->
+  page:Server_doc.page ->
   name:string ->
   descr:Markdown.text ->
   ?details:Markdown.block ->
@@ -121,7 +121,7 @@ val signal : 'a array -> Request.signal
     [States.useSyncArray()] hook.
 *)
 val register_array :
-  page:Doc.page ->
+  page:Server_doc.page ->
   name:string ->
   descr:Markdown.text ->
   ?details:Markdown.block ->

src/plugins/server/syntax.ml

@@ -37,7 +37,7 @@ let check_plugin plugin name =
       name plugin
 
 let check_page page name =
-  match Doc.chapter page with
+  match Server_doc.chapter page with
   | `Kernel -> ()
   | `Plugin plugin -> check_plugin plugin name
   | `Protocol -> check_plugin "server" name
@@ -69,13 +69,13 @@ let publish ~page ~name ~descr ~synopsis ?(details = []) ?generated () =
   let id = Printf.sprintf "data-%s" name in
   let title = Printf.sprintf "`DATA` %s" name in
   let index = [ Printf.sprintf "%s (`DATA`)" name ] in
-  let dref = Doc.href page id in
+  let dref = Server_doc.href page id in
   let dlink = Markdown.href ~text:(Markdown.emph name) dref in
   let data = Markdown.(plain "<" @ dlink @ plain ">") in
   let contents = Markdown.(Block(
       [ Text descr ; define data synopsis.text ]
     )) :: details in
-  let _href = Doc.publish ~page ~name:id ~title ~index ~contents ?generated ()
+  let _href = Server_doc.publish ~page ~name:id ~title ~index ~contents ?generated ()
   in atom dlink
 
 (* -------------------------------------------------------------------------- *)

src/plugins/server/syntax.mli

@@ -32,7 +32,7 @@ val text : t -> Markdown.text
     Extended definition, like record fields and such, must be detailed in
     the description block. *)
 val publish :
-  page:Doc.page -> name:string -> descr:Markdown.text ->
+  page:Server_doc.page -> name:string -> descr:Markdown.text ->
   synopsis:t ->
   ?details:Markdown.elements ->
   ?generated:(unit -> Markdown.elements) ->