Opstic first working version w/ projection

.ocamlformat

@@ -0,0 +1,22 @@
+profile = default
+version = 0.25.1
+type-decl=sparse
+margin=72
+
+# dock-collection-brackets=false
+# break-separators=before
+
+# break-collection-expressions=wrap
+
+# sequence-style=before
+
+# break-fun-decl=smart
+# break-fun-decl=fit-or-vertical
+
+# let-binding-indent=2
+# parens-tuple=multi-line-only
+# break-fun-sig=fit-or-vertical
+# function-indent=2
+# function-indent-nested=always
+
+# type-decl-indent=2

apps/main-entry/mlsrc/dune

@@ -1,12 +1,13 @@
 (executables
  (names server_main)
  (libraries
+  opstic
   bisect_ppx.runtime
   prr
   kxclib
   kxclib.jsoo)
  (preprocess
-  (pps js_of_ocaml-ppx))
+  (pps js_of_ocaml-ppx opstic.ppx rows.ppx))
  (instrumentation (backend bisect_ppx))
  (modes byte js)
  (flags
@@ -23,7 +24,13 @@
      --source-map
      --target-env
      browser ;; note that this is intentional even when we target nodejs
-     --no-inline))
+     --no-inline 
+    ;  --pretty 
+    ;  --debug-info 
+    ;  --disable staticeval
+    ;  --disable 
+    ;  share
+     ))
    (link_flags
     ((:standard \ --source-map-inline --pretty)
      --source-map))))

apps/main-entry/mlsrc/server_main.bc.d.ts

@@ -3,10 +3,11 @@ export type Http_response = {
   body: unknown;
 };
 
-export declare function handle_get(path: string): Http_response;
+export declare function handle_get(path: string): Promise<Http_response>;
 export declare function handle_post(
   path: string,
-  reqbody: unknown
+  reqbody: unknown,
+  express: express
 ): Http_response;
 
 export interface Bisect_ppx_jsoo_coverage_helper {

apps/main-entry/mlsrc/server_main.ml

@@ -1,16 +1,19 @@
 module Pjv = Prr.Jv
 open Kxclib.Json
-open Log0
+open Kxclib.Log0
+open Opstic.Monad
+
+let ( let* ) = Opstic.Monad.bind
 
 type http_response = {
-    status_code : int;
-    body        : jv;
-  }
+  status_code : int;
+  body : jv;
+}
 
 let json_of_http_response : http_response -> jv =
-  fun { status_code; body } ->
-  `obj [ "status_code", `num (float_of_int status_code);
-         "body", body ]
+ fun { status_code; body } ->
+  `obj
+    [ ("status_code", `num (float_of_int status_code)); ("body", body) ]
 
 let jsobj_of_http_response : http_response -> Pjv.t =
   json_of_http_response &> Kxclib_jsoo.Json_ext.to_xjv
@@ -21,68 +24,113 @@ let json_of_jsobj : Pjv.t -> jv =
   &> Kxclib_jsoo.Json_ext.of_xjv
 
 module Resp = struct
