From 4345d330591fcc555d5bfee50b2164f665515a85 Mon Sep 17 00:00:00 2001
From: Andre Maroneze <andre.maroneze@cea.fr>
Date: Mon, 1 Feb 2021 19:03:50 +0100
Subject: [PATCH] [Server] use Filepath parameters for relevant options
---
src/plugins/server/server_doc.ml | 26 +++++++++++++-----------
src/plugins/server/server_doc.mli | 2 +-
src/plugins/server/server_parameters.ml | 5 +++--
src/plugins/server/server_parameters.mli | 2 +-
4 files changed, 19 insertions(+), 16 deletions(-)
diff --git a/src/plugins/server/server_doc.ml b/src/plugins/server/server_doc.ml
index f38f08705f9..e1ba1ae684f 100644
--- a/src/plugins/server/server_doc.ml
+++ b/src/plugins/server/server_doc.ml
@@ -307,16 +307,17 @@ let metadata page : json =
(* -------------------------------------------------------------------------- *)
let pp_one_page ~root ~page ~title body =
- let full_path = Filepath.normalize (root ^ "/" ^ page) in
- let dir = Filename.dirname full_path in
+ let full_path = Filepath.Normalized.concat root page in
+ let dir = Filename.dirname (full_path:>string) in
if not (Sys.file_exists dir) then Extlib.mkdir ~parents:true dir 0o755;
try
- let chan = open_out full_path in
+ let chan = open_out (full_path:>string) in
let fmt = Format.formatter_of_out_channel chan in
let title = Md.plain title in
Markdown.(pp_pandoc ~page fmt (pandoc ~title body))
with Sys_error e ->
- Senv.fatal "Could not open file %s for writing: %s" full_path e
+ Senv.fatal "Could not open file %a for writing: %s"
+ Filepath.Normalized.pretty full_path e
(* Build section contents in reverse order *)
let build d s = List.fold_left (fun d s -> s() :: d) d s
@@ -338,13 +339,13 @@ let dump ~root ?(meta=true) () =
let body = Markdown.subsections page.descr (build [] page.sections) in
pp_one_page ~root ~page:path ~title (intro @ body) ;
if meta then
- let path = Printf.sprintf "%s/%s.json" root path in
- Yojson.Basic.to_file path (metadata page) ;
+ let path = Filepath.Normalized.concat root (path ^ ".json") in
+ Yojson.Basic.to_file (path:>string) (metadata page) ;
) !pages ;
Senv.feedback "[doc] Page: 'readme.md'" ;
if meta then
- let path = Printf.sprintf "%s/readme.md.json" root in
- Yojson.Basic.to_file path maindata ;
+ let path = Filepath.Normalized.concat root "readme.md.json" in
+ Yojson.Basic.to_file (path:>string) maindata ;
let body =
[ Md.H1 (Md.plain "Presentation", None);
Md.Block (Md.text (Md.format "Version %s" Fc_config.version))]
@@ -363,15 +364,16 @@ let () =
Db.Main.extend begin
fun () ->
let root = Senv.Doc.get () in
- if root <> "" then
- if Sys.file_exists root && Sys.is_directory root then
+ if not (Filepath.Normalized.is_unknown root) then
+ if Sys.is_directory (root:>string) then
begin
- Senv.feedback "[doc] Root: '%s'" root ;
+ Senv.feedback "[doc] Root: '%a'" Filepath.Normalized.pretty root ;
Package.iter package ;
dump ~root () ;
end
else
- Senv.error "[doc] File '%s' is not a directory" root
+ Senv.error "[doc] File '%a' is not a directory"
+ Filepath.Normalized.pretty root
end
(* -------------------------------------------------------------------------- *)
diff --git a/src/plugins/server/server_doc.mli b/src/plugins/server/server_doc.mli
index 6bb0462554e..d86aaa97d5b 100644
--- a/src/plugins/server/server_doc.mli
+++ b/src/plugins/server/server_doc.mli
@@ -72,6 +72,6 @@ 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
+val dump : root:Filepath.Normalized.t -> ?meta:bool -> unit -> unit
(* -------------------------------------------------------------------------- *)
diff --git a/src/plugins/server/server_parameters.ml b/src/plugins/server/server_parameters.ml
index 3eedff1c728..c7086902c97 100644
--- a/src/plugins/server/server_parameters.ml
+++ b/src/plugins/server/server_parameters.ml
@@ -60,11 +60,12 @@ let server_doc = add_group "Server Doc Generation"
let () = Parameter_customize.set_group server_doc
let () = Parameter_customize.do_not_save ()
-module Doc = P.String
+module Doc = P.Filepath
(struct
let option_name = "-server-doc"
let arg_name = "dir"
- let default = ""
+ let file_kind = "Directory"
+ let existence = Fc_Filepath.Must_exist
let help = "Output a markdown documentation of the server in <dir>"
end)
diff --git a/src/plugins/server/server_parameters.mli b/src/plugins/server/server_parameters.mli
index 4186a397421..74d29a8d0c1 100644
--- a/src/plugins/server/server_parameters.mli
+++ b/src/plugins/server/server_parameters.mli
@@ -24,7 +24,7 @@
include Plugin.General_services
-module Doc : Parameter_sig.String (** Generate documentation *)
+module Doc : Parameter_sig.Filepath (** Generate documentation *)
module Polling : Parameter_sig.Int (** Idle waiting time (in ms) *)
module AutoLog : Parameter_sig.Bool (** Monitor logs *)
--
GitLab