split dream runtime into a separate package

Author: andreypopp

browser/runtime/dune

@@ -6,7 +6,7 @@
  (libraries melange-fetch))
 
 (copy_files#
- (files ../../native/runtime/ppx_deriving_router_witness.ml*))
+ (files ../../native/runtime_dream/ppx_deriving_router_witness.ml*))
 
 (copy_files#
- (files ../../native/runtime/ppx_deriving_router_primitives.ml*))
+ (files ../../native/runtime_dream/ppx_deriving_router_primitives.ml*))

dune-project

@@ -23,8 +23,19 @@
   ppxlib
   containers
   routes
-  dream
   melange
   melange-fetch
   ppx_deriving_json
   uri))
+
+(package
+ (name ppx_deriving_router_dream)
+ (synopsis "Dream runtime")
+ (depends
+  (ocaml
+   (>= 4.14))
+  dune
+  routes
+  dream
+  ppx_deriving_json
+  uri))

native/lib/dune

@@ -5,7 +5,6 @@
  (public_name ppx_deriving_router)
  (libraries uri ppxlib containers ppx_deriving_json.native)
  (kind ppx_deriver)
- (ppx_runtime_libraries ppx_deriving_router.runtime)
  (preprocess
   (pps ppxlib.metaquot)))
 

native/lib/ppx_deriving_router.ml

@@ -16,7 +16,7 @@ module Derive_encode_response = struct
       td_newtype td (fun typ ->
           let value_typ =
             match typ with
-            | None -> [%type: Dream.response]
+            | None -> [%type: Ppx_deriving_router_runtime.response]
             | Some txt -> ptyp_constr ~loc { loc; txt = Lident txt } []
           in
           [%type: [%t value_typ] -> Ppx_deriving_router_runtime.json])
@@ -74,17 +74,19 @@ let td_to_ty_handler param td =
         [ { loc; txt = param_name } ]
         [%type:
           [%t td_to_ty (Some param) td] ->
-          Dream.request ->
+          Ppx_deriving_router_runtime.request ->
           [%t param] Lwt.t]
   | None ->
       [%type:
-        [%t td_to_ty param td] -> Dream.request -> Dream.response Lwt.t]
+        [%t td_to_ty param td] ->
+        Ppx_deriving_router_runtime.request ->
+        Ppx_deriving_router_runtime.response Lwt.t]
 
 let td_to_ty_enc param td =
   let loc = td.ptype_loc in
   let result =
     match param with
-    | None -> [%type: Dream.response]
+    | None -> [%type: Ppx_deriving_router_runtime.response]
     | Some param -> param
   in
   [%type: [%t result] Ppx_deriving_router_runtime.encode]
@@ -192,7 +194,8 @@ let derive_path td (exemplar, ctors) =
                   let value =
                     [%expr
                       let v =
-                        Dream.queries [%e req] [%e estring ~loc name]
+                        Ppx_deriving_router_runtime.queries [%e req]
+                          [%e estring ~loc name]
                       in
                       match [%e of_url] v with
                       | Some v -> v
@@ -233,7 +236,7 @@ let derive_path td (exemplar, ctors) =
                 let args = (name, ebody) :: args in
                 [%expr
                   Lwt.bind
-                    (Dream.body [%e req])
+                    (Ppx_deriving_router_runtime.body [%e req])
                     (fun [%p pbody] ->
                       let [%p pbody] =
                         try Yojson.Basic.from_string [%e ebody]
@@ -254,8 +257,11 @@ let derive_path td (exemplar, ctors) =
     in
     let make =
       [%expr
-        fun ([%p preq] : Dream.request) ->
-          [%e pexp_match ~loc [%expr Dream.method_ [%e req]] by_method]]
+        fun ([%p preq] : Ppx_deriving_router_runtime.request) ->
+          [%e
+            pexp_match ~loc
+              [%expr Ppx_deriving_router_runtime.method_ [%e req]]
+              by_method]]
     in
     List.fold_left (List.rev params) ~init:make ~f:(fun body param ->
         pexp_fun ~loc Nolabel None (pvar ~loc param) body)

native/runtime/dune

@@ -0,0 +1,5 @@
+(library
+ (name ppx_deriving_router_runtime_dream)
+ (public_name ppx_deriving_router_dream)
+ (wrapped false)
+ (libraries containers dream routes ppx_deriving_json.native_runtime))

native/runtime_dream/dune

@@ -1,3 +1,18 @@
+type json = Ppx_deriving_json_runtime.t
+type response = Dream.response
+type request = Dream.request
+
+let queries = Dream.queries
+let body = Dream.body
+
+let method_ req =
+  match Dream.method_ req with
+  | `GET -> `GET
+  | `POST -> `POST
+  | `PUT -> `PUT
+  | `DELETE -> `DELETE
+  | _ -> failwith "Unsupported method"
+
 module Witness = Ppx_deriving_router_witness
 module Primitives = Ppx_deriving_router_primitives
 
@@ -34,9 +49,6 @@ let prefix_route prefix f (Route (path, a, g)) =
 
 let to_route (Route (path, a, f)) = Routes.(map f (route path a))
 
-type json = Ppx_deriving_json_runtime.t
-type response = Dream.response
-
 type _ encode =
   | Encode_raw : response encode
   | Encode_json : ('a -> json) -> 'a encode

native/runtime/ppx_deriving_router_primitives.ml renamed to native/runtime_dream/ppx_deriving_router_primitives.ml

@@ -1,3 +1,11 @@
+type json = Ppx_deriving_json_runtime.t
+type request = Dream.request
+type response = Dream.response
+
+val queries : request -> string -> string list
+val body : request -> string Lwt.t
+val method_ : request -> [ `DELETE | `GET | `POST | `PUT ]
+
 (** REQUEST DECODING *)
 
 type 'a url_path_encoder = 'a -> string
@@ -18,9 +26,6 @@ val encode_path : Buffer.t -> string -> unit
 val encode_query_key : Buffer.t -> string -> unit
 val encode_query_value : Buffer.t -> string -> unit
 
-type response = Dream.response
-type json = Ppx_deriving_json_runtime.t
-
 type _ encode =
   | Encode_raw : response encode
   | Encode_json : ('a -> json) -> 'a encode