-  let msg ?(status_code=200) s = {
-      status_code; body = `obj [ "message", `str s ]
-    }
-  let msg' ?status_code fmt =
-    Format.kasprintf (msg ?status_code) fmt
-  let ret ?(status_code=200) ?wrap body =
-    let body = match wrap with
-      | Some (`in_field fname) -> `obj [ fname, body ]
-      | None -> body in
-    { status_code; body }
+  let msg ?(status_code = 200) s =
+    { status_code; body = `obj [ ("message", `str s) ] }
+
+  let msg' ?status_code fmt = Format.kasprintf (msg ?status_code) fmt
+
+  (* let ret ?(status_code = 200) ?wrap body =
+     let body =
+       match wrap with
+       | Some (`in_field fname) -> `obj [ (fname, body) ]
+       | None -> body
+     in
+     { status_code; body } *)
 end
 
-let coverage_helper_js = object%js
-  method reset_counters_js =
-    info "Bisect.Runtime.reset_counters";
-    Bisect.Runtime.reset_counters();
-    Pjv.undefined
-  method write_coverage_data_js =
-    info "Bisect.Runtime.write_coverage_data";
-    Bisect.Runtime.write_coverage_data();
-    Pjv.undefined
-  method get_coverage_data_js =
-    info "Bisect.Runtime.get_coverage_data";
-    Bisect.Runtime.get_coverage_data ()
-    >? Pjv.of_string
-    |? Pjv.null
-  end [@@coverage off]
+let coverage_helper_js =
+  object%js
+    method reset_counters_js =
+      info "Bisect.Runtime.reset_counters";
+      Bisect.Runtime.reset_counters ();
+      Pjv.undefined
+
+    method write_coverage_data_js =
+      info "Bisect.Runtime.write_coverage_data";
+      Bisect.Runtime.write_coverage_data ();
+      Pjv.undefined
+
+    method get_coverage_data_js =
+      info "Bisect.Runtime.get_coverage_data";
+      Bisect.Runtime.get_coverage_data () >? Pjv.of_string |? Pjv.null
+  end
+  [@@coverage off]
+
+let server = Opstic.Server.create ()
+
+let to_promise : http_response Prr.Fut.or_error -> Pjv.t =
+ fun m -> Prr.Fut.to_promise ~ok:jsobj_of_http_response m
 
 let () =
   info "%s loaded" __FILE__;
+  let obj =
+    object%js
+      val coverage_helper_js = coverage_helper_js
 
-  object%js
+      val handle_get_ =
+        fun path_js ->
+          let path = Pjv.to_string path_js in
+          verbose "handle_get[%s]" path;
+          (match path with
+          | "/" -> return (Resp.msg "hello?")
+          | _ ->
+              return
+                (Resp.msg' ~status_code:404 "path not found: %s" path))
+          |> to_promise
+
+      val handle_post_ =
+        fun path_js reqbody_js _req_js ->
+          let path = Pjv.to_string path_js in
+          let reqbody = json_of_jsobj reqbody_js in
+          verbose "handle_post[%s]@\n @[%a@]" path Json.pp_lit reqbody;
+          Opstic.Monad.then_
+            (fun () ->
+              Opstic.Server.handle_request server ~path reqbody
+                reqbody_js)
+            (function
+              | Ok body -> return { status_code = 200; body }
+              | Error err ->
+                  return
+                    {
+                      status_code = 500;
+                      body = `str (Opstic.Monad.error_to_string err);
+                    })
+          |> to_promise
+    end
+  in
+  obj |> Js_of_ocaml.Js.export_all
+
+open Opstic
+
+[@@@ocaml.warning "-11-32"]
 
-    val coverage_helper_js = coverage_helper_js
-
-    val handle_get_ =
-      fun path_js ->
-      let path = Pjv.to_string path_js in
-      verbose "handle_get[%s]" path;
-      (match path with
-       | "/" -> Resp.msg "hello?"
-       | _ -> Resp.msg' ~status_code:404 "path not found: %s" path
-      ) |> jsobj_of_http_response
-
-    val handle_post_ =
-      fun path_js reqbody_js ->
-      let path = Pjv.to_string path_js in
-      let reqbody = json_of_jsobj reqbody_js in
-      verbose "handle_post[%s]@\n @[%a@]" path Json.pp_lit reqbody;
-      (match path with
-       | "/addxy" -> (
-         match
-           reqbody
-           |> Jv.(pump_field "y" &> pump_field "x")
-         with
-         | `obj ["x", `num x; "y", `num y] ->
-            verbose "/addxy parsed x=%f, y=%f" x y;
-            Resp.ret ~wrap:(`in_field "result") (`num (x +. y))
-         | _ ->
-            Resp.msg ~status_code:400 {|bad request. example: { "x": 1, "y": 2 }|}
-       )
-       | _ -> Resp.msg' ~status_code:404 "path not found: %s" path
-      ) |> jsobj_of_http_response
-
-  end |> Js_of_ocaml.Js.export_all
+let%global g =
+  let rec loop =
+    cli#args = "/adder"
+    => srv :: `obj (("x", `num __) :: ("y", `num __) :: __);
+    srv
+    *>> ( (srv#ans ==> cli :: `obj [ ("ans", `num __) ];
+           loop),
+          srv#err ==> cli :: `obj [ ("msg", `str __) ] )
+  in
+  loop
+
+let spec = [%project_global g srv]
+
+let () =
+  let open Opstic.Comm in
+  let rec loop acc (`cli (`args ((x, y, _), ep))) =
+    if x > 0. && y > 0. then
+      let* ep = send ep (fun x -> x#cli#ans) (x +. y +. acc) in
+      let* vars = receive ep in
+      loop acc vars
+    else
+      let* ep =
+        send ep
+          (fun x -> x#cli#err)
+          "Oops, both x and y should be positive"
+      in
+      close ep;
+      return ()
+  in
+  start_service server spec (loop 0.0)

apps/main-entry/mlsrc/server_main.spec.ts

@@ -6,8 +6,8 @@ describe("mlsrc/server_main correctness", () => {
     coverage_helper.write_coverage_data();
     coverage_helper.reset_counters();
   });
-  it("gives 404 on non-existing GET paths", () => {
-    const { status_code, body } = camlimpl.handle_get(
+  it("gives 404 on non-existing GET paths", async () => {
+    const { status_code, body } = await camlimpl.handle_get(
       "/this-path-should-not-exists-or-we-are-screwed"
     );
     expect(status_code).toEqual(404);

apps/main-entry/src/main.ts

@@ -9,14 +9,26 @@ app.get("/_ping", (req, res) => {
   res.send(answerForPing());
 });
 
-app.get("/*", (req, res) => {
-  const { status_code, body } = camlimpl.handle_get(req.path);
-  res.status(status_code).send(body);
+app.get("/*", async (req, res) => {
+  const { status_code, body } = await camlimpl.handle_get(req.path);;
+  return res.status(status_code).send(body);
 });
 
-app.post("/*", (req, res) => {
-  const { status_code, body } = camlimpl.handle_post(req.path, req.body);
-  res.status(status_code).send(body);
+app.post("/*", async (req, res) => {
+  console.log(req.body)
+  try {
+    const { status_code, body } = await camlimpl.handle_post(req.path, req.body, req);
+    return res.status(status_code).send(body);
+  } catch (err) {
+    console.log("Error:" + (err as any));
+    if (err instanceof Error) {
+      if (err.name == "OpsticError") {
+        return res.status(500).send(err.name + ": " + err.message);
+      }
+    }
+    throw err;
+  }
+
 });
 
 /* istanbul ignore next */

vendors/opstic

@@ -0,0 +1 @@
+/Users/keigoi/Dropbox/Code/opstic