Merge pull request #773 from ocsigen/dune-update

Dune improvements
ocsigen · Dec 8, 2023 · 6c7fa6d · 6c7fa6d
2 parents 6a94d4e + 1a224dc
commit 6c7fa6d
Show file tree

Hide file tree

Showing 7 changed files with 99 additions and 121 deletions.
diff --git a/src/lib/client/dune b/src/lib/client/dune
@@ -24,7 +24,7 @@
   (action
     (with-stdout-to
       %{target}
-      (run ocaml ../../tools/gen_dune.ml --client ..))))
+      (run ../../tools/gen_dune.exe --client ..))))
 
 (env
  (_

diff --git a/src/lib/client/dune.client b/src/lib/client/dune.client
@@ -4,10 +4,10 @@
 (rule (copy# ../eliom_client.client.mli eliom_client.mli))
 (rule (copy# ../eliom_client_base.shared.ml eliom_client_base.ml))
 (rule (copy# ../eliom_client_core.client.ml eliom_client_core.ml))
-(rule (target eliom_client_main.ml) (deps ../eliom_client_main.eliom ../server/eliom_client_main.type_mli)
+(rule (target eliom_client_main.ml) (deps ../eliom_client_main.eliom)
   (action
     (with-stdout-to %{target}
-      (chdir .. (run ppx_eliom_client -type server/eliom_client_main.type_mli --as-pp --impl eliom_client_main.eliom)))))
+      (chdir .. (run ppx_eliom_client --as-pp -server-cmo %{cmo:../server/eliom_client_main} --impl %{deps})))))
 (rule (copy# ../eliom_client_value.client.ml eliom_client_value.ml))
 (rule (copy# ../eliom_client_value.client.mli eliom_client_value.mli))
 (rule (copy# ../eliom_comet.client.ml eliom_comet.ml))
@@ -19,23 +19,31 @@
 (rule (copy# ../eliom_config.client.ml eliom_config.ml))
 (rule (copy# ../eliom_config.client.mli eliom_config.mli))
 (rule (copy# ../eliom_content.client.mli eliom_content.mli))
-(rule (target eliom_content.ml) (deps ../eliom_content.eliom ../server/eliom_content.type_mli)
+(rule (target eliom_content.ml) (deps ../eliom_content.eliom)
   (action
     (with-stdout-to %{target}
-      (chdir .. (run ppx_eliom_client -type server/eliom_content.type_mli --as-pp --impl eliom_content.eliom)))))
+      (chdir .. (run ppx_eliom_client --as-pp -server-cmo %{cmo:../server/eliom_content} --impl %{deps})))))
 (rule (copy# ../eliom_content_.client.ml eliom_content_.ml))
 (rule (copy# ../eliom_content_core.client.ml eliom_content_core.ml))
 (rule (copy# ../eliom_content_core.client.mli eliom_content_core.mli))
 (rule (copy# ../eliom_content_sigs.shared.mli eliom_content_sigs.mli))
 (rule (copy# ../eliom_cookies_base.shared.ml eliom_cookies_base.ml))
-(rule (target eliom_cscache.ml) (deps ../eliom_cscache.eliom ../server/eliom_cscache.type_mli)
+(rule (target eliom_cscache.ml) (deps ../eliom_cscache.eliom)
   (action
     (with-stdout-to %{target}
-      (chdir .. (run ppx_eliom_client -type server/eliom_cscache.type_mli --as-pp --impl eliom_cscache.eliom)))))
-(rule (target eliom_form.ml) (deps ../eliom_form.eliom ../server/eliom_form.type_mli)
+      (chdir .. (run ppx_eliom_client --as-pp -server-cmo %{cmo:../server/eliom_cscache} --impl %{deps})))))
+(rule (target eliom_cscache.mli) (deps ../eliom_cscache.eliomi)
   (action
     (with-stdout-to %{target}
-      (chdir .. (run ppx_eliom_client -type server/eliom_form.type_mli --as-pp --impl eliom_form.eliom)))))
+      (chdir .. (run ppx_eliom_client --as-pp --intf %{deps})))))
+(rule (target eliom_form.ml) (deps ../eliom_form.eliom)
+  (action
+    (with-stdout-to %{target}
+      (chdir .. (run ppx_eliom_client --as-pp -server-cmo %{cmo:../server/eliom_form} --impl %{deps})))))
+(rule (target eliom_form.mli) (deps ../eliom_form.eliomi)
+  (action
+    (with-stdout-to %{target}
+      (chdir .. (run ppx_eliom_client --as-pp --intf %{deps})))))
 (rule (copy# ../eliom_form_sigs.shared.mli eliom_form_sigs.mli))
 (rule (copy# ../eliom_lazy.client.ml eliom_lazy.ml))
 (rule (copy# ../eliom_lazy.client.mli eliom_lazy.mli))
@@ -63,25 +71,33 @@
 (rule (copy# ../eliom_runtime.shared.mli eliom_runtime.mli))
 (rule (copy# ../eliom_service.client.ml eliom_service.ml))
 (rule (copy# ../eliom_service.client.mli eliom_service.mli))
-(rule (target eliom_service_base.ml) (deps ../eliom_service_base.eliom ../server/eliom_service_base.type_mli)
+(rule (target eliom_service_base.ml) (deps ../eliom_service_base.eliom)
   (action
     (with-stdout-to %{target}
-      (chdir .. (run ppx_eliom_client -type server/eliom_service_base.type_mli --as-pp --impl eliom_service_base.eliom)))))
+      (chdir .. (run ppx_eliom_client --as-pp -server-cmo %{cmo:../server/eliom_service_base} --impl %{deps})))))
 (rule (copy# ../eliom_service_sigs.shared.mli eliom_service_sigs.mli))
 (rule (copy# ../eliom_shared.client.mli eliom_shared.mli))
-(rule (target eliom_shared.ml) (deps ../eliom_shared.eliom ../server/eliom_shared.type_mli)
+(rule (target eliom_shared.ml) (deps ../eliom_shared.eliom)
   (action
     (with-stdout-to %{target}
-      (chdir .. (run ppx_eliom_client -type server/eliom_shared.type_mli --as-pp --impl eliom_shared.eliom)))))
-(rule (target eliom_shared_content.ml) (deps ../eliom_shared_content.eliom ../server/eliom_shared_content.type_mli)
+      (chdir .. (run ppx_eliom_client --as-pp -server-cmo %{cmo:../server/eliom_shared} --impl %{deps})))))
+(rule (target eliom_shared_content.ml) (deps ../eliom_shared_content.eliom)
   (action
     (with-stdout-to %{target}
-      (chdir .. (run ppx_eliom_client -type server/eliom_shared_content.type_mli --as-pp --impl eliom_shared_content.eliom)))))
+      (chdir .. (run ppx_eliom_client --as-pp -server-cmo %{cmo:../server/eliom_shared_content} --impl %{deps})))))
+(rule (target eliom_shared_content.mli) (deps ../eliom_shared_content.eliomi)
+  (action
+    (with-stdout-to %{target}
+      (chdir .. (run ppx_eliom_client --as-pp --intf %{deps})))))
 (rule (copy# ../eliom_shared_sigs.shared.mli eliom_shared_sigs.mli))
-(rule (target eliom_tools.ml) (deps ../eliom_tools.eliom ../server/eliom_tools.type_mli)
+(rule (target eliom_tools.ml) (deps ../eliom_tools.eliom)
+  (action
+    (with-stdout-to %{target}
+      (chdir .. (run ppx_eliom_client --as-pp -server-cmo %{cmo:../server/eliom_tools} --impl %{deps})))))
+(rule (target eliom_tools.mli) (deps ../eliom_tools.eliomi)
   (action
     (with-stdout-to %{target}
-      (chdir .. (run ppx_eliom_client -type server/eliom_tools.type_mli --as-pp --impl eliom_tools.eliom)))))
+      (chdir .. (run ppx_eliom_client --as-pp --intf %{deps})))))
 (rule (copy# ../eliom_types.client.ml eliom_types.ml))
 (rule (copy# ../eliom_types_base.shared.ml eliom_types_base.ml))
 (rule (copy# ../eliom_types_base.shared.mli eliom_types_base.mli))

diff --git a/src/lib/eliom_shared.eliom b/src/lib/eliom_shared.eliom
@@ -338,7 +338,7 @@ module React = struct
   module S = struct
     type 'a t = 'a FakeReact.S.t Value.t
 
-    let value (x : 'a t) =
+    let value (x : 'a FakeReact.S.t Value.t) =
       Value.create
         (FakeReact.S.value (Value.local x))
         [%client.unsafe (FakeReact.S.value (Value.local ~%x) : 'a)]
@@ -375,21 +375,23 @@ module React = struct
       in
       si, up
 
-    let map ?eq (f : ('a -> 'b) Value.t) (s : 'a t) : 'b t =
+    let map ?eq (f : ('a -> 'b) Value.t) (s : 'a FakeReact.S.t Value.t) : 'b t =
       Value.create
         (FakeReact.S.map (Value.local f) (Value.local s))
         [%client.unsafe (FakeReact.S.map ?eq:~%eq ~%f ~%s : 'b FakeReact.S.t)]
 
     let fmap ?(eq : ('b -> 'b -> bool) Value.t option)
-        (f : ('a -> 'b option) Value.t) (i : 'b Value.t) (s : 'a t)
+        (f : ('a -> 'b option) Value.t) (i : 'b Value.t)
+        (s : 'a FakeReact.S.t Value.t)
         : 'b t
       =
       Value.create
         (FakeReact.S.fmap (Value.local f) (Value.local i) (Value.local s))
         [%client.unsafe
           (FakeReact.S.fmap ?eq:~%eq ~%f ~%i ~%s : 'b FakeReact.S.t)]
 
-    let merge ?eq (f : ('a -> 'b -> 'a) Value.t) (acc : 'a) (l : 'b t list)
+    let merge ?eq (f : ('a -> 'b -> 'a) Value.t) (acc : 'a)
+        (l : 'b FakeReact.S.t Value.t list)
         : 'a t
       =
       Value.create
@@ -402,13 +404,17 @@ module React = struct
         (FakeReact.S.const ~synced:true v)
         [%client.unsafe (React.S.const ~%v : 'a FakeReact.S.t)]
 
-    let l2 ?eq (f : ('a -> 'b -> 'c) Value.t) (s1 : 'a t) (s2 : 'b t) : 'c t =
+    let l2 ?eq (f : ('a -> 'b -> 'c) Value.t) (s1 : 'a FakeReact.S.t Value.t)
+        (s2 : 'b FakeReact.S.t Value.t)
+        : 'c t
+      =
       Value.create
         (FakeReact.S.l2 (Value.local f) (Value.local s1) (Value.local s2))
         [%client.unsafe (React.S.l2 ?eq:~%eq ~%f ~%s1 ~%s2 : 'd FakeReact.S.t)]
 
-    let l3 ?eq (f : ('a -> 'b -> 'c -> 'd) Value.t) (s1 : 'a t) (s2 : 'b t)
-        (s3 : 'c t)
+    let l3 ?eq (f : ('a -> 'b -> 'c -> 'd) Value.t)
+        (s1 : 'a FakeReact.S.t Value.t) (s2 : 'b FakeReact.S.t Value.t)
+        (s3 : 'c FakeReact.S.t Value.t)
         : 'd t
       =
       Value.create
@@ -417,8 +423,9 @@ module React = struct
         [%client.unsafe
           (React.S.l3 ?eq:~%eq ~%f ~%s1 ~%s2 ~%s3 : 'd FakeReact.S.t)]
 
-    let l4 ?eq (f : ('a -> 'b -> 'c -> 'd -> 'e) Value.t) (s1 : 'a t)
-        (s2 : 'b t) (s3 : 'c t) (s4 : 'd t)
+    let l4 ?eq (f : ('a -> 'b -> 'c -> 'd -> 'e) Value.t)
+        (s1 : 'a FakeReact.S.t Value.t) (s2 : 'b FakeReact.S.t Value.t)
+        (s3 : 'c FakeReact.S.t Value.t) (s4 : 'd FakeReact.S.t Value.t)
         : 'e t
       =
       Value.create
@@ -427,8 +434,10 @@ module React = struct
         [%client.unsafe
           (React.S.l4 ?eq:~%eq ~%f ~%s1 ~%s2 ~%s3 ~%s4 : 'e FakeReact.S.t)]
 
-    let l5 ?eq (f : ('a -> 'b -> 'c -> 'd -> 'e -> 'f) Value.t) (s1 : 'a t)
-        (s2 : 'b t) (s3 : 'c t) (s4 : 'd t) (s5 : 'e t)
+    let l5 ?eq (f : ('a -> 'b -> 'c -> 'd -> 'e -> 'f) Value.t)
+        (s1 : 'a FakeReact.S.t Value.t) (s2 : 'b FakeReact.S.t Value.t)
+        (s3 : 'c FakeReact.S.t Value.t) (s4 : 'd FakeReact.S.t Value.t)
+        (s5 : 'e FakeReact.S.t Value.t)
         : 'f t
       =
       Value.create
@@ -438,7 +447,9 @@ module React = struct
           (React.S.l5 ?eq:~%eq ~%f ~%s1 ~%s2 ~%s3 ~%s4 ~%s5 : 'f FakeReact.S.t)]
 
     let l6 ?eq (f : ('a -> 'b -> 'c -> 'd -> 'e -> 'f -> 'g) Value.t)
-        (s1 : 'a t) (s2 : 'b t) (s3 : 'c t) (s4 : 'd t) (s5 : 'e t) (s6 : 'f t)
+        (s1 : 'a FakeReact.S.t Value.t) (s2 : 'b FakeReact.S.t Value.t)
+        (s3 : 'c FakeReact.S.t Value.t) (s4 : 'd FakeReact.S.t Value.t)
+        (s5 : 'e FakeReact.S.t Value.t) (s6 : 'f FakeReact.S.t Value.t)
         : 'g t
       =
       Value.create
@@ -448,7 +459,7 @@ module React = struct
           (React.S.l6 ?eq:~%eq ~%f ~%s1 ~%s2 ~%s3 ~%s4 ~%s5 ~%s6
             : 'g FakeReact.S.t)]
 
-    let switch ?eq (s : 'a t t) : 'a t =
+    let switch ?eq (s : 'a FakeReact.S.t Value.t FakeReact.S.t Value.t) : 'a t =
       (* TODO : setting synced to false is safe, but can we do
          better? *)
       Value.create
@@ -465,7 +476,10 @@ module React = struct
     end
 
     module Lwt = struct
-      let map_s ?eq (f : ('a -> 'b Lwt.t) Value.t) (s : 'a t) : 'b t Lwt.t =
+      let map_s ?eq (f : ('a -> 'b Lwt.t) Value.t)
+          (s : 'a FakeReact.S.t Value.t)
+          : 'b t Lwt.t
+        =
         let s' = Value.local s in
         let%lwt server_result = (Value.local f) (FakeReact.S.value s') in
         let synced = FakeReact.S.synced s' in
@@ -476,7 +490,8 @@ module React = struct
                (React.S.Lwt.map_s_init ~init:~%server_result ?eq:~%eq ~%f ~%s
                  : 'b FakeReact.S.t)])
 
-      let l2_s ?eq (f : ('a -> 'b -> 'c Lwt.t) Value.t) (s1 : 'a t) (s2 : 'b t)
+      let l2_s ?eq (f : ('a -> 'b -> 'c Lwt.t) Value.t)
+          (s1 : 'a FakeReact.S.t Value.t) (s2 : 'b FakeReact.S.t Value.t)
           : 'c t Lwt.t
         =
         let s1' = Value.local s1 and s2' = Value.local s2 in
@@ -492,8 +507,9 @@ module React = struct
                   ~%s2
                  : 'c FakeReact.S.t)])
 
-      let l3_s ?eq (f : ('a -> 'b -> 'c -> 'd Lwt.t) Value.t) (s1 : 'a t)
-          (s2 : 'b t) (s3 : 'c t)
+      let l3_s ?eq (f : ('a -> 'b -> 'c -> 'd Lwt.t) Value.t)
+          (s1 : 'a FakeReact.S.t Value.t) (s2 : 'b FakeReact.S.t Value.t)
+          (s3 : 'c FakeReact.S.t Value.t)
           : 'd t Lwt.t
         =
         let s1' = Value.local s1
@@ -512,8 +528,9 @@ module React = struct
                   ~%s2 ~%s3
                  : 'd FakeReact.S.t)])
 
-      let l4_s ?eq (f : ('a -> 'b -> 'c -> 'd -> 'e Lwt.t) Value.t) (s1 : 'a t)
-          (s2 : 'b t) (s3 : 'c t) (s4 : 'd t)
+      let l4_s ?eq (f : ('a -> 'b -> 'c -> 'd -> 'e Lwt.t) Value.t)
+          (s1 : 'a FakeReact.S.t Value.t) (s2 : 'b FakeReact.S.t Value.t)
+          (s3 : 'c FakeReact.S.t Value.t) (s4 : 'd FakeReact.S.t Value.t)
           : 'e t Lwt.t
         =
         let s1' = Value.local s1
@@ -536,7 +553,9 @@ module React = struct
                  : 'e FakeReact.S.t)])
 
       let l5_s ?eq (f : ('a -> 'b -> 'c -> 'd -> 'e -> 'f Lwt.t) Value.t)
-          (s1 : 'a t) (s2 : 'b t) (s3 : 'c t) (s4 : 'd t) (s5 : 'e t)
+          (s1 : 'a FakeReact.S.t Value.t) (s2 : 'b FakeReact.S.t Value.t)
+          (s3 : 'c FakeReact.S.t Value.t) (s4 : 'd FakeReact.S.t Value.t)
+          (s5 : 'e FakeReact.S.t Value.t)
           : 'f t Lwt.t
         =
         let s1' = Value.local s1
@@ -562,8 +581,9 @@ module React = struct
                  : 'f FakeReact.S.t)])
 
       let l6_s ?eq (f : ('a -> 'b -> 'c -> 'd -> 'e -> 'f -> 'g Lwt.t) Value.t)
-          (s1 : 'a t) (s2 : 'b t) (s3 : 'c t) (s4 : 'd t) (s5 : 'e t)
-          (s6 : 'f t)
+          (s1 : 'a FakeReact.S.t Value.t) (s2 : 'b FakeReact.S.t Value.t)
+          (s3 : 'c FakeReact.S.t Value.t) (s4 : 'd FakeReact.S.t Value.t)
+          (s5 : 'e FakeReact.S.t Value.t) (s6 : 'f FakeReact.S.t Value.t)
           : 'g t Lwt.t
         =
         let s1' = Value.local s1
@@ -591,7 +611,7 @@ module React = struct
                  : 'g FakeReact.S.t)])
 
       let merge_s ?eq (f : ('a -> 'b -> 'a Lwt.t) Value.t) (acc : 'a)
-          (l : 'b t list)
+          (l : 'b FakeReact.S.t Value.t list)
           : 'a t Lwt.t
         =
         let%lwt server_result, synced =
@@ -655,13 +675,13 @@ module ReactiveData = struct
           (FakeReactiveData.RList.singleton_s (Value.local ~%s)
             : 'a FakeReactiveData.RList.t)]
 
-    let value (s : 'a t) =
+    let value (s : 'a FakeReactiveData.RList.t Value.t) =
       Value.create
         (FakeReactiveData.RList.value (Value.local s))
         [%client.unsafe
           (FakeReactiveData.RList.value (Value.local ~%s) : 'a list)]
 
-    let signal ?eq (s : 'a t) =
+    let signal ?eq (s : 'a FakeReactiveData.RList.t Value.t) =
       let sv =
         let eq =
           match eq with Some eq -> Some (Value.local eq) | None -> None
@@ -706,7 +726,10 @@ module ReactiveData = struct
     let synced s = Value.local s |> FakeReactiveData.RList.synced
 
     module Lwt = struct
-      let map_p (f : ('a -> 'b Lwt.t) Value.t) (l : 'a t) : 'b t Lwt.t =
+      let map_p (f : ('a -> 'b Lwt.t) Value.t)
+          (l : 'a FakeReactiveData.RList.t Value.t)
+          : 'b t Lwt.t
+        =
         let l' = Value.local l in
         let%lwt server_result =
           Lwt_list.map_p (Value.local f) (FakeReactiveData.RList.value l')

diff --git a/src/lib/server/dune b/src/lib/server/dune
@@ -20,14 +20,12 @@
   (action
     (with-stdout-to
       %{target}
-      (run ocaml ../../tools/gen_dune.ml --server ..))))
-
-(rule (target includes)
-  (action
-    (with-stdout-to %{target}
-      (system "ocamlfind query -r -i-format lwt_react,ocsigenserver,ocsigenserver.ext,js_of_ocaml,tyxml | tr ' ' '\n'"))))
+      (run ../../tools/gen_dune.exe --server ..))))
 
+; We need to refer to types defined by Js_of_ocaml without a link
+; dependency to some code that only makes sense in a browser.
 (rule (target type_includes)
+  (deps (universe))
   (action
     (with-stdout-to %{target}
       (system "printf '('; ocamlfind query -i-format js_of_ocaml; printf ')'"))))