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.

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

Fix all warnings #774

Merged
merged 2 commits into from
Dec 8, 2023
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
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
7 changes: 2 additions & 5 deletions src/lib/client/dune
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,7 @@
(public_name eliom.client)
(synopsis "Eliom: client-side")
(wrapped false)
(modes byte)
(modules_without_implementation eliom_content_sigs eliom_form_sigs
eliom_parameter_sigs eliom_registration_sigs eliom_service_sigs
eliom_shared_sigs eliom_wrap)
Expand All @@ -24,8 +25,4 @@
(action
(with-stdout-to
%{target}
(run ../../tools/gen_dune.exe --client ..))))

(env
(_
(flags (:standard -w -9 -warn-error -6-16-22-27-32-37-39-67-69))))
(run ../../tools/gen_dune.exe --client ..))))
2 changes: 1 addition & 1 deletion src/lib/client/eliommod_cookies.ml
Original file line number Diff line number Diff line change
Expand Up @@ -104,7 +104,7 @@ let get_cookies_to_send ?(in_local_storage = false) host https path =
match exp with
| Some exp when exp <= now ->
set_table ~in_local_storage host
(Ocsigen_cookie_map.Poly.remove cpath name
(Ocsigen_cookie_map.Poly.remove ~path:cpath name
(get_table ~in_local_storage host));
cookies_to_send
| _ ->
Expand Down
2 changes: 1 addition & 1 deletion src/lib/eliom_bus.client.ml
Original file line number Diff line number Diff line change
Expand Up @@ -147,7 +147,7 @@ let try_flush t =
Lwt.return_unit

let write t v = Queue.add v t.queue; try_flush t
let close {channel} = Eliom_comet.close channel
let close {channel; _} = Eliom_comet.close channel
let set_queue_size b s = b.max_size <- s

let set_time_before_flush b t =
Expand Down
3 changes: 2 additions & 1 deletion src/lib/eliom_bus.server.ml
Original file line number Diff line number Diff line change
Expand Up @@ -30,6 +30,7 @@ type ('a, 'b) t =
; service_registered : bool Eliom_state.volatile_table option
; size : int option
; bus_mark : ('a, 'b) t Eliom_common.wrapper (* must be the last field ! *) }
[@@warning "-69"]

