diff --git a/src/lib/client/dune b/src/lib/client/dune index 4348345bdb..2ea30aaa78 100644 --- 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 index 8d5075d66f..68f8ab59b5 100644 --- 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 index c0c5af3404..df40384a0f 100644 --- 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,13 +375,14 @@ 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 @@ -389,7 +390,8 @@ module React = struct [%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 index 15c0ade426..4b89ac9552 100644 --- 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 ')'")))) diff --git a/src/lib/server/dune.server b/src/lib/server/dune.server index f9a081b13c..6b23b78ffd 100644 --- a/src/lib/server/dune.server +++ b/src/lib/server/dune.server @@ -7,14 +7,6 @@ (action (with-stdout-to %{target} (chdir .. (run ppx_eliom_server --as-pp --impl %{deps}))))) -(rule (target eliom_client_main.type_mli) (deps ../eliom_client_main.eliom) - (action - (progn - (ignore-stdout (echo %{cmo:eliom_client_main})) - (with-stdout-to %{target} - (pipe-stdout - (chdir .. (run ocamlfind ocamlc -package lwt_ppx %{read-lines:includes} -I server/.eliom_server.objs/byte -i -ppx "%{bin:ppx_eliom_types} --as-ppx" -impl %{deps})) - (run sed -e "s$/[1-9][0-9]*$$g" -e "s/_\\[\\([<>]\\)/[\\1/g" -e "s/'\\(_[a-z0-9_]*\\)/'eliom_inferred_type_\\1/g")))))) (rule (copy# ../eliom_client_value.server.ml eliom_client_value.ml)) (rule (copy# ../eliom_client_value.server.mli eliom_client_value.mli)) (rule (copy# ../eliom_comet.server.ml eliom_comet.ml)) @@ -30,14 +22,6 @@ (action (with-stdout-to %{target} (chdir .. (run ppx_eliom_server --as-pp --impl %{deps}))))) -(rule (target eliom_content.type_mli) (deps ../eliom_content.eliom) - (action - (progn - (ignore-stdout (echo %{cmo:eliom_content})) - (with-stdout-to %{target} - (pipe-stdout - (chdir .. (run ocamlfind ocamlc -package lwt_ppx %{read-lines:includes} -I server/.eliom_server.objs/byte -i -ppx "%{bin:ppx_eliom_types} --as-ppx" -impl %{deps})) - (run sed -e "s$/[1-9][0-9]*$$g" -e "s/_\\[\\([<>]\\)/[\\1/g" -e "s/'\\(_[a-z0-9_]*\\)/'eliom_inferred_type_\\1/g")))))) (rule (copy# ../eliom_content.server.mli eliom_content.mli)) (rule (copy# ../eliom_content_.server.ml eliom_content_.ml)) (rule (copy# ../eliom_content_core.server.ml eliom_content_core.ml)) @@ -48,14 +32,6 @@ (action (with-stdout-to %{target} (chdir .. (run ppx_eliom_server --as-pp --impl %{deps}))))) -(rule (target eliom_cscache.type_mli) (deps ../eliom_cscache.eliom) - (action - (progn - (ignore-stdout (echo %{cmo:eliom_cscache})) - (with-stdout-to %{target} - (pipe-stdout - (chdir .. (run ocamlfind ocamlc -package lwt_ppx %{read-lines:includes} -I server/.eliom_server.objs/byte -i -ppx "%{bin:ppx_eliom_types} --as-ppx" -impl %{deps})) - (run sed -e "s$/[1-9][0-9]*$$g" -e "s/_\\[\\([<>]\\)/[\\1/g" -e "s/'\\(_[a-z0-9_]*\\)/'eliom_inferred_type_\\1/g")))))) (rule (target eliom_cscache.mli) (deps ../eliom_cscache.eliomi) (action (with-stdout-to %{target} @@ -67,14 +43,6 @@ (action (with-stdout-to %{target} (chdir .. (run ppx_eliom_server --as-pp --impl %{deps}))))) -(rule (target eliom_form.type_mli) (deps ../eliom_form.eliom) - (action - (progn - (ignore-stdout (echo %{cmo:eliom_form})) - (with-stdout-to %{target} - (pipe-stdout - (chdir .. (run ocamlfind ocamlc -package lwt_ppx %{read-lines:includes} -I server/.eliom_server.objs/byte -i -ppx "%{bin:ppx_eliom_types} --as-ppx" -impl %{deps})) - (run sed -e "s$/[1-9][0-9]*$$g" -e "s/_\\[\\([<>]\\)/[\\1/g" -e "s/'\\(_[a-z0-9_]*\\)/'eliom_inferred_type_\\1/g")))))) (rule (target eliom_form.mli) (deps ../eliom_form.eliomi) (action (with-stdout-to %{target} @@ -115,40 +83,16 @@ (action (with-stdout-to %{target} (chdir .. (run ppx_eliom_server --as-pp --impl %{deps}))))) -(rule (target eliom_service_base.type_mli) (deps ../eliom_service_base.eliom) - (action - (progn - (ignore-stdout (echo %{cmo:eliom_service_base})) - (with-stdout-to %{target} - (pipe-stdout - (chdir .. (run ocamlfind ocamlc -package lwt_ppx %{read-lines:includes} -I server/.eliom_server.objs/byte -i -ppx "%{bin:ppx_eliom_types} --as-ppx" -impl %{deps})) - (run sed -e "s$/[1-9][0-9]*$$g" -e "s/_\\[\\([<>]\\)/[\\1/g" -e "s/'\\(_[a-z0-9_]*\\)/'eliom_inferred_type_\\1/g")))))) (rule (copy# ../eliom_service_sigs.shared.mli eliom_service_sigs.mli)) (rule (target eliom_shared.ml) (deps ../eliom_shared.eliom) (action (with-stdout-to %{target} (chdir .. (run ppx_eliom_server --as-pp --impl %{deps}))))) -(rule (target eliom_shared.type_mli) (deps ../eliom_shared.eliom) - (action - (progn - (ignore-stdout (echo %{cmo:eliom_shared})) - (with-stdout-to %{target} - (pipe-stdout - (chdir .. (run ocamlfind ocamlc -package lwt_ppx %{read-lines:includes} -I server/.eliom_server.objs/byte -i -ppx "%{bin:ppx_eliom_types} --as-ppx" -impl %{deps})) - (run sed -e "s$/[1-9][0-9]*$$g" -e "s/_\\[\\([<>]\\)/[\\1/g" -e "s/'\\(_[a-z0-9_]*\\)/'eliom_inferred_type_\\1/g")))))) (rule (copy# ../eliom_shared.server.mli eliom_shared.mli)) (rule (target eliom_shared_content.ml) (deps ../eliom_shared_content.eliom) (action (with-stdout-to %{target} (chdir .. (run ppx_eliom_server --as-pp --impl %{deps}))))) -(rule (target eliom_shared_content.type_mli) (deps ../eliom_shared_content.eliom) - (action - (progn - (ignore-stdout (echo %{cmo:eliom_shared_content})) - (with-stdout-to %{target} - (pipe-stdout - (chdir .. (run ocamlfind ocamlc -package lwt_ppx %{read-lines:includes} -I server/.eliom_server.objs/byte -i -ppx "%{bin:ppx_eliom_types} --as-ppx" -impl %{deps})) - (run sed -e "s$/[1-9][0-9]*$$g" -e "s/_\\[\\([<>]\\)/[\\1/g" -e "s/'\\(_[a-z0-9_]*\\)/'eliom_inferred_type_\\1/g")))))) (rule (target eliom_shared_content.mli) (deps ../eliom_shared_content.eliomi) (action (with-stdout-to %{target} @@ -162,14 +106,6 @@ (action (with-stdout-to %{target} (chdir .. (run ppx_eliom_server --as-pp --impl %{deps}))))) -(rule (target eliom_tools.type_mli) (deps ../eliom_tools.eliom) - (action - (progn - (ignore-stdout (echo %{cmo:eliom_tools})) - (with-stdout-to %{target} - (pipe-stdout - (chdir .. (run ocamlfind ocamlc -package lwt_ppx %{read-lines:includes} -I server/.eliom_server.objs/byte -i -ppx "%{bin:ppx_eliom_types} --as-ppx" -impl %{deps})) - (run sed -e "s$/[1-9][0-9]*$$g" -e "s/_\\[\\([<>]\\)/[\\1/g" -e "s/'\\(_[a-z0-9_]*\\)/'eliom_inferred_type_\\1/g")))))) (rule (target eliom_tools.mli) (deps ../eliom_tools.eliomi) (action (with-stdout-to %{target} diff --git a/src/ppx/ppx_eliom_utils.ml b/src/ppx/ppx_eliom_utils.ml index 55fdca4939..6f9bcb7b7b 100644 --- a/src/ppx/ppx_eliom_utils.ml +++ b/src/ppx/ppx_eliom_utils.ml @@ -330,7 +330,9 @@ module Cmo = struct | Oide_apply (id, id') -> Lapply (ident_of_out_ident id, ident_of_out_ident id') | Oide_dot (id, nm) -> Ldot (ident_of_out_ident id, nm) - | Oide_ident {printed_name = nm} -> Lident nm + | Oide_ident {printed_name = nm} -> + Lident + (try String.sub nm 0 (String.index nm '/') with Not_found -> nm) let counter = ref 0 diff --git a/src/tools/gen_dune.ml b/src/tools/gen_dune.ml index 90c345b722..44166deded 100644 --- a/src/tools/gen_dune.ml +++ b/src/tools/gen_dune.ml @@ -15,8 +15,14 @@ let handle_file_client nm = then let nm = Filename.chop_suffix nm ".eliom" in Printf.printf - "(rule (target %s.ml) (deps ../%s.eliom ../server/%s.type_mli)\n\ (action\n\ (with-stdout-to %%{target}\n\ (chdir .. (run ppx_eliom_client -type server/%s.type_mli --as-pp --impl %s.eliom)))))\n" - nm nm nm nm nm + "(rule (target %s.ml) (deps ../%s.eliom)\n\ (action\n\ (with-stdout-to %%{target}\n\ (chdir .. (run ppx_eliom_client --as-pp -server-cmo %%{cmo:../server/%s} --impl %%{deps})))))\n" + nm nm nm + else if Filename.check_suffix nm ".eliomi" + then + let nm = Filename.chop_suffix nm ".eliomi" in + Printf.printf + "(rule (target %s.mli) (deps ../%s.eliomi)\n\ (action\n\ (with-stdout-to %%{target}\n\ (chdir .. (run ppx_eliom_client --as-pp --intf %%{deps})))))\n" + nm nm (* let handle_file_server nm = @@ -48,14 +54,11 @@ let handle_file_server nm = else if Filename.check_suffix nm ".shared.mli" then copy_file ".shared.mli" else if Filename.check_suffix nm ".eliom" - then ( + then let nm = Filename.chop_suffix nm ".eliom" in Printf.printf "(rule (target %s.ml) (deps ../%s.eliom)\n\ (action\n\ (with-stdout-to %%{target}\n\ (chdir .. (run ppx_eliom_server --as-pp --impl %%{deps})))))\n" - nm nm; - Printf.printf - "(rule (target %s.type_mli) (deps ../%s.eliom)\n\ (action\n\ (progn\n\ (ignore-stdout (echo %%{cmo:%s}))\n\ (with-stdout-to %%{target}\n\ (pipe-stdout\n\ (chdir .. (run ocamlfind ocamlc -package lwt_ppx %%{read-lines:includes} -I server/.eliom_server.objs/byte -i -ppx \"%%{bin:ppx_eliom_types} --as-ppx\" -impl %%{deps}))\n\ (run sed -e \"s$/[1-9][0-9]*$$g\" -e \"s/_\\\\[\\\\([<>]\\\\)/[\\\\1/g\" -e \"s/'\\\\(_[a-z0-9_]*\\\\)/'eliom_inferred_type_\\\\1/g\"))))))\n" - nm nm nm) + nm nm else if Filename.check_suffix nm ".eliomi" then let nm = Filename.chop_suffix nm ".eliomi" in