From c8c3ced69901fc5a9c3e2f61322b75c0eb02bd05 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Loi=CC=88c=20Correnson?= <loic.correnson@cea.fr>
Date: Wed, 17 Jun 2020 08:54:06 +0200
Subject: [PATCH] [server] kernel project
---
src/plugins/server/Makefile.in | 2 +-
src/plugins/server/kernel_project.ml | 80 ++++++++++++++++------------
2 files changed, 46 insertions(+), 36 deletions(-)
diff --git a/src/plugins/server/Makefile.in b/src/plugins/server/Makefile.in
index 2c59c4cb72b..e64141111ed 100644
--- a/src/plugins/server/Makefile.in
+++ b/src/plugins/server/Makefile.in
@@ -45,7 +45,7 @@ PLUGIN_CMO:= \
main request states \
server_batch \
kernel_main \
-# kernel_project \
+ kernel_project \
# kernel_ast \
# kernel_properties
diff --git a/src/plugins/server/kernel_project.ml b/src/plugins/server/kernel_project.ml
index e20a51e86f7..45559e30b30 100644
--- a/src/plugins/server/kernel_project.ml
+++ b/src/plugins/server/kernel_project.ml
@@ -21,36 +21,40 @@
(**************************************************************************)
open Data
-module Sy = Syntax
module Md = Markdown
module Js = Yojson.Basic.Util
+module Pkg = Package
-let page = Server_doc.page `Kernel ~title:"Project Management" ~filename:"project.md" ()
+let package = Pkg.package ~name:"project" ()
(* -------------------------------------------------------------------------- *)
(* --- Project Info --- *)
(* -------------------------------------------------------------------------- *)
+module ProjectId = (val jkey ~kind:"project")
+
module ProjectInfo =
- Collection
- (struct
- type t = Project.t
-
- let syntax = Sy.publish ~page ~name:"project-info"
- ~descr:(Md.plain "Project informations")
- ~synopsis:Sy.(record[ "id",ident; "name",string; "current",boolean ])
- ()
-
- let of_json js =
- Js.member "id" js |> Js.to_string |> Project.from_unique_name
-
- let to_json p =
- `Assoc [
- "id", `String (Project.get_unique_name p) ;
- "name", `String (Project.get_name p) ;
- "current", `Bool (Project.is_current p) ;
- ]
- end)
+struct
+ type t = Project.t
+ let jtype = Pkg.datatype ~package
+ ~name:"projectInfo"
+ ~descr:(Md.plain "Project informations")
+ Pkg.(Jrecord [
+ "id",ProjectId.jtype;
+ "name",Jstring;
+ "current",Jboolean;
+ ])
+
+ let of_json js =
+ Js.member "id" js |> Js.to_string |> Project.from_unique_name
+
+ let to_json p =
+ `Assoc [
+ "id", `String (Project.get_unique_name p) ;
+ "name", `String (Project.get_name p) ;
+ "current", `Bool (Project.is_current p) ;
+ ]
+end
(* -------------------------------------------------------------------------- *)
(* --- Project Requests --- *)
@@ -59,11 +63,17 @@ module ProjectInfo =
module ProjectRequest =
struct
+ (* forward request on a given project *)
+
type t = Project.t * string * json
- let syntax = Sy.publish ~page ~name:"project-request"
- ~synopsis:(Sy.(record[ "project",ident; "request",string; "data",any; ]))
- ~descr:(Md.plain "Request to be executed on the specified project.") ()
+ let jtype = Pkg.datatype ~package ~name:"projectRequest"
+ ~descr:(Md.plain "Request to be executed on the specified project.")
+ (Jrecord [
+ "project",ProjectId.jtype;
+ "request",Jstring;
+ "data",Jany;
+ ])
let of_json js =
begin
@@ -84,37 +94,37 @@ end
(* --- Project Requests --- *)
(* -------------------------------------------------------------------------- *)
-let () = Request.register ~page
- ~kind:`GET ~name:"kernel.project.getCurrent"
+let () = Request.register ~package
+ ~kind:`GET ~name:"getCurrent"
~descr:(Md.plain "Returns the current project")
~input:(module Junit) ~output:(module ProjectInfo)
Project.current
-let () = Request.register ~page
- ~kind:`SET ~name:"kernel.project.setCurrent"
+let () = Request.register ~package
+ ~kind:`SET ~name:"setCurrent"
~descr:(Md.plain "Switches the current project")
- ~input:(module Jident) ~output:(module Junit)
+ ~input:(module ProjectId) ~output:(module Junit)
(fun pid -> Project.(set_current (from_unique_name pid)))
-let () = Request.register ~page
+let () = Request.register ~package
~kind:`GET ~name:"kernel.project.getList"
~descr:(Md.plain "Returns the list of all projects")
- ~input:(module Junit) ~output:(module ProjectInfo.Jlist)
+ ~input:(module Junit) ~output:(module Jlist(ProjectInfo))
(fun () -> Project.fold_on_projects (fun ids p -> p :: ids) [])
-let () = Request.register ~page
+let () = Request.register ~package
~kind:`GET ~name:"kernel.project.getOn"
~descr:(Md.plain "Execute a GET request within the given project")
~input:(module ProjectRequest) ~output:(module Jany)
(ProjectRequest.process `GET)
-let () = Request.register ~page
+let () = Request.register ~package
~kind:`SET ~name:"kernel.project.setOn"
~descr:(Md.plain "Execute a SET request within the given project")
~input:(module ProjectRequest) ~output:(module Jany)
(ProjectRequest.process `SET)
-let () = Request.register ~page
+let () = Request.register ~package
~kind:`EXEC ~name:"kernel.project.execOn"
~descr:(Md.plain "Execute an EXEC request within the given project")
~input:(module ProjectRequest) ~output:(module Jany)
@@ -126,7 +136,7 @@ let () = Request.register ~page
let () =
Request.register
- ~page
+ ~package
~descr:(Md.plain "Create a new project")
~kind:`SET
~name:"kernel.project.setCreate"
--
GitLab