let register_sender scope service write =
Eliom_registration.Action.register ~scope ~options:`NoReload ~service
Expand All @@ -52,7 +53,7 @@ let internal_wrap (bus : ('a, 'b) t)
match Eliom_state.get_volatile_data ~table () with
| Eliom_state.Data true -> ()
| _ ->
let {service = Ecb.Bus_send_service srv} = bus in
let {service = Ecb.Bus_send_service srv; _} = bus in
register_sender bus.scope
(srv
:> ( _
Expand Down
17 changes: 10 additions & 7 deletions src/lib/eliom_client.client.ml
Original file line number Diff line number Diff line change
Expand Up @@ -109,7 +109,7 @@ let check_global_data global_data =
"Code generating the following client values is not linked on the client:\n%s"
(String.concat "\n"
(List.rev_map
(fun (compilation_unit_id, {Eliom_runtime.closure_id; value}) ->
(fun (compilation_unit_id, {Eliom_runtime.closure_id; value; _}) ->
let instance_id =
Eliom_runtime.Client_value_server_repr.instance_id value
in
Expand Down Expand Up @@ -445,6 +445,7 @@ type tmp_recontent =
(* arguments ('econtent') are already unwrapped. *)
| RELazy of Xml.econtent Eliom_lazy.request
| RE of Xml.econtent
[@@warning "-37"]

type tmp_elt =
{(* to be unwrapped *)
Expand Down Expand Up @@ -854,7 +855,7 @@ let get_global_data () =
Js.Opt.case storage ## (getItem id) def @@ fun v ->
Lwt_log.ign_debug_f "Unwrap __global_data";
match Eliom_unwrap.unwrap (Url.decode (Js.to_string v)) 0 with
| {Eliom_runtime.ecs_data = `Success v} ->
| {Eliom_runtime.ecs_data = `Success v; _} ->
Lwt_log.ign_debug_f "Unwrap __global_data success";
Some v
| _ -> None
Expand Down Expand Up @@ -943,10 +944,10 @@ let init () =
match
Url.url_of_string (Js.to_string Js.Unsafe.global##.___eliom_server_)
with
| Some (Http {hu_host; hu_port}) ->
| Some (Http {hu_host; hu_port; _}) ->
init_client_app ~app_name ~ssl:false ~hostname:hu_host ~port:hu_port
~site_dir ()
| Some (Https {hu_host; hu_port}) ->
| Some (Https {hu_host; hu_port; _}) ->
init_client_app ~app_name ~ssl:true ~hostname:hu_host ~port:hu_port
~site_dir ()
| _ -> ());
Expand Down Expand Up @@ -1340,7 +1341,7 @@ end

let is_in_cache state_id =
match History.find_by_state_index state_id.state_index with
| Some {dom = Some _} -> true
| Some {dom = Some _; _} -> true
| _ -> false

let stash_reload_function f =
Expand Down Expand Up @@ -1632,7 +1633,7 @@ let make_uri subpath params =
and params = List.map (fun (s, s') -> s, `String (Js.string s')) params in
Eliom_uri.make_string_uri_from_components (base, params, None)

let route ({Eliom_route.i_subpath; i_get_params; i_post_params} as info) =
let route ({Eliom_route.i_subpath; i_get_params; i_post_params; _} as info) =
Lwt_log.ign_debug ~section:section_page "Route";
let info, i_subpath =
match i_subpath with
Expand Down Expand Up @@ -2078,7 +2079,9 @@ let () =
Lwt_log.ign_debug ~section:section_page
"revisit: session has not changed";
let old_page = History.find_by_state_index state_id.state_index in
let rf = Option.bind old_page @@ fun {reload_function = rf} -> rf in
let rf =
Option.bind old_page @@ fun {reload_function = rf; _} -> rf
in
reload_function := rf;
let%lwt () = run_lwt_callbacks ev (flush_onchangepage ()) in
with_new_page ~state_id ?old_page ~replace:false () @@ fun () ->
Expand Down
3 changes: 2 additions & 1 deletion src/lib/eliom_client_core.client.ml
Original file line number Diff line number Diff line change
Expand Up @@ -137,7 +137,7 @@ end = struct
Lwt_log.raise_error_f "Did not find injection %s" name))

let initialize ~compilation_unit_id
{Eliom_runtime.injection_id; injection_value}
{Eliom_runtime.injection_id; injection_value; _}
=
Lwt_log.ign_debug_f ~section "Initialize injection %d" injection_id;
(* BBB One should assert that injection_value doesn't contain any
Expand Down Expand Up @@ -606,6 +606,7 @@ end = struct

type t =
{mutable node : Dom.node Js.t option; mutable signal : unit React.S.t option}
[@@warning "-69"]

let signals : (Dom.node Js.t, t array) weakMap Js.t =
let weakMap = Js.Unsafe.global##._WeakMap in
Expand Down
4 changes: 2 additions & 2 deletions src/lib/eliom_client_value.server.ml
Original file line number Diff line number Diff line change
Expand Up @@ -23,8 +23,8 @@ let client_value_unwrapper =
Eliom_wrap.create_unwrapper
(Eliom_wrap.id_of_int Eliom_runtime.client_value_unwrap_id_int)

let create_client_value ?loc ~instance_id =
Eliom_runtime.Client_value_server_repr.create ?loc ~instance_id
let create_client_value ~loc ~instance_id =
Eliom_runtime.Client_value_server_repr.create ~loc ~instance_id
~unwrapper:client_value_unwrapper

let client_value_from_server_repr cv = cv
Expand Down
2 changes: 1 addition & 1 deletion src/lib/eliom_client_value.server.mli
Original file line number Diff line number Diff line change
Expand Up @@ -40,7 +40,7 @@ exception Client_value_creation_invalid_context of string
(**/**)

val create_client_value
: ?loc:Eliom_lib.pos
: loc:Eliom_lib.pos option
-> instance_id:int
-> _ Eliom_runtime.Client_value_server_repr.t

Expand Down
25 changes: 14 additions & 11 deletions src/lib/eliom_comet.client.ml
Original file line number Diff line number Diff line change
Expand Up @@ -262,7 +262,6 @@ end = struct
type 'a t =
{ hd_service : Ecb.comet_service
; hd_state : channel_state
; hd_kind : 'a kind
; hd_activity : activity }

let add_listener target event f =
Expand Down Expand Up @@ -375,20 +374,20 @@ end = struct
if q <> []
then (
queue := [];
Eliom_client.call_service service ()
Eliom_client.call_service ~service ()
(false, Ecb.Stateful (Ecb.Commands (Array.of_list (List.rev q)))))
else Lwt.return ""
| _ ->
let%lwt () = Eliom_client.wait_load_end () in
Eliom_client.call_service service () p
Eliom_client.call_service ~service () p

let make_request hd =
match hd.hd_state with
| Stateful_state count -> Ecb.Stateful (Ecb.Request_data !count)
| Stateless_state map ->
let l =
Eliom_lib.String.Table.fold
(fun channel {position} l -> (channel, position) :: l)
(fun channel {position; _} l -> (channel, position) :: l)
!map []
in
Ecb.Stateless (Array.of_list l)
Expand Down Expand Up @@ -458,7 +457,7 @@ end = struct
raise (Comet_error "update_stateless_state on stateful one")

let call_service
({hd_activity; hd_service = Ecb.Comet_service (srv, queue)} as hd)
({hd_activity; hd_service = Ecb.Comet_service (srv, queue); _} as hd)
=
let%lwt () =
Configuration.sleep_before_next_request
Expand Down Expand Up @@ -539,7 +538,7 @@ end = struct
in
update_activity hd; aux 0

let call_commands {hd_service = Ecb.Comet_service (srv, queue)} command =
let call_commands {hd_service = Ecb.Comet_service (srv, queue); _} command =
ignore
(try%lwt
call_service_after_load_end srv queue
Expand Down Expand Up @@ -619,7 +618,7 @@ end = struct
| Stateless -> Stateless_state (ref Eliom_lib.String.Table.empty)
| Stateful -> Stateful_state (ref 0)
in
let hd = {hd_service; hd_state; hd_kind; hd_activity = init_activity ()} in
let hd = {hd_service; hd_state; hd_activity = init_activity ()} in
handle_visibility hd; hd
end

Expand Down Expand Up @@ -668,21 +667,25 @@ let get_stateless_hd (service : Ecb.comet_service)
init service Service_handler.stateless stateless_handler_table

let activate () =
let f _ {hd_service_handler} = Service_handler.activate hd_service_handler in
let f _ {hd_service_handler; _} =
Service_handler.activate hd_service_handler
in
Hashtbl.iter f stateless_handler_table;
Hashtbl.iter f stateful_handler_table

let restart () =
let f _ {hd_service_handler} = Service_handler.restart hd_service_handler in
let f _ {hd_service_handler; _} =
Service_handler.restart hd_service_handler
in
Hashtbl.iter f stateless_handler_table;
Hashtbl.iter f stateful_handler_table

let close = function
| Ecb.Stateful_channel (chan_service, chan_id) ->
let {hd_service_handler} = get_stateful_hd chan_service in
let {hd_service_handler; _} = get_stateful_hd chan_service in
Service_handler.close hd_service_handler (Ecb.string_of_chan_id chan_id)
| Ecb.Stateless_channel (chan_service, chan_id, _kind) ->
let {hd_service_handler} = get_stateless_hd chan_service in
let {hd_service_handler; _} = get_stateless_hd chan_service in
Service_handler.close hd_service_handler (Ecb.string_of_chan_id chan_id)

let unmarshal s : 'a = Eliom_unwrap.unwrap (Eliom_lib.Url.decode s) 0
Expand Down
23 changes: 14 additions & 9 deletions src/lib/eliom_comet.server.ml
Original file line number Diff line number Diff line change
Expand Up @@ -280,9 +280,9 @@ end = struct
Eliom_comet_base.Comet_service
(Eliom_common.force_lazy_site_value global_service, queue)

let get_id {ch_id} = ch_id
let get_id {ch_id; _} = ch_id

let get_kind ~newest {ch_index} =
let get_kind ~newest {ch_index; _} =
if newest
then Eliom_comet_base.Newest_kind (ch_index + 1)
else Eliom_comet_base.After_kind (ch_index + 1)
Expand Down Expand Up @@ -442,11 +442,11 @@ end = struct
else
match channels with
| [] -> acc
| (id, Events {queue}) :: rem ->
| (id, Events {queue; _}) :: rem ->
if Queue.is_empty queue
then take n acc rem
else take (n - 1) ((id, Queue.take queue) :: acc) channels
| (id, Stream ({stream} as s)) :: rem ->
| (id, Stream ({stream; _} as s)) :: rem ->
let l =
Lwt.with_value Eliom_common.sp_key None @@ fun () ->
Lwt_stream.get_available_up_to n stream
Expand All @@ -459,7 +459,9 @@ end = struct
let wait_channels handler =
List.fold_left
(fun acc (_, channel) ->
match channel with Events _ -> acc | Stream {waiter} -> waiter :: acc)
match channel with
| Events _ -> acc
| Stream {waiter; _} -> waiter :: acc)
[] handler.hd_active_channels

(** wait for data on any channel that the client asks. It correctly
Expand Down Expand Up @@ -567,7 +569,7 @@ end = struct
empty answer *)
Lwt.return (encode_downgoing [])
in
let {hd_service = Eliom_comet_base.Internal_comet_service (service, _)} =
let {hd_service = Eliom_comet_base.Internal_comet_service (service, _); _} =
handler
in
Comet.register ~scope:handler.hd_scope ~service f
Expand Down Expand Up @@ -727,10 +729,12 @@ end = struct
(name, channel) :: handler.hd_unregistered_channels;
{ch_handler = handler; ch_id = name}

let get_id {ch_id} = ch_id
let get_id {ch_id; _} = ch_id

let get_service {ch_handler} =
let {hd_service = Ecb.Internal_comet_service (srv, queue)} = ch_handler in
let get_service {ch_handler; _} =
let {hd_service = Ecb.Internal_comet_service (srv, queue); _} =
ch_handler
in
Ecb.Comet_service (srv, queue)
end

Expand Down Expand Up @@ -783,6 +787,7 @@ end = struct
| External of 'a Eliom_comet_base.wrapped_channel

type 'a t = {channel : 'a channel; channel_mark : 'a t Eliom_common.wrapper}
[@@warning "-69"]

let get_wrapped t =
match t.channel with
Expand Down
10 changes: 7 additions & 3 deletions src/lib/eliom_comet_base.shared.ml
Original file line number Diff line number Diff line change
Expand Up @@ -24,6 +24,8 @@ type 'a chan_id = string
external string_of_chan_id : 'a chan_id -> string = "%identity"
external chan_id_of_string : string -> 'a chan_id = "%identity"

[@@@warning "-39"]

type position =
| Newest of int
| After of int
Expand All @@ -41,9 +43,6 @@ type comet_request =
| Stateful of comet_stateful_request
[@@deriving json]

let comet_request_param =
Eliom_parameter.ocaml "comet_request" [%json: comet_request]

type 'a channel_data = Data of 'a | Full | Closed [@@deriving json]

type answer =
Expand All @@ -54,6 +53,11 @@ type answer =
| Comet_error of string
[@@deriving json]

[@@@warning "+39"]

let comet_request_param =
Eliom_parameter.ocaml "comet_request" [%json: comet_request]

type comet_service =
| Comet_service :
( unit
Expand Down
4 changes: 2 additions & 2 deletions src/lib/eliom_common.client.ml
Original file line number Diff line number Diff line change
Expand Up @@ -60,8 +60,8 @@ let add_unregistered _ _ = ()
module To_and_of_shared = struct
type 'a t = 'a to_and_of

let of_string {of_string} = of_string
let to_string {to_string} = to_string
let of_string {of_string; _} = of_string
let to_string {to_string; _} = to_string
let to_and_of tao = tao
end

Expand Down
Loading