Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Dune improvements #773

Merged
merged 2 commits into from
Dec 8, 2023
Merged

Dune improvements #773

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
444a7e4
Dune improvements
vouillon Dec 4, 2023
1a224dc
Fix compilation with dune 3.12
vouillon Dec 4, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion src/lib/client/dune
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -24,7 +24,7 @@
(action
(with-stdout-to
%{target}
(run ocaml ../../tools/gen_dune.ml --client ..))))
(run ../../tools/gen_dune.exe --client ..))))

(env
(_
Expand Down
48 changes: 32 additions & 16 deletions src/lib/client/dune.client
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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))
Expand All @@ -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))
Expand Down Expand Up @@ -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))
Expand Down
75 changes: 49 additions & 26 deletions src/lib/eliom_shared.eliom
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)]
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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 =
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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')
Expand Down
10 changes: 4 additions & 6 deletions src/lib/server/dune
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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 ')'"))))
Expand Down
Loading
Loading