diff --git a/src/lib/client/dune b/src/lib/client/dune index 4348345bdb..611b23de3c 100644 --- a/src/lib/client/dune +++ b/src/lib/client/dune @@ -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) @@ -25,7 +26,3 @@ (with-stdout-to %{target} (run ocaml ../../tools/gen_dune.ml --client ..)))) - -(env - (_ - (flags (:standard -w -9 -warn-error -6-16-22-27-32-37-39-67-69)))) diff --git a/src/lib/client/eliommod_cookies.ml b/src/lib/client/eliommod_cookies.ml index b8ffc386e0..19e4a995b8 100644 --- a/src/lib/client/eliommod_cookies.ml +++ b/src/lib/client/eliommod_cookies.ml @@ -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 | _ -> diff --git a/src/lib/eliom_bus.client.ml b/src/lib/eliom_bus.client.ml index 48ed9c8fd6..9e3caca55b 100644 --- a/src/lib/eliom_bus.client.ml +++ b/src/lib/eliom_bus.client.ml @@ -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 = diff --git a/src/lib/eliom_bus.server.ml b/src/lib/eliom_bus.server.ml index 9911a122fa..c6dca29259 100644 --- a/src/lib/eliom_bus.server.ml +++ b/src/lib/eliom_bus.server.ml @@ -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 @@ -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 :> ( _ diff --git a/src/lib/eliom_client.client.ml b/src/lib/eliom_client.client.ml index 68dc9060ef..f05f39af89 100644 --- a/src/lib/eliom_client.client.ml +++ b/src/lib/eliom_client.client.ml @@ -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 @@ -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 *) @@ -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 @@ -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 () | _ -> ()); @@ -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 = @@ -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 @@ -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 () -> diff --git a/src/lib/eliom_client_core.client.ml b/src/lib/eliom_client_core.client.ml index 534eb680d0..3146b34751 100644 --- a/src/lib/eliom_client_core.client.ml +++ b/src/lib/eliom_client_core.client.ml @@ -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 @@ -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 diff --git a/src/lib/eliom_client_value.server.ml b/src/lib/eliom_client_value.server.ml index fd281324a0..3dcb09d321 100644 --- a/src/lib/eliom_client_value.server.ml +++ b/src/lib/eliom_client_value.server.ml @@ -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 diff --git a/src/lib/eliom_client_value.server.mli b/src/lib/eliom_client_value.server.mli index c093e7895e..2ca225e007 100644 --- a/src/lib/eliom_client_value.server.mli +++ b/src/lib/eliom_client_value.server.mli @@ -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 diff --git a/src/lib/eliom_comet.client.ml b/src/lib/eliom_comet.client.ml index c86c62b9f2..427ca16057 100644 --- a/src/lib/eliom_comet.client.ml +++ b/src/lib/eliom_comet.client.ml @@ -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 = @@ -375,12 +374,12 @@ 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 @@ -388,7 +387,7 @@ end = struct | 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) @@ -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 @@ -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 @@ -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 @@ -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 diff --git a/src/lib/eliom_comet.server.ml b/src/lib/eliom_comet.server.ml index 7a8c456d58..07ab85205d 100644 --- a/src/lib/eliom_comet.server.ml +++ b/src/lib/eliom_comet.server.ml @@ -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) @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 diff --git a/src/lib/eliom_comet_base.shared.ml b/src/lib/eliom_comet_base.shared.ml index bc2be58e50..8204bc7385 100644 --- a/src/lib/eliom_comet_base.shared.ml +++ b/src/lib/eliom_comet_base.shared.ml @@ -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 @@ -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 = @@ -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 diff --git a/src/lib/eliom_common.client.ml b/src/lib/eliom_common.client.ml index 7401108de1..59568e238c 100644 --- a/src/lib/eliom_common.client.ml +++ b/src/lib/eliom_common.client.ml @@ -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 diff --git a/src/lib/eliom_common.server.ml b/src/lib/eliom_common.server.ml index cacbcb7e2f..3f955b80e8 100644 --- a/src/lib/eliom_common.server.ml +++ b/src/lib/eliom_common.server.ml @@ -522,7 +522,7 @@ let make_full_state_name2 site_dir_str secure ~(scope : [< user_scope]) {user_scope = (scope :> user_scope); secure; site_dir_str} let make_full_state_name ~sp ~secure ~(scope : [< user_scope]) = - make_full_state_name2 sp.sp_sitedata.site_dir_string secure scope + make_full_state_name2 sp.sp_sitedata.site_dir_string secure ~scope let get_cookie_info sp = function | `Session -> sp.sp_cookie_info @@ -538,7 +538,7 @@ type info = (*****************************************************************************) (** Create server parameters record *) -let make_server_params sitedata ({request = ri; session_info = si} as info) +let make_server_params sitedata ({request = ri; session_info = si; _} as info) suffix full_state_name = let appl_name = @@ -881,6 +881,8 @@ let eliom_params_after_action = Polytables.make_key () (* After an action, we get tab_cookies info from rc: *) let tab_cookie_action_info_key = Polytables.make_key () +[@@@warning "-39"] + type cpi = client_process_info = { cpi_ssl : bool ; cpi_hostname : string @@ -888,6 +890,8 @@ type cpi = client_process_info = ; cpi_original_full_path : string list } [@@deriving json] +[@@@warning "+39"] + let matches_regexp name (_, re) = try let _ = Re.exec re name in @@ -1252,7 +1256,8 @@ exception Eliom_retry_with of info module Omit_persistent_storage = struct let check_if_omitting_storage () = match get_sp_option () with - | Some {sp_request; sp_sitedata = {omitpersistentstorage = Some rules}} -> + | Some {sp_request; sp_sitedata = {omitpersistentstorage = Some rules; _}; _} + -> let apply_rule = function | HeaderRule (header_name, regexp) -> ( match @@ -1394,7 +1399,7 @@ let bus_unwrap_id : unwrap_id = Eliom_wrap.id_of_int bus_unwrap_id_int (* HACK: Remove the 'nl_get_appl_parameter' used to avoid confusion between XHR and classical request in App. *) -let patch_request_info ({Ocsigen_extensions.request_info} as r) = +let patch_request_info ({Ocsigen_extensions.request_info; _} as r) = let u = Ocsigen_request.uri request_info in match Uri.get_query_param u nl_get_appl_parameter with | Some _ -> @@ -1422,18 +1427,19 @@ module To_and_of_shared = struct { server : 'a to_and_of ; client : 'a to_and_of Eliom_client_value.t option ; wrapper : wrapper } + [@@warning "-69"] let wrapper : wrapper = Obj.magic @@ Eliom_wrap.create_wrapper @@ function - | {client = Some tao} -> tao - | {client = None} -> + | {client = Some tao; _} -> tao + | {client = None; _} -> failwith "Cannot wrap user type parameter.\nUse the ?client_to_and_of parameter of Eliom_parameter.user_type\nor (Eliom_parameter.all_suffix_user)" - let to_string {server = {to_string}} = to_string - let of_string {server = {of_string}} = of_string - let to_and_of {server} = server + let to_string {server = {to_string; _}; _} = to_string + let of_string {server = {of_string; _}; _} = of_string + let to_and_of {server; _} = server let create ?client_to_and_of server = {server; client = client_to_and_of; wrapper} diff --git a/src/lib/eliom_content_core.client.ml b/src/lib/eliom_content_core.client.ml index 942d089da6..f5ff964bef 100644 --- a/src/lib/eliom_content_core.client.ml +++ b/src/lib/eliom_content_core.client.ml @@ -74,7 +74,7 @@ module Xml = struct in {node_id = id; elt = Lazy.from_fun f} - let force_lazy {elt} = ignore (Lazy.force elt) + let force_lazy {elt; _} = ignore (Lazy.force elt) let make_react ?(id = NoId) signal = {elt = Lazy.from_val (ReactNode signal); node_id = id} diff --git a/src/lib/eliom_content_core.server.ml b/src/lib/eliom_content_core.server.ml index 7cb3a861c1..50e028aaa6 100644 --- a/src/lib/eliom_content_core.server.ml +++ b/src/lib/eliom_content_core.server.ml @@ -48,11 +48,13 @@ module Xml = struct { recontent : recontent ; node_id : node_id ; unwrapper_mark : Eliom_wrap.unwrapper } + [@@warning "-69"] and elt = {elt : elt'; wrapper_mark : elt Eliom_wrap.wrapper} + [@@warning "-69"] (** Values of type [elt] are wrapped values of type [elt']. *) - let content {elt} = + let content {elt; _} = match elt.recontent with RE e -> e | RELazy e -> Eliom_lazy.force e module Node_id_set = Set.Make (struct @@ -64,15 +66,15 @@ module Xml = struct let node_ids_in_content = ref Node_id_set.empty let wrapper_mark = - Eliom_wrap.create_wrapper (fun {elt} -> + Eliom_wrap.create_wrapper (fun {elt; _} -> if Node_id_set.mem elt.node_id !node_ids_in_content then {elt with recontent = RE Empty} else elt) let wrap page value = let node_ids = ref [] in - let rec collect_node_ids ({elt} as elt') = - let {node_id} = elt in + let rec collect_node_ids ({elt; _} as elt') = + let {node_id; _} = elt in if node_id <> NoId then node_ids := node_id :: !node_ids; match content elt' with | Empty | Comment _ | EncodedPCDATA _ | PCDATA _ | Entity _ | Leaf _ -> () @@ -85,7 +87,7 @@ module Xml = struct node_ids_in_content := Node_id_set.empty; res - let get_node_id {elt} = elt.node_id + let get_node_id {elt; _} = elt.node_id let tyxml_unwrap_id = Eliom_wrap.id_of_int Eliom_runtime.tyxml_unwrap_id_int let make elt = @@ -163,9 +165,7 @@ module Xml = struct (as this string is to be considered as the end of the cdata) *) let s' = - "\n\n" + "\n\n" in encodedpcdata s' @@ -175,9 +175,7 @@ module Xml = struct (as this string is to be considered as the end of the cdata) *) let s' = - "\n//\n" + "\n//\n" in encodedpcdata s' @@ -253,7 +251,7 @@ module Xml = struct | Node (ename, attribs, sons) -> Node (ename, filter_class_attribs node_id attribs, sons) - let content {elt} = + let content {elt; _} = let c = match elt.recontent with RE e -> e | RELazy e -> Eliom_lazy.force e in @@ -404,6 +402,7 @@ module Html = struct ; to_string : 'a -> string ; of_string : string -> 'a ; default : 'a option } + [@@warning "-69"] let create ~name ?default ~to_string ~of_string () = {name; of_string; to_string; default} diff --git a/src/lib/eliom_content_core.server.mli b/src/lib/eliom_content_core.server.mli index 5f5b0e7545..c4d830e41d 100644 --- a/src/lib/eliom_content_core.server.mli +++ b/src/lib/eliom_content_core.server.mli @@ -117,7 +117,7 @@ module Svg : sig module Make (Xml : Xml_sigs.T with type elt = Xml.elt and type attrib = Xml.attrib) - (C : Svg_sigs.Wrapped_functions with module Xml = Xml) : + (_ : Svg_sigs.Wrapped_functions with module Xml = Xml) : Svg_sigs.Make(Xml).T with type +'a elt = 'a elt and type +'a attrib = 'a attrib @@ -194,7 +194,7 @@ module Html : sig module Make (Xml : Xml_sigs.T with type elt = Xml.elt and type attrib = Xml.attrib) - (C : Html_sigs.Wrapped_functions with module Xml = Xml) + (_ : Html_sigs.Wrapped_functions with module Xml = Xml) (Svg : Svg_sigs.T with module Xml := Xml) : Html_sigs.Make(Xml)(Svg).T with type +'a elt = 'a elt diff --git a/src/lib/eliom_cookies_base.shared.ml b/src/lib/eliom_cookies_base.shared.ml index 5e5950b578..fb6b7dc5a4 100644 --- a/src/lib/eliom_cookies_base.shared.ml +++ b/src/lib/eliom_cookies_base.shared.ml @@ -1,3 +1,5 @@ +[@@@warning "-39"] + type cookie = Ocsigen_cookie_map.cookie = | OSet of float option (* exp date *) * string (* value *) * bool (* secure *) | OUnset @@ -6,6 +8,8 @@ type cookie = Ocsigen_cookie_map.cookie = type cookie_array = (string array * (string * cookie) array) array [@@deriving json] +[@@@warning "+39"] + (** changes to cookieset_to_json must be completed by corresponding changes in cookieset_of_json *) let cookieset_to_json set = diff --git a/src/lib/eliom_lazy.server.ml b/src/lib/eliom_lazy.server.ml index 1fb7819cd8..1e5cf861f2 100644 --- a/src/lib/eliom_lazy.server.ml +++ b/src/lib/eliom_lazy.server.ml @@ -1,4 +1,5 @@ type 'a request = {data : unit -> 'a; mark : 'a request Eliom_wrap.wrapper} +[@@warning "-69"] let mark = Eliom_wrap.create_wrapper (fun l -> l.data ()) let from_fun data = {data; mark} diff --git a/src/lib/eliom_lib.client.ml b/src/lib/eliom_lib.client.ml index 8fb001cec4..81a67be1af 100644 --- a/src/lib/eliom_lib.client.ml +++ b/src/lib/eliom_lib.client.ml @@ -66,9 +66,9 @@ module Url = struct String.concat "/" l let path_of_url = function - | Url.Http {Url.hu_path = path} - | Url.Https {Url.hu_path = path} - | Url.File {Url.fu_path = path} -> + | Url.Http {Url.hu_path = path; _} + | Url.Https {Url.hu_path = path; _} + | Url.File {Url.fu_path = path; _} -> path let path_of_url_string s = diff --git a/src/lib/eliom_parameter.client.ml b/src/lib/eliom_parameter.client.ml index 56024bc227..abb1cef7db 100644 --- a/src/lib/eliom_parameter.client.ml +++ b/src/lib/eliom_parameter.client.ml @@ -115,7 +115,7 @@ and reconstruct_params_form reconstruct_atom ~f m (name ^ ".x") >>= fun (abscissa, m) -> reconstruct_atom ~f m (name ^ ".y") >>= fun (ordinate, m) -> Some ({abscissa; ordinate}, m) - | TUserType (name, {of_string = f}) -> reconstruct_atom ~f m name + | TUserType (name, {of_string = f; _}) -> reconstruct_atom ~f m name | _ -> None let user_type ~of_string ~to_string n = TUserType (n, {of_string; to_string}) @@ -126,7 +126,7 @@ let all_suffix_user ~of_string ~to_string n = let reconstruct_params_form l y = reconstruct_params_form (M.of_assoc_list l) y >>= fun (v, _) -> Some v -let get_non_localized_get_parameters {name; param} = +let get_non_localized_get_parameters {name; param; _} = (* Simplified version of the server-side code that - only deals with GET params - doesn't cache the result diff --git a/src/lib/eliom_parameter.server.ml b/src/lib/eliom_parameter.server.ml index bcbdbe506d..796382620e 100644 --- a/src/lib/eliom_parameter.server.ml +++ b/src/lib/eliom_parameter.server.ml @@ -46,7 +46,7 @@ let all_suffix_user ?client_to_and_of ~(of_string : string -> 'a) let regexp reg dest ~to_string n = user_type - (fun s -> + ~of_string:(fun s -> match Re.Pcre.exec ~rex:reg ~pos:0 s with | g when Re.Group.start g 0 = 0 -> ( try @@ -55,14 +55,14 @@ let regexp reg dest ~to_string n = s with Ocsigen_extensions.NoSuchUser -> raise (Failure "User does not exist")) - | _ | exception Not_found -> raise (Failure "Regexp not matching")) - to_string n + | _ | (exception Not_found) -> raise (Failure "Regexp not matching")) + ~to_string n let all_suffix_regexp reg dest ~(to_string : 'a -> string) (n : string) : (string, [`Endsuffix], [`One of string] param_name) params_type = all_suffix_user - (fun s -> + ~of_string:(fun s -> match Re.Pcre.exec ~rex:reg ~pos:0 s with | g when Re.Group.start g 0 = 0 -> ( try @@ -71,13 +71,13 @@ let all_suffix_regexp reg dest ~(to_string : 'a -> string) (n : string) s with Ocsigen_extensions.NoSuchUser -> raise (Failure "User does not exist")) - | _ | exception Not_found -> raise (Failure "Regexp not matching")) - to_string n + | _ | (exception Not_found) -> raise (Failure "Regexp not matching")) + ~to_string n (* Non localized parameters *) let get_non_localized_parameters params files ~getorpost ~sp - {name; get; post; param = paramtype} + {name; get; post; param = paramtype; _} = (* non localized parameters are parsed only once, and cached in request_cache *) diff --git a/src/lib/eliom_parameter_base.shared.ml b/src/lib/eliom_parameter_base.shared.ml index 5511a6e154..5f7dece178 100644 --- a/src/lib/eliom_parameter_base.shared.ml +++ b/src/lib/eliom_parameter_base.shared.ml @@ -178,7 +178,7 @@ let make_list_suffix i = "[" ^ string_of_int i ^ "]" let rec make_suffix : type a c. (a, 'b, c) params_type -> a -> string list = fun typ params -> match typ with - | TNLParams {param} -> make_suffix param params + | TNLParams {param; _} -> make_suffix param params | TProd (t1, t2) -> make_suffix t1 (fst params) @ make_suffix t2 (snd params) | TAtom (_, a) -> [string_of_atom a params] | TCoord _ -> @@ -223,7 +223,7 @@ let rec aux fun typ psuff nlp params pref suff l -> let open Eliommod_parameters in match typ with - | TNLParams {name; param = t} -> + | TNLParams {name; param = t; _} -> let psuff, nlp, nl = aux t psuff nlp params pref suff [] in psuff, String.Table.add name nl nlp, l | TProd (t1, t2) -> @@ -367,7 +367,7 @@ let make_params_names params = = fun issuffix prefix suffix x -> match x with - | TNLParams {param = t} -> aux issuffix prefix suffix t + | TNLParams {param = t; _} -> aux issuffix prefix suffix t | TProd (t1, t2) -> let issuffix, a = aux issuffix prefix suffix t1 in let issuffix, b = aux issuffix prefix suffix t2 in @@ -459,7 +459,7 @@ let nl_prod (t : ('a, 'su, 'an) params_type) let rec remove_from_nlp : type a c. 's -> (a, 'b, c) params_type -> 's = fun nlp x -> match x with - | TNLParams {name = n} -> String.Table.remove n nlp + | TNLParams {name = n; _} -> String.Table.remove n nlp | TProd (t1, t2) -> let nlp = remove_from_nlp nlp t1 in remove_from_nlp nlp t2 @@ -678,7 +678,7 @@ let reconstruct_params_ typ params files nosuffixversion urlsuffix : 'a = = fun typ params files pref suff -> match typ with - | TNLParams {param = t} -> aux t params files pref suff + | TNLParams {param = t; _} -> aux t params files pref suff | TProd (t1, t2) -> ( match aux t1 params files pref suff with | Res_ (v1, l1, f) -> ( diff --git a/src/lib/eliom_react.server.ml b/src/lib/eliom_react.server.ml index a91f10a6a9..4215d5c1c1 100644 --- a/src/lib/eliom_react.server.ml +++ b/src/lib/eliom_react.server.ml @@ -32,7 +32,9 @@ module Down = struct type 'a stateless = 'a Eliom_comet.Channel.t type 'a t' = Stateful of 'a stateful | Stateless of 'a stateless + type 'a t = {t : 'a t'; react_down_mark : 'a t Eliom_common.wrapper} + [@@warning "-69"] let wrap_stateful {throttling = t; scope; react = e; name; size} = let ee = @@ -50,8 +52,8 @@ module Down = struct channel, Eliom_common.make_unwrapper Eliom_common.react_down_unwrap_id let internal_wrap = function - | {t = Stateful v} -> wrap_stateful v - | {t = Stateless v} -> wrap_stateless v + | {t = Stateful v; _} -> wrap_stateful v + | {t = Stateless v; _} -> wrap_stateless v let react_down_mark () = Eliom_common.make_wrapper internal_wrap @@ -95,6 +97,7 @@ module Up = struct , Eliom_registration.Action.return ) Eliom_service.t ; wrapper : 'a t Eliom_common.wrapper } + [@@warning "-69"] let to_react t = t.event @@ -131,15 +134,19 @@ module S = struct ; scope : Eliom_common.client_process_scope option ; signal : 'a S.t ; name : string option } + [@@warning "-69"] type 'a stateless = { channel : 'a Eliom_comet.Channel.t ; stream : 'a Lwt_stream.t ; (* avoid garbage collection *) sl_signal : 'a S.t } + [@@warning "-69"] type 'a t' = Stateful of 'a stateful | Stateless of 'a stateless + type 'a t = {t : 'a t'; signal_down_mark : 'a t Eliom_common.wrapper} + [@@warning "-69"] type 'a store = { s : unit S.t Lazy.t @@ -179,7 +186,7 @@ module S = struct in fun () -> Lwt.with_value Eliom_common.sp_key None @@ aux - let wrap_stateful {throttling = t; signal = s; name} = + let wrap_stateful {throttling = t; signal = s; name; _} = let s : 'a S.t = match t with | None -> s @@ -193,15 +200,15 @@ module S = struct , value , Eliom_common.make_unwrapper Eliom_common.signal_down_unwrap_id ) - let wrap_stateless {sl_signal = s; channel} = + let wrap_stateless {sl_signal = s; channel; _} = let value : 'a = S.value s in ( channel , value , Eliom_common.make_unwrapper Eliom_common.signal_down_unwrap_id ) let internal_wrap = function - | {t = Stateful v} -> wrap_stateful v - | {t = Stateless v} -> wrap_stateless v + | {t = Stateful v; _} -> wrap_stateful v + | {t = Stateless v; _} -> wrap_stateless v let signal_down_mark () = Eliom_common.make_wrapper internal_wrap diff --git a/src/lib/eliom_registration.client.mli b/src/lib/eliom_registration.client.mli index cde7787e22..9521bc3ec4 100644 --- a/src/lib/eliom_registration.client.mli +++ b/src/lib/eliom_registration.client.mli @@ -53,7 +53,7 @@ module Unit : type appl_service_options = {do_not_launch : bool} (** Has no effect on client; for compatibility with server *) -module App (P : Eliom_registration_sigs.APP_PARAM) : sig +module App (_ : Eliom_registration_sigs.APP_PARAM) : sig val application_name : string type app_id diff --git a/src/lib/eliom_registration.server.ml b/src/lib/eliom_registration.server.ml index b53e492b75..7148e8d734 100644 --- a/src/lib/eliom_registration.server.ml +++ b/src/lib/eliom_registration.server.ml @@ -233,8 +233,8 @@ module Action_base = struct (* send bypassing the following directives in the configuration file (they have already been taken into account) *) Polytables.set - (Ocsigen_request.request_cache ri) - Eliom_common.found_stop_key (); + ~table:(Ocsigen_request.request_cache ri) + ~key:Eliom_common.found_stop_key ~value:(); res let update_request ri si cookies_override = @@ -269,7 +269,7 @@ module Action_base = struct Be very careful while re-reading this. *) let sp = Eliom_common.get_sp () in - let sitedata = Eliom_request_info.get_sitedata_sp sp in + let sitedata = Eliom_request_info.get_sitedata_sp ~sp in let si = Eliom_request_info.get_si sp in let ri = Eliom_request_info.get_request_sp sp in let open Ocsigen_extensions in @@ -310,19 +310,22 @@ module Action_base = struct , si.Eliom_common.si_tab_cookies ); (* Remove some parameters to choose the following service *) Polytables.set - (Ocsigen_request.request_cache ri.Ocsigen_extensions.request_info) - Eliom_common.eliom_params_after_action - ( si.Eliom_common.si_all_get_params - , si.Eliom_common.si_all_post_params - , (* is Some [] *) - si.Eliom_common.si_all_file_params - , (* is Some [] *) - si.Eliom_common.si_nl_get_params - , si.Eliom_common.si_nl_post_params - , si.Eliom_common.si_nl_file_params - , si.Eliom_common.si_all_get_but_nl - , si.Eliom_common.si_ignored_get_params - , si.Eliom_common.si_ignored_post_params ); + ~table: + (Ocsigen_request.request_cache + ri.Ocsigen_extensions.request_info) + ~key:Eliom_common.eliom_params_after_action + ~value: + ( si.Eliom_common.si_all_get_params + , si.Eliom_common.si_all_post_params + , (* is Some [] *) + si.Eliom_common.si_all_file_params + , (* is Some [] *) + si.Eliom_common.si_nl_get_params + , si.Eliom_common.si_nl_post_params + , si.Eliom_common.si_nl_file_params + , si.Eliom_common.si_all_get_but_nl + , si.Eliom_common.si_ignored_get_params + , si.Eliom_common.si_ignored_post_params ); (*VVV Also put all_cookie_info in this, to avoid update_cookie_table and get_cookie_info (?) *) let ri = update_request ri.request_info si ric in @@ -421,7 +424,7 @@ module File_base = struct let sp = Eliom_common.get_sp () in let request = Eliom_request_info.get_request_sp sp in match - try Ocsigen_local_files.resolve request filename () + try Ocsigen_local_files.resolve ~request ~filename () with | Ocsigen_local_files.Failed_403 (* XXXBY : maybe we should signal a true 403 ? *) @@ -452,7 +455,7 @@ module File = struct let sp = Eliom_common.get_sp () in let request = Eliom_request_info.get_request_sp sp in try - ignore (Ocsigen_local_files.resolve request filename ()); + ignore (Ocsigen_local_files.resolve ~request ~filename ()); true with | Ocsigen_local_files.Failed_403 | Ocsigen_local_files.Failed_404 diff --git a/src/lib/eliom_registration.server.mli b/src/lib/eliom_registration.server.mli index 90b42191fb..795e8e5f94 100644 --- a/src/lib/eliom_registration.server.mli +++ b/src/lib/eliom_registration.server.mli @@ -157,7 +157,7 @@ val transform_global_app_uri (** Functor for application creation. See {% <> %} in the Eliom manual for details. *) -module App (App_params : Eliom_registration_sigs.APP_PARAM) : APP +module App (_ : Eliom_registration_sigs.APP_PARAM) : APP module type TMPL_PARAMS = sig type t diff --git a/src/lib/eliom_request.client.ml b/src/lib/eliom_request.client.ml index 6e9ce0356c..f2816e95c0 100644 --- a/src/lib/eliom_request.client.ml +++ b/src/lib/eliom_request.client.ml @@ -56,9 +56,9 @@ let get_cookie_info_for_uri_js uri_js = (Eliom_request_info.get_csp_original_full_path () @ path) in Eliom_request_info.get_csp_ssl (), path) - | Some (Url.Https {Url.hu_path = path}) -> true, path - | Some (Url.Http {Url.hu_path = path}) -> false, path - | Some (Url.File {Url.fu_path = path}) -> false, path + | Some (Url.Https {Url.hu_path = path; _}) -> true, path + | Some (Url.Http {Url.hu_path = path; _}) -> false, path + | Some (Url.File {Url.fu_path = path; _}) -> false, path let get_cookie_info_for_uri uri = let uri_js = Js.bytestring uri in diff --git a/src/lib/eliom_request_info.client.ml b/src/lib/eliom_request_info.client.ml index e0dd787e6a..8d1f7655d1 100644 --- a/src/lib/eliom_request_info.client.ml +++ b/src/lib/eliom_request_info.client.ml @@ -83,7 +83,7 @@ let update_session_info ~path ~all_get_params ~all_post_params cont = let all_get_but_na_nl = lazy (Eliom_common.remove_na_prefix_params all_get_but_nl) and na_get_params = lazy (Eliom_common.filter_na_get_params all_get_but_nl) in - let {si} = get_ri () in + let {si; _} = get_ri () in let si = { si with Eliom_common.si_other_get_params = [] diff --git a/src/lib/eliom_route.client.ml b/src/lib/eliom_route.client.ml index dd9a8c2439..3acbad4e74 100644 --- a/src/lib/eliom_route.client.ml +++ b/src/lib/eliom_route.client.ml @@ -15,9 +15,9 @@ module A = struct type result = Eliom_service.result let site_data _ = () - let sess_info_of_info {i_sess_info} = i_sess_info - let subpath_of_info {i_subpath} = i_subpath - let meth_of_info {i_meth} = i_meth + let sess_info_of_info {i_sess_info; _} = i_sess_info + let subpath_of_info {i_subpath; _} = i_subpath + let meth_of_info {i_meth; _} = i_meth let make_params _ _ suffix _ = suffix let get_number_of_reloads = @@ -47,14 +47,14 @@ module A = struct module Table = struct type t = table - let add {Eliom_common.key_meth} p m = Raw_table.add key_meth (`Ptc p) m + let add {Eliom_common.key_meth; _} p m = Raw_table.add key_meth (`Ptc p) m - let find {Eliom_common.key_meth} m = + let find {Eliom_common.key_meth; _} m = let (`Ptc v) = Raw_table.find key_meth m in v let empty () = Raw_table.empty - let remove {Eliom_common.key_meth} = Raw_table.remove key_meth + let remove {Eliom_common.key_meth; _} = Raw_table.remove key_meth end (* FIXME: dummy *) @@ -74,7 +74,7 @@ module A = struct (Eliom_common.na_key_serv, bool -> params -> result Lwt.t) Hashtbl.t } - let get {t_services} = t_services + let get {t_services; _} = t_services let set_contains_timeout a b = a.t_contains_timeout <- b let set tables l = tables.t_services <- l let dlist_add ?sp:_ _tables _srv = () @@ -91,10 +91,10 @@ let global_tables = ; t_contains_timeout = false ; t_na_services = Hashtbl.create 256 } -let add_naservice k f {A.Container.t_na_services} = +let add_naservice k f {A.Container.t_na_services; _} = Hashtbl.add t_na_services k f -let call_naservice k {A.Container.t_na_services} = +let call_naservice k {A.Container.t_na_services; _} = try (Hashtbl.find t_na_services k) true None with Not_found -> Lwt.fail Eliom_common.Eliom_404 @@ -112,7 +112,7 @@ let rec remove_site_dir p p' = | [], t -> Some t | _ -> None -let call_service ({i_get_params; i_post_params; i_subpath} as info) = +let call_service ({i_get_params; i_post_params; i_subpath; _} as info) = let info = match remove_site_dir (Eliom_request_info.get_site_dir ()) i_subpath with | Some i_subpath -> {info with i_subpath} diff --git a/src/lib/eliom_route.server.ml b/src/lib/eliom_route.server.ml index d0ffdc0bf5..2cfdd9ab43 100644 --- a/src/lib/eliom_route.server.ml +++ b/src/lib/eliom_route.server.ml @@ -7,9 +7,9 @@ include Eliom_route_base.Make (struct type site_data = Eliom_common.sitedata type info = Eliom_common.info - let sess_info_of_info {Eliom_common.session_info} = session_info + let sess_info_of_info {Eliom_common.session_info; _} = session_info - let meth_of_info {Eliom_common.request} = + let meth_of_info {Eliom_common.request; _} = match Ocsigen_request.meth request.request_info with | `GET -> `Get | `POST -> `Post @@ -17,14 +17,14 @@ include Eliom_route_base.Make (struct | `DELETE -> `Delete | _ -> `Other - let subpath_of_info {Eliom_common.request} = + let subpath_of_info {Eliom_common.request; _} = Ocsigen_request.sub_path request.request_info module Container = struct type t = Eliom_common.tables let set t v = t.Eliom_common.table_services <- v - let get {Eliom_common.table_services} = table_services + let get {Eliom_common.table_services; _} = table_services let dlist_add ?sp tables lr = tables.Eliom_common.service_dlist_add ?sp lr let set_contains_timeout tables b = @@ -60,7 +60,7 @@ include Eliom_route_base.Make (struct let make_params = Eliom_common.make_server_params - let handle_directory {Eliom_common.request = r} = + let handle_directory {Eliom_common.request = r; _} = Lwt.fail @@ Ocsigen_extensions.Ocsigen_is_dir (Ocsigen_extensions.new_url_of_directory_request r) @@ -84,7 +84,7 @@ let find_aux now sitedata info _ sci : Ocsigen_response.t Lwt.t = sci (fail Eliom_common.Eliom_404) -let session_tables {Eliom_common.all_cookie_info; tab_cookie_info} = +let session_tables {Eliom_common.all_cookie_info; tab_cookie_info; _} = let (service_cookies_info, _, _), (secure_service_cookies_info, _, _) = all_cookie_info and (service_cookies_info_tab, _, _), (secure_service_cookies_info_tab, _, _) = @@ -99,7 +99,7 @@ let drop_most_params ri si = Ocsigen_request.update ri ~post_data:None ~meth:`GET ~get_params_flat:si.Eliom_common.si_other_get_params -let get_page now ({Eliom_common.request = ri; session_info = si} as info) +let get_page now ({Eliom_common.request = ri; session_info = si; _} as info) sitedata : Ocsigen_response.t Lwt.t = @@ -141,8 +141,8 @@ let get_page now ({Eliom_common.request = ri; session_info = si} as info) Lwt_log.ign_info ~section "Link too old. Try without POST parameters:"; Polytables.set - (Ocsigen_request.request_cache ri.request_info) - Eliom_common.eliom_link_too_old true; + ~table:(Ocsigen_request.request_cache ri.request_info) + ~key:Eliom_common.eliom_link_too_old ~value:true; let request = { ri with request_info = @@ -165,8 +165,8 @@ let get_page now ({Eliom_common.request = ri; session_info = si} as info) Lwt_log.ign_info ~section "Link to old. Trying without GET state parameters and POST parameters:"; Polytables.set - (Ocsigen_request.request_cache ri.request_info) - Eliom_common.eliom_link_too_old true; + ~table:(Ocsigen_request.request_cache ri.request_info) + ~key:Eliom_common.eliom_link_too_old ~value:true; let request = { ri with request_info = drop_most_params ri.request_info si } @@ -272,8 +272,8 @@ let remove_naservice tables name = in remove_naservice_ tables name nodeopt -let make_naservice now ({Eliom_common.request = ri; session_info = si} as info) - sitedata +let make_naservice now + ({Eliom_common.request = ri; session_info = si; _} as info) sitedata = let find_aux sci = match @@ -329,12 +329,13 @@ let make_naservice now ({Eliom_common.request = ri; session_info = si} as info) Lwt_log.ign_info ~section "Link too old to a non-attached POST coservice. Try without POST parameters:"; Polytables.set - (Ocsigen_request.request_cache ri.request_info) - Eliom_common.eliom_link_too_old true; - Eliom_common.get_session_info sitedata - { ri with - Ocsigen_extensions.request_info = - drop_most_params ri.request_info si } + ~table:(Ocsigen_request.request_cache ri.request_info) + ~key:Eliom_common.eliom_link_too_old ~value:true; + Eliom_common.get_session_info ~sitedata + ~req: + { ri with + Ocsigen_extensions.request_info = + drop_most_params ri.request_info si } si.Eliom_common.si_previous_extension_error >>= fun (ri', si', _previous_tab_cookies_info) -> Lwt.fail @@ -344,12 +345,13 @@ let make_naservice now ({Eliom_common.request = ri; session_info = si} as info) Lwt_log.ign_info ~section "Link too old. Try without non-attached parameters:"; Polytables.set - (Ocsigen_request.request_cache ri.request_info) - Eliom_common.eliom_link_too_old true; - Eliom_common.get_session_info sitedata - { ri with - Ocsigen_extensions.request_info = - drop_most_params ri.request_info si } + ~table:(Ocsigen_request.request_cache ri.request_info) + ~key:Eliom_common.eliom_link_too_old ~value:true; + Eliom_common.get_session_info ~sitedata + ~req: + { ri with + Ocsigen_extensions.request_info = + drop_most_params ri.request_info si } si.Eliom_common.si_previous_extension_error >>= fun (ri', si', _previous_tab_cookies_info) -> Lwt.fail diff --git a/src/lib/eliom_route_base.shared.ml b/src/lib/eliom_route_base.shared.ml index 6c8b017abd..92b35eb1ee 100644 --- a/src/lib/eliom_route_base.shared.ml +++ b/src/lib/eliom_route_base.shared.ml @@ -106,7 +106,7 @@ module Make (P : PARAM) = struct | [] -> Lwt.return (Eliom_common.Notfound Eliom_common.Eliom_Wrong_parameter, []) - | ({Eliom_common.s_max_use; s_expire; s_f} as a) :: l -> ( + | ({Eliom_common.s_max_use; s_expire; s_f; _} as a) :: l -> ( match s_expire with | Some (_, e) when !e < now -> (* Service expired. Removing it. *) @@ -180,11 +180,11 @@ module Make (P : PARAM) = struct | Eliom_common.Notfound e -> fail e let remove_id services id = - List.filter (fun {Eliom_common.s_id} -> s_id <> id) services + List.filter (fun {Eliom_common.s_id; _} -> s_id <> id) services let find_and_remove_id services id = let found, l = - let f (found, l) ({Eliom_common.s_id} as x) = + let f (found, l) ({Eliom_common.s_id; _} as x) = if id = s_id then Some x, l else found, x :: l in List.fold_left f (None, []) services @@ -192,7 +192,7 @@ module Make (P : PARAM) = struct match found with Some found -> found, List.rev l | None -> raise Not_found let add_page_table tables url_act tref key - ({Eliom_common.s_id; s_expire} as service) + ({Eliom_common.s_id; s_expire; _} as service) = let sp = Eliom_common.get_sp_option () in (match s_expire with @@ -217,7 +217,8 @@ module Make (P : PARAM) = struct with Not_found -> let node = P.Container.dlist_add ?sp tables (Left (tref, key)) in tref := P.Table.add key (Some node, [service]) !tref) - | {Eliom_common.key_state = Eliom_common.SAtt_no, Eliom_common.SAtt_no} -> ( + | {Eliom_common.key_state = Eliom_common.SAtt_no, Eliom_common.SAtt_no; _} + -> ( try let _nodeopt, l = P.Table.find key !tref and newt = P.Table.remove key !tref in diff --git a/src/lib/eliom_runtime.shared.ml b/src/lib/eliom_runtime.shared.ml index cf3c8a6713..b71c25682a 100644 --- a/src/lib/eliom_runtime.shared.ml +++ b/src/lib/eliom_runtime.shared.ml @@ -26,10 +26,11 @@ module Client_value_server_repr = struct { mutable loc : Eliom_lib_base.pos option ; instance_id : int ; unwrapper : Eliom_wrap.unwrapper } + [@@warning "-69"] type 'a t = u - let create ?loc ~instance_id ~unwrapper = {instance_id; loc; unwrapper} + let create ~loc ~instance_id ~unwrapper = {instance_id; loc; unwrapper} let instance_id cv = cv.instance_id let loc cv = cv.loc let clear_loc cv = cv.loc <- None @@ -43,8 +44,12 @@ module RawXML = struct let separator_to_string = function Space -> " " | Comma -> ", " + [@@@warning "-39"] + type cookie_info = bool * string list [@@deriving json] + [@@@warning "+39"] + type caml_event_handler = | CE_registered_closure of string * Ocsigen_lib_base.poly (* 'a Js.t -> unit) client_value *) | CE_client_closure of (Dom_html.event Js.t -> unit) (* Client side-only *) diff --git a/src/lib/eliom_runtime.shared.mli b/src/lib/eliom_runtime.shared.mli index a3403cedbc..0ac610d758 100644 --- a/src/lib/eliom_runtime.shared.mli +++ b/src/lib/eliom_runtime.shared.mli @@ -29,7 +29,7 @@ module Client_value_server_repr : sig type +'a t val create - : ?loc:Eliom_lib_base.pos + : loc:Eliom_lib_base.pos option -> instance_id:int -> unwrapper:Eliom_wrap.unwrapper -> _ t diff --git a/src/lib/eliom_service.client.ml b/src/lib/eliom_service.client.ml index a5f9812f17..c9d605fef4 100644 --- a/src/lib/eliom_service.client.ml +++ b/src/lib/eliom_service.client.ml @@ -52,7 +52,7 @@ let reload_fun match Eliom_parameter.is_unit (post_params_type service) with | Eliom_parameter.U_yes -> ( match service with - | {client_fun = Some {contents = Some f}; reload_fun = Rf_client_fun} -> + | {client_fun = Some {contents = Some f}; reload_fun = Rf_client_fun; _} -> Some f | _ -> None) | _ -> None diff --git a/src/lib/eliom_service.server.ml b/src/lib/eliom_service.server.ml index 5ad990fa4e..31f6b297a1 100644 --- a/src/lib/eliom_service.server.ml +++ b/src/lib/eliom_service.server.ml @@ -203,7 +203,7 @@ let attach -> ('get, 'post, 'gp, att, co, non_ext, non_reg, 'sf, 'gn, 'pn, 'return) t = fun ~fallback ~service () -> - let {na_name} = non_attached_info service in + let {na_name; _} = non_attached_info service in let fallbackkind = attached_info fallback in let open Eliom_common in let error_msg = diff --git a/src/lib/eliom_service_base.eliom b/src/lib/eliom_service_base.eliom index be50dabab7..62503b04e9 100644 --- a/src/lib/eliom_service_base.eliom +++ b/src/lib/eliom_service_base.eliom @@ -185,7 +185,7 @@ type%shared unit_service = t let service_mark () = Eliom_common.make_wrapper pre_wrap -let info {info} = info +let info {info; _} = info let pre_applied_parameters s = s.pre_applied_parameters let get_params_type s = s.get_params_type let post_params_type s = s.post_params_type @@ -207,9 +207,9 @@ let internal_set_client_fun ~service = service.client_fun <- Some [%client.unsafe ref (Some ~%f)] -let is_external = function {kind = `External} -> true | _ -> false +let is_external = function {kind = `External; _} -> true | _ -> false let default_priority = 0 -let meth {meth} = meth +let meth {meth; _} = meth let change_get_num service attser n = { service with @@ -448,8 +448,8 @@ let default_csrf_scope = function exception Unreachable_exn -let attached_info = function {info = Attached k} -> k -let non_attached_info = function {info = Nonattached k} -> k +let attached_info = function {info = Attached k; _} -> k +let non_attached_info = function {info = Nonattached k; _} -> k let%server no_client_fun () : _ ref Eliom_client_value.t option = (* It only makes sense to create a client value when in a global @@ -502,7 +502,7 @@ let extern ?keep_nl_params ~prefix ~path ~meth () = ~site_dir:[] ~kind:`External ~meth ?keep_nl_params ~redirect_suffix:false ~get_params ~post_params ~reload_fun:Rf_keep () -let which_meth {meth} = meth +let which_meth {meth; _} = meth let which_meth_untyped (type m) (s : (_, _, m, _, _, _, _, _, _, _, _) t) = match which_meth s with diff --git a/src/lib/eliom_shared.eliom b/src/lib/eliom_shared.eliom index c0c5af3404..16c49b2dd3 100644 --- a/src/lib/eliom_shared.eliom +++ b/src/lib/eliom_shared.eliom @@ -44,8 +44,9 @@ module Value = struct { sh_server : 'a ; sh_client : 'a Eliom_client_value.t ; sh_mark : 'a t Eliom_wrap.wrapper } + [@@warning "-69"] - let internal_wrap {sh_client} = sh_client + let internal_wrap {sh_client; _} = sh_client let shared_value_mark () : 'a t Eliom_wrap.wrapper = Eliom_wrap.create_wrapper internal_wrap @@ -53,8 +54,8 @@ module Value = struct let create sh_server sh_client = {sh_server; sh_client; sh_mark = shared_value_mark ()} - let client {sh_client} = sh_client - let local {sh_server} = sh_server + let client {sh_client; _} = sh_client + let local {sh_server; _} = sh_server end] [%%client diff --git a/src/lib/eliom_state.server.ml b/src/lib/eliom_state.server.ml index 1b1c2fcba2..c47bfba0f9 100644 --- a/src/lib/eliom_state.server.ml +++ b/src/lib/eliom_state.server.ml @@ -144,7 +144,7 @@ let set_global_persistent_data_state_timeout ~cookie_scope ?secure let get_global_service_state_timeout ?secure ~cookie_scope () = let sitedata = Eliom_request_info.find_sitedata "get_global_timeout" in - let secure = Eliom_common.get_secure secure sitedata () in + let secure = Eliom_common.get_secure ~secure_o:secure ~sitedata () in Eliommod_timeouts.get_global ~kind:`Service ~cookie_scope ~secure sitedata let get_global_volatile_data_state_timeout ?secure ~cookie_scope () = @@ -1261,7 +1261,7 @@ module Ext = struct let () = match get_service_cookie_info ~sitedata state with | exception Not_found -> () - | _, {Eliom_common.Service_cookie.session_group_node} -> + | _, {Eliom_common.Service_cookie.session_group_node; _} -> Eliommod_sessiongroups.Serv.remove session_group_node in Lwt.return_unit @@ -1269,14 +1269,14 @@ module Ext = struct let () = match get_volatile_data_cookie_info ~sitedata state with | exception Not_found -> () - | _, {Eliom_common.Data_cookie.session_group_node} -> + | _, {Eliom_common.Data_cookie.session_group_node; _} -> Eliommod_sessiongroups.Data.remove session_group_node in Lwt.return_unit | _, `Pers, _cookie -> ( match%lwt get_persistent_cookie_info state with | exception Not_found -> Lwt.return_unit - | cookie, {Eliommod_cookies.full_state_name; session_group} -> + | cookie, {Eliommod_cookies.full_state_name; session_group; _} -> let scope = full_state_name.Eliom_common.user_scope in let cookie_level = Eliom_common.cookie_level_of_user_scope scope in Eliommod_sessiongroups.Pers.close_persistent_session2 ~cookie_level @@ -1340,7 +1340,8 @@ module Ext = struct match state with | _, `Pers, _ -> Eliommod_sessiongroups.Pers.find - (Eliom_common.make_persistent_full_group_name sub_states_level + (Eliom_common.make_persistent_full_group_name + ~cookie_level:sub_states_level sitedata.Eliom_common.site_dir_string (Some id)) >>= fun l -> Lwt_list.fold_left_s f e l | _ -> fold_sub_states_aux Ocsigen_cache.Dlist.lwt_fold Lwt.return a e state @@ -1451,7 +1452,7 @@ module Ext = struct Eliommod_cookies.Persistent_cookies.Cookies.add c {cookie with Eliommod_cookies.timeout = TGlobal} >>= fun () -> - let {Eliommod_cookies.expiry} = cookie in + let {Eliommod_cookies.expiry; _} = cookie in Eliommod_cookies.Persistent_cookies.Expiry_dates.remove_cookie expiry c let get_session_group_list () = @@ -1541,12 +1542,12 @@ let set_cookie ?(cookie_level = `Session) ?path ?exp ?secure ~name ~value () = match cookie_level with | `Session -> sp.Eliom_common.sp_user_cookies <- - Ocsigen_cookie_map.add path name + Ocsigen_cookie_map.add ~path name (OSet (exp, value, secure)) sp.Eliom_common.sp_user_cookies | `Client_process -> sp.Eliom_common.sp_user_tab_cookies <- - Ocsigen_cookie_map.add path name + Ocsigen_cookie_map.add ~path name (OSet (exp, value, secure)) sp.Eliom_common.sp_user_tab_cookies @@ -1556,8 +1557,8 @@ let unset_cookie ?(cookie_level = `Session) ?path ~name () = match cookie_level with | `Session -> sp.Eliom_common.sp_user_cookies <- - Ocsigen_cookie_map.add path name OUnset sp.Eliom_common.sp_user_cookies + Ocsigen_cookie_map.add ~path name OUnset sp.Eliom_common.sp_user_cookies | `Client_process -> sp.Eliom_common.sp_user_tab_cookies <- - Ocsigen_cookie_map.add path name OUnset + Ocsigen_cookie_map.add ~path name OUnset sp.Eliom_common.sp_user_tab_cookies diff --git a/src/lib/eliom_syntax.server.ml b/src/lib/eliom_syntax.server.ml index e5f5d060fb..87bb999f9e 100644 --- a/src/lib/eliom_syntax.server.ml +++ b/src/lib/eliom_syntax.server.ml @@ -136,7 +136,7 @@ let last_id = ref 0 let client_value ?pos closure_id args = let instance_id = if !is_global then (incr last_id; !last_id) else 0 in - let value = Eliom_client_value.create_client_value ?loc:pos ~instance_id in + let value = Eliom_client_value.create_client_value ~loc:pos ~instance_id in register_client_value_data ~closure_id ~args:(Eliom_lib.to_poly args) ~value; Eliom_client_value.client_value_from_server_repr value diff --git a/src/lib/eliom_tools.eliom b/src/lib/eliom_tools.eliom index c59cfd47c7..ca4e0d2e4e 100644 --- a/src/lib/eliom_tools.eliom +++ b/src/lib/eliom_tools.eliom @@ -277,14 +277,14 @@ module Make (DorF : module type of Eliom_content.Html.F) : HTML5_TOOLS = struct | [] -> [] | [(url, text)] -> let classe = [last_class] in - let _ = li [a url text ()] in + let _ = li [a ~service:url text ()] in if same_service_opt url current then [li ~a:[a_class (current_class :: classe)] text] - else [li ~a:[a_class classe] [a url text ()]] + else [li ~a:[a_class classe] [a ~service:url text ()]] | (url, text) :: l -> (if same_service_opt url current then li ~a:[a_class [current_class]] text - else li [a url text ()]) + else li [a ~service:url text ()]) :: aux l in match l with @@ -295,14 +295,14 @@ module Make (DorF : module type of Eliom_content.Html.F) : HTML5_TOOLS = struct [ (let liclasse = [first_class; last_class] in if same_service_opt url current then li ~a:[a_class (current_class :: liclasse)] text - else li ~a:[a_class liclasse] [a url text ()]) ] + else li ~a:[a_class liclasse] [a ~service:url text ()]) ] | (url, text) :: l -> DorF.ul ~a:(a_ul (menu_class :: classe) id 0) (let liclasse = [first_class] in (if same_service_opt url current then li ~a:[a_class (current_class :: liclasse)] text - else li ~a:[a_class liclasse] [a url text ()]) + else li ~a:[a_class liclasse] [a ~service:url text ()]) :: aux l) let service_prefix s sopt = @@ -369,14 +369,14 @@ module Make (DorF : module type of Eliom_content.Html.F) : HTML5_TOOLS = struct let attclass = if classe = [] then [] else [a_class classe] in match s with | text, Site_tree (Default_page (Srv page), []) -> - li ~a:attclass [a page text ()] + li ~a:attclass [a ~service:page text ()] | text, Site_tree (Main_page (Srv page), []) -> - li ~a:attclass [a page text ()] + li ~a:attclass [a ~service:page text ()] | text, Site_tree (Not_clickable, []) -> li ~a:attclass text | text, Disabled -> li ~a:[a_class (disabled_class :: classe)] text | text, Site_tree (Default_page (Srv page), hsl) -> li ~a:attclass - (a page text () + (a ~service:page text () :: (if deplier || whole_tree then @@ -386,7 +386,7 @@ module Make (DorF : module type of Eliom_content.Html.F) : HTML5_TOOLS = struct else [])) | text, Site_tree (Main_page (Srv page), hsl) -> li ~a:attclass - (a page text () + (a ~service:page text () :: (if deplier || whole_tree then (depth_first_fun hsl (level + 1) pos2 :> li_content elt list) @@ -429,9 +429,9 @@ module Make (DorF : module type of Eliom_content.Html.F) : HTML5_TOOLS = struct let attclass = if classe = [] then [] else [a_class classe] in match s with | text, Site_tree (Default_page (Srv page), _) -> - li ~a:attclass [a page text ()] + li ~a:attclass [a ~service:page text ()] | text, Site_tree (Main_page (Srv page), _) -> - li ~a:attclass [a page text ()] + li ~a:attclass [a ~service:page text ()] | text, Site_tree (Not_clickable, _) -> li ~a:attclass text | text, Disabled -> li ~a:[a_class (disabled_class :: classe)] text and one_menu first i = function @@ -496,11 +496,11 @@ module Make (DorF : module type of Eliom_content.Html.F) : HTML5_TOOLS = struct let head ~title:ttl ?(css = []) ?(js = []) ?(other = []) () = let open DorF in let mk_css_link path = - let uri = make_uri (Eliom_service.static_dir ()) path in + let uri = make_uri ~service:(Eliom_service.static_dir ()) path in css_link ~uri () in let mk_js_script path = - let uri = make_uri (Eliom_service.static_dir ()) path in + let uri = make_uri ~service:(Eliom_service.static_dir ()) path in js_script ~a:[a_defer ()] ~uri () in DorF.head diff --git a/src/lib/eliom_unwrap.client.ml b/src/lib/eliom_unwrap.client.ml index f05de73ff1..7d0945df69 100644 --- a/src/lib/eliom_unwrap.client.ml +++ b/src/lib/eliom_unwrap.client.ml @@ -45,7 +45,7 @@ type unwrap_id = int let id_of_int x = x -type unwrapper = {id : unwrap_id; mutable umark : Mark.t} +type unwrapper = {id : unwrap_id; mutable umark : Mark.t} [@@warning "-69"] let unwrap_table : (Obj.t -> Obj.t option) Js.js_array Js.t = new%js Js.array_empty diff --git a/src/lib/eliom_uri.shared.ml b/src/lib/eliom_uri.shared.ml index f13463d7f2..a982213883 100644 --- a/src/lib/eliom_uri.shared.ml +++ b/src/lib/eliom_uri.shared.ml @@ -96,7 +96,7 @@ let make_proto_prefix ?hostname ?port https : string = then Eliom_config.get_default_sslport () else Eliom_config.get_default_port () in - Eliom_lib.Url.make_absolute_url https host port "/" + Eliom_lib.Url.make_absolute_url ~https ~host ~port "/" let is_https https ssl service = https = Some true @@ -316,7 +316,7 @@ let make_uri_components ?absolute ?absolute_path ?https (type a) let make_string_uri_from_components (uri, params, fragment) = let s = - Eliom_lib.String.may_concat uri "?" + Eliom_lib.String.may_concat uri ~sep:"?" (Eliom_parameter.construct_params_string params) in match fragment with None -> s | Some f -> Eliom_lib.String.concat "#" [s; f] diff --git a/src/lib/eliom_wrap.server.ml b/src/lib/eliom_wrap.server.ml index dbf61c5846..41fd18489a 100644 --- a/src/lib/eliom_wrap.server.ml +++ b/src/lib/eliom_wrap.server.ml @@ -51,6 +51,7 @@ end = struct end type marked_value = {mark : Mark.t; f : (Obj.t -> Obj.t) option} +[@@warning "-69"] let make_mark f mark = {mark; f} @@ -127,7 +128,7 @@ module Tbl = struct mutable gc : int ; (* Last minor GC cycle where the table was accurate *) - mutable on_resize : (int -> unit) list } + on_resize : (int -> unit) list } (* Functions called on resize *) let cst = @@ -390,6 +391,7 @@ type unwrapper = { (* WARNING Must be the same as Eliom_unwrap.unwrapper *) id : unwrap_id ; umark : Mark.t } +[@@warning "-69"] let create_unwrapper id = {id; umark = Mark.unwrap_mark} let empty_unwrapper = {id = -1; umark = Mark.do_nothing_mark} diff --git a/src/lib/server/dune b/src/lib/server/dune index 15c0ade426..f0a7441f1d 100644 --- a/src/lib/server/dune +++ b/src/lib/server/dune @@ -31,7 +31,3 @@ (action (with-stdout-to %{target} (system "printf '('; ocamlfind query -i-format js_of_ocaml; printf ')'")))) - -(env - (_ - (flags (:standard -w -9 -warn-error -6-9-16-27-39-67-69)))) diff --git a/src/lib/server/eliommod_cli.ml b/src/lib/server/eliommod_cli.ml index ac14a3b2a3..c8df826113 100644 --- a/src/lib/server/eliommod_cli.ml +++ b/src/lib/server/eliommod_cli.ml @@ -25,7 +25,7 @@ let fresh_id = "id" ^ string_of_int !c let client_sitedata sp = - let s = Eliom_request_info.get_sitedata_sp sp in + let s = Eliom_request_info.get_sitedata_sp ~sp in { Eliom_types.site_dir = s.Eliom_common.site_dir ; Eliom_types.site_dir_string = s.Eliom_common.site_dir_string } diff --git a/src/lib/server/eliommod_cookies.ml b/src/lib/server/eliommod_cookies.ml index 80b0acdbbd..e43d25560f 100644 --- a/src/lib/server/eliommod_cookies.ml +++ b/src/lib/server/eliommod_cookies.ml @@ -99,11 +99,11 @@ module Persistent_cookies = struct if cookies' = [] then None else Some (String.concat "," cookies') end - let add cookie ({expiry} as content) = + let add cookie ({expiry; _} as content) = Eliom_lib.Option.Lwt.iter (fun t -> Expiry_dates.add_cookie t cookie) expiry >>= fun _ -> Cookies.add cookie content - let replace_if_exists cookie ({expiry} as content) = + let replace_if_exists cookie ({expiry; _} as content) = Eliom_lib.Option.Lwt.iter (fun t -> Expiry_dates.add_cookie t cookie) expiry >>= fun _ -> Cookies.replace_if_exists cookie content @@ -138,7 +138,8 @@ let get_cookie_info now sitedata service_cookies data_cookies persistent_cookies ; expiry ; timeout ; session_group - ; session_group_node } + ; session_group_node + ; _ } = Eliom_common.SessionCookies.find sitedata.Eliom_common.session_services @@ -199,7 +200,8 @@ let get_cookie_info now sitedata service_cookies data_cookies persistent_cookies let { Eliom_common.Data_cookie.expiry ; timeout ; session_group - ; session_group_node } + ; session_group_node + ; _ } = Eliom_common.SessionCookies.find sitedata.Eliom_common.session_data @@ -257,7 +259,8 @@ let get_cookie_info now sitedata service_cookies data_cookies persistent_cookies (Eliom_common.Hashed_cookies.to_string hvalue) >>= fun { expiry = persexp ; timeout = perstimeout - ; session_group = sessgrp } -> + ; session_group = sessgrp + ; _ } -> Eliommod_sessiongroups.Pers.up hvalue_string sessgrp >>= fun () -> match persexp with @@ -436,7 +439,7 @@ let compute_session_cookies_to_send sitedata (match old, newc with | None, None -> beg | Some _, None -> - Ocsigen_cookie_map.add sitedata.Eliom_common.site_dir + Ocsigen_cookie_map.add ~path:sitedata.Eliom_common.site_dir (Eliom_common.make_full_cookie_name cookiekind full_st_name) OUnset beg (* the path is always site_dir because the cookie cannot @@ -444,7 +447,7 @@ let compute_session_cookies_to_send sitedata this site directory *) | _, Some (_, Some v, exp) -> (* New value *) - Ocsigen_cookie_map.add sitedata.Eliom_common.site_dir + Ocsigen_cookie_map.add ~path:sitedata.Eliom_common.site_dir (Eliom_common.make_full_cookie_name cookiekind full_st_name) (OSet (ch_exp exp, v, secure)) beg @@ -452,7 +455,7 @@ let compute_session_cookies_to_send sitedata if exp = Eliom_common.CENothing then beg else - Ocsigen_cookie_map.add sitedata.Eliom_common.site_dir + Ocsigen_cookie_map.add ~path:sitedata.Eliom_common.site_dir (Eliom_common.make_full_cookie_name cookiekind full_st_name) (OSet (ch_exp exp, oldv, secure)) @@ -517,7 +520,7 @@ let compute_new_ri_cookies (now : float) (ripath : string list) let f _secure (service_cookie_info, data_cookie_info, pers_cookie_info) ric = let ric = Eliom_common.Full_state_name_table.fold - (fun ({Eliom_common.user_scope = sc} as full_st_name) (_, v) beg -> + (fun ({Eliom_common.user_scope = sc; _} as full_st_name) (_, v) beg -> let ct = Eliom_common.cookie_level_of_user_scope sc in if ct = `Client_process then beg @@ -529,14 +532,14 @@ let compute_new_ri_cookies (now : float) (ripath : string list) match !v with | Eliom_common.SCData_session_expired | Eliom_common.SCNo_data -> Ocsigen_cookie_map.Map_inner.remove n beg - | Eliom_common.SC {Eliom_common.sc_set_value = Some v} -> + | Eliom_common.SC {Eliom_common.sc_set_value = Some v; _} -> Ocsigen_cookie_map.Map_inner.add n v beg - | Eliom_common.SC {Eliom_common.sc_set_value = None} -> beg) + | Eliom_common.SC {Eliom_common.sc_set_value = None; _} -> beg) !service_cookie_info ric in let ric = Eliom_common.Full_state_name_table.fold - (fun ({Eliom_common.user_scope = sc} as full_st_name) v beg -> + (fun ({Eliom_common.user_scope = sc; _} as full_st_name) v beg -> let ct = Eliom_common.cookie_level_of_user_scope sc in if ct = `Client_process then beg @@ -551,15 +554,15 @@ let compute_new_ri_cookies (now : float) (ripath : string list) match !v with | Eliom_common.SCData_session_expired | Eliom_common.SCNo_data -> Ocsigen_cookie_map.Map_inner.remove n beg - | Eliom_common.SC {Eliom_common.dc_set_value = Some v} -> + | Eliom_common.SC {Eliom_common.dc_set_value = Some v; _} -> Ocsigen_cookie_map.Map_inner.add n v beg - | Eliom_common.SC {Eliom_common.dc_set_value = None} -> beg + | Eliom_common.SC {Eliom_common.dc_set_value = None; _} -> beg else beg) !data_cookie_info ric in let ric = Eliom_common.Full_state_name_table.fold - (fun ({Eliom_common.user_scope = sc} as full_st_name) v beg -> + (fun ({Eliom_common.user_scope = sc; _} as full_st_name) v beg -> let ct = Eliom_common.cookie_level_of_user_scope sc in if ct = `Client_process then beg @@ -575,9 +578,9 @@ let compute_new_ri_cookies (now : float) (ripath : string list) match !v with | Eliom_common.SCData_session_expired | Eliom_common.SCNo_data -> Lwt.return (Ocsigen_cookie_map.Map_inner.remove n beg) - | Eliom_common.SC {Eliom_common.pc_set_value = Some v} -> + | Eliom_common.SC {Eliom_common.pc_set_value = Some v; _} -> Lwt.return (Ocsigen_cookie_map.Map_inner.add n v beg) - | Eliom_common.SC {Eliom_common.pc_set_value = None} -> + | Eliom_common.SC {Eliom_common.pc_set_value = None; _} -> Lwt.return beg else return beg) !pers_cookie_info (Lwt.return ric) diff --git a/src/lib/server/eliommod_datasess.ml b/src/lib/server/eliommod_datasess.ml index 264bff204a..e0ed12e72c 100644 --- a/src/lib/server/eliommod_datasess.ml +++ b/src/lib/server/eliommod_datasess.ml @@ -44,7 +44,7 @@ let close_data_state ~scope ~secure_o ?sp () = let (_, cookie_info, _), secure_ci = Eliom_common.get_cookie_info sp cookie_level in - let sitedata = Eliom_request_info.get_sitedata_sp sp in + let sitedata = Eliom_request_info.get_sitedata_sp ~sp in let cookie_info, secure = compute_cookie_info sitedata secure_o secure_ci cookie_info in @@ -141,7 +141,7 @@ let rec find_or_create_data_cookie ?set_session_group let (_, cookie_info, _), secure_ci = Eliom_common.get_cookie_info sp cookie_level in - let sitedata = Eliom_request_info.get_sitedata_sp sp in + let sitedata = Eliom_request_info.get_sitedata_sp ~sp in let cookie_info, secure = compute_cookie_info sitedata secure_o secure_ci cookie_info in @@ -209,7 +209,7 @@ let find_data_cookie_only ~cookie_scope ~secure_o ?sp () = let (_, cookie_info, _), secure_ci = Eliom_common.get_cookie_info sp cookie_level in - let sitedata = Eliom_request_info.get_sitedata_sp sp in + let sitedata = Eliom_request_info.get_sitedata_sp ~sp in let cookie_info, secure = compute_cookie_info sitedata secure_o secure_ci cookie_info in diff --git a/src/lib/server/eliommod_gc.ml b/src/lib/server/eliommod_gc.ml index ce7f1bdcf0..633d9269e5 100644 --- a/src/lib/server/eliommod_gc.ml +++ b/src/lib/server/eliommod_gc.ml @@ -63,7 +63,7 @@ let gc_timeouted_services now tables = let%lwt _ = thr in (* we wait for the previous one to be completed *) (match nodeopt, l with - | Some node, {Eliom_common.s_expire = Some (_, e)} :: _ + | Some node, {Eliom_common.s_expire = Some (_, e); _} :: _ (* it is an anonymous coservice. The list should have length 1 here *) when !e < now -> @@ -84,7 +84,7 @@ let gc_timeouted_services now tables = then match List.fold_right - (fun ({Eliom_common.s_expire} as a) foll -> + (fun ({Eliom_common.s_expire; _} as a) foll -> match s_expire with | Some (_, e) when !e < now -> foll | _ -> a :: foll) @@ -186,7 +186,8 @@ let service_session_gc sitedata = { Eliom_common.Service_cookie.session_table = tables ; expiry ; session_group - ; session_group_node } thr -> + ; session_group_node + ; _ } thr -> thr >>= fun () -> (match !expiry with | Some exp when exp < now -> @@ -247,7 +248,8 @@ let data_session_gc sitedata = (fun k { Eliom_common.Data_cookie.expiry ; session_group - ; session_group_node } thr -> + ; session_group_node + ; _ } thr -> thr >>= fun () -> (match !expiry with | Some exp when exp < now -> @@ -292,7 +294,7 @@ let persistent_session_gc sitedata = let now = Unix.time () in let log_hash c = Eliom_common.Hashed_cookies.(sha256 c) in let do_gc_cookie cookie - {Eliommod_cookies.full_state_name; expiry; session_group} + {Eliommod_cookies.full_state_name; expiry; session_group; _} = let scope = full_state_name.Eliom_common.user_scope in match expiry with diff --git a/src/lib/server/eliommod_pagegen.ml b/src/lib/server/eliommod_pagegen.ml index b74230996b..b50e7bdffd 100644 --- a/src/lib/server/eliommod_pagegen.ml +++ b/src/lib/server/eliommod_pagegen.ml @@ -193,7 +193,7 @@ let update_cookie_table ?now sitedata (ci, sci) = + update the cookie tables (value, expiration date and timeout) *) let execute now generate_page - ({Eliom_common.all_cookie_info; tab_cookie_info} as info) sitedata + ({Eliom_common.all_cookie_info; tab_cookie_info; _} as info) sitedata = let%lwt result = Lwt.catch @@ -210,8 +210,8 @@ let set_expired_sessions ri closedservsessions = then () else Polytables.set - (Ocsigen_request.request_cache ri.Ocsigen_extensions.request_info) - Eliom_common.eliom_service_session_expired closedservsessions + ~table:(Ocsigen_request.request_cache ri.Ocsigen_extensions.request_info) + ~key:Eliom_common.eliom_service_session_expired ~value:closedservsessions open Ocsigen_extensions @@ -235,7 +235,7 @@ let gen_req_not_found ~is_eliom_extension ~sitedata ~previous_extension_err ~req let req = Eliom_common.patch_request_info req in let now = Unix.gettimeofday () in let%lwt ri, si, previous_tab_cookies_info = - Eliom_common.get_session_info sitedata req 404 + Eliom_common.get_session_info ~sitedata ~req 404 in let all_cookie_info, closedsessions = Eliommod_cookies.get_cookie_info now sitedata @@ -261,7 +261,8 @@ let gen_req_not_found ~is_eliom_extension ~sitedata ~previous_extension_err ~req in set_expired_sessions ri (closedsessions, closedsessions_tab); let rec gen_aux - ({Eliom_common.request = ri; session_info = si; all_cookie_info} as info) + ({Eliom_common.request = ri; session_info = si; all_cookie_info; _} as + info) = let sp = Eliom_common.make_server_params sitedata info None None in (* The last two arguments are not yet available, so for now we use None. diff --git a/src/lib/server/eliommod_persess.ml b/src/lib/server/eliommod_persess.ml index 9ceee11c18..346871e002 100644 --- a/src/lib/server/eliommod_persess.ml +++ b/src/lib/server/eliommod_persess.ml @@ -60,7 +60,7 @@ let close_persistent_state ~scope ~secure_o ?sp () = let (_, _, cookie_info), secure_ci = Eliom_common.get_cookie_info sp cookie_level in - let sitedata = Eliom_request_info.get_sitedata_sp sp in + let sitedata = Eliom_request_info.get_sitedata_sp ~sp in let cookie_info, secure = compute_cookie_info sitedata secure_o secure_ci cookie_info in @@ -144,7 +144,7 @@ let rec find_or_create_persistent_cookie_ ?set_max_in_group ?set_session_group let (_, _, cookie_info), secure_ci = Eliom_common.get_cookie_info sp cookie_level in - let sitedata = Eliom_request_info.get_sitedata_sp sp in + let sitedata = Eliom_request_info.get_sitedata_sp ~sp in let cookie_info, secure = compute_cookie_info sitedata secure_o secure_ci cookie_info in @@ -205,7 +205,7 @@ let find_persistent_cookie_only ~cookie_scope ~secure_o ?sp () = let (_, _, cookie_info), secure_ci = Eliom_common.get_cookie_info sp cookie_level in - let sitedata = Eliom_request_info.get_sitedata_sp sp in + let sitedata = Eliom_request_info.get_sitedata_sp ~sp in let cookie_info, secure = compute_cookie_info sitedata secure_o secure_ci cookie_info in diff --git a/src/lib/server/eliommod_sersess.ml b/src/lib/server/eliommod_sersess.ml index 71c41baf48..6ab067861c 100644 --- a/src/lib/server/eliommod_sersess.ml +++ b/src/lib/server/eliommod_sersess.ml @@ -43,7 +43,7 @@ let close_service_state ~scope ~secure_o ?sp () = let (cookie_info, _, _), secure_ci = Eliom_common.get_cookie_info sp cookie_level in - let sitedata = Eliom_request_info.get_sitedata_sp sp in + let sitedata = Eliom_request_info.get_sitedata_sp ~sp in let cookie_info, secure = compute_cookie_info sitedata secure_o secure_ci cookie_info in @@ -76,7 +76,7 @@ let close_service_state ~scope ~secure_o ?sp () = with Not_found -> () let fullsessgrp ~cookie_level ~sp set_session_group = - let sitedata = Eliom_request_info.get_sitedata_sp sp in + let sitedata = Eliom_request_info.get_sitedata_sp ~sp in Eliommod_sessiongroups.make_full_group_name ~cookie_level (Eliom_request_info.get_request_sp sp).Ocsigen_extensions.request_info sitedata.Eliom_common.site_dir_string @@ -141,7 +141,7 @@ let rec find_or_create_service_cookie_ ?set_session_group let (cookie_info, _, _), secure_ci = Eliom_common.get_cookie_info sp cookie_level in - let sitedata = Eliom_request_info.get_sitedata_sp sp in + let sitedata = Eliom_request_info.get_sitedata_sp ~sp in let cookie_info, secure = compute_cookie_info sitedata secure_o secure_ci cookie_info in @@ -216,7 +216,7 @@ let find_service_cookie_only ~cookie_scope ~secure_o ?sp () = Eliom_common.get_cookie_info sp (Eliom_common.cookie_level_of_user_scope cookie_scope) in - let sitedata = Eliom_request_info.get_sitedata_sp sp in + let sitedata = Eliom_request_info.get_sitedata_sp ~sp in let cookie_info, secure = compute_cookie_info sitedata secure_o secure_ci cookie_info in diff --git a/src/lib/server/eliommod_sessadmin.ml b/src/lib/server/eliommod_sessadmin.ml index c9fa3e4905..5c8044fccb 100644 --- a/src/lib/server/eliommod_sessadmin.ml +++ b/src/lib/server/eliommod_sessadmin.ml @@ -44,7 +44,8 @@ let close_all_service_states2 full_st_name sitedata = (fun _ { Eliom_common.Service_cookie.full_state_name ; timeout - ; session_group_node } thr -> + ; session_group_node + ; _ } thr -> let%lwt () = thr in if full_st_name = full_state_name && !timeout = Eliom_common.TGlobal then Eliommod_sessiongroups.Serv.remove session_group_node; @@ -70,8 +71,10 @@ let close_all_service_states ~scope ~secure sitedata = let close_all_data_states2 full_st_name sitedata = Eliom_common.SessionCookies.fold (fun _ - {Eliom_common.Data_cookie.full_state_name; timeout; session_group_node} - thr -> + { Eliom_common.Data_cookie.full_state_name + ; timeout + ; session_group_node + ; _ } thr -> thr >>= fun () -> if full_st_name = full_state_name && !timeout = Eliom_common.TGlobal then Eliommod_sessiongroups.Data.remove session_group_node; @@ -96,7 +99,8 @@ let close_all_data_states ~scope ~secure sitedata = let close_all_persistent_states2 full_st_name sitedata = Eliommod_cookies.Persistent_cookies.Cookies.iter - (fun k {Eliommod_cookies.full_state_name; timeout = old_t; session_group} -> + (fun k {Eliommod_cookies.full_state_name; timeout = old_t; session_group; _} + -> let scope = full_state_name.Eliom_common.user_scope in if full_st_name = full_state_name && old_t = Eliom_common.TGlobal then @@ -135,7 +139,8 @@ let update_serv_exp full_st_name sitedata old_glob_timeout new_glob_timeout = { Eliom_common.Service_cookie.full_state_name ; expiry ; timeout - ; session_group_node } thr -> + ; session_group_node + ; _ } thr -> let%lwt () = thr in (if full_st_name = full_state_name && !timeout = Eliom_common.TGlobal then @@ -166,7 +171,8 @@ let update_data_exp full_st_name sitedata old_glob_timeout new_glob_timeout = { Eliom_common.Data_cookie.full_state_name ; expiry ; timeout - ; session_group_node } thr -> + ; session_group_node + ; _ } thr -> thr >>= fun () -> (if full_st_name = full_state_name && !timeout = Eliom_common.TGlobal then diff --git a/src/lib/server/eliommod_sessiongroups.ml b/src/lib/server/eliommod_sessiongroups.ml index b015547d5e..400c9a3385 100644 --- a/src/lib/server/eliommod_sessiongroups.ml +++ b/src/lib/server/eliommod_sessiongroups.ml @@ -302,7 +302,7 @@ Besides, volatile sessions are (hopefully) going to disappear soon. match (sess_grp : GroupTable.key) with | _, `Client_process, Left sess_id -> ( try - let {Eliom_common.Data_cookie.session_group; session_group_node} = + let {Eliom_common.Data_cookie.session_group; session_group_node; _} = Eliom_common.SessionCookies.find sitedata.Eliom_common.session_data sess_id in @@ -373,7 +373,8 @@ Besides, volatile sessions are (hopefully) going to disappear soon. | _, `Client_process, Left sess_id -> ( try let { Eliom_common.Service_cookie.session_table = tables - ; session_group_node } + ; session_group_node + ; _ } = Eliom_common.SessionCookies.find sitedata.Eliom_common.session_services sess_id diff --git a/src/lib/server/eliommod_timeouts.ml b/src/lib/server/eliommod_timeouts.ml index b8eb2614f9..acb6a02616 100644 --- a/src/lib/server/eliommod_timeouts.ml +++ b/src/lib/server/eliommod_timeouts.ml @@ -93,7 +93,7 @@ let set_timeout_ get set get_default update ?full_st_name ?cookie_level | _, _, Some `Client_process -> set sitedata (def_bro, Some (t, fromconfigfile), tl) | _, _, None -> failwith "set_timeout_") - | Some ({Eliom_common.user_scope} as full_st_name) -> + | Some ({Eliom_common.user_scope; _} as full_st_name) -> (* recompute_expdates works only if full_st_name is present *) let oldtopt = try diff --git a/src/ocamlbuild/dune b/src/ocamlbuild/dune index feea7380ca..5d657a8570 100644 --- a/src/ocamlbuild/dune +++ b/src/ocamlbuild/dune @@ -4,7 +4,3 @@ (synopsis "Eliom ocamlbuild plugin (js_of_ocaml part included)") (wrapped false) (libraries js_of_ocaml-ocamlbuild)) - -(env - (_ - (flags (:standard -warn-error -67)))) diff --git a/src/ocamlbuild/ocamlbuild_eliom.mli b/src/ocamlbuild/ocamlbuild_eliom.mli index 0e62e23c30..17f7442061 100644 --- a/src/ocamlbuild/ocamlbuild_eliom.mli +++ b/src/ocamlbuild/ocamlbuild_eliom.mli @@ -5,7 +5,7 @@ module type ELIOM = sig val client_dir : Ocamlbuild_plugin.Pathname.t end -module Make (Eliom : ELIOM) : sig +module Make (_ : ELIOM) : sig val dispatcher : ?oasis_executables:Ocamlbuild_plugin.Pathname.t list -> Ocamlbuild_plugin.hook @@ -47,7 +47,7 @@ module type INTERNALS = sig val with_package : string -> string end -module MakeIntern (I : INTERNALS) (Eliom : ELIOM) : sig +module MakeIntern (_ : INTERNALS) (_ : ELIOM) : sig val dispatcher : ?oasis_executables:Ocamlbuild_plugin.Pathname.t list -> Ocamlbuild_plugin.hook diff --git a/src/ppx/dune b/src/ppx/dune index 3643566acf..df6e1be5f2 100644 --- a/src/ppx/dune +++ b/src/ppx/dune @@ -56,7 +56,3 @@ (libraries ppx_type) (preprocess (pps ppxlib.metaquot)) (modules ppx_eliom_types_ex)) - -(env - (_ - (flags (:standard -w -9 -warn-error -3-6)))) diff --git a/src/ppx/ppx_eliom_client.ml b/src/ppx/ppx_eliom_client.ml index 34a329145c..487a1aa93c 100644 --- a/src/ppx/ppx_eliom_client.ml +++ b/src/ppx/ppx_eliom_client.ml @@ -18,8 +18,8 @@ module Pass = struct method! expression e = match e.pexp_desc with - | Pexp_ident {txt} when Mli.is_escaped_ident @@ Longident.last_exn txt - -> + | Pexp_ident {txt; _} + when Mli.is_escaped_ident @@ Longident.last_exn txt -> let loc = e.pexp_loc in [%expr Eliom_client_core.Syntax_helpers.get_escaped_value [%e e]] | _ -> super#expression e @@ -166,7 +166,7 @@ module Pass = struct let op = may_open_client_section loc in op @ register_client_closures client_expr_data - @ define_client_functions loc client_expr_data + @ define_client_functions ~loc client_expr_data @ [item] @ may_close_server_section ~no_fragment:(no_fragment || op <> []) item @@ -178,7 +178,7 @@ module Pass = struct | None when not (Mli.exists () || Cmo.exists ()) -> () | None -> ( match find_fragment loc id with - | {ptyp_desc = Ptyp_var _} when not unsafe -> + | {ptyp_desc = Ptyp_var _; _} when not unsafe -> Location.raise_errorf ~loc "The types of client values must be monomorphic from its usage or from its type annotation" | _ -> ())); @@ -208,7 +208,7 @@ module Pass = struct method! core_type typ = match typ with - | {ptyp_desc = Ptyp_var _; ptyp_loc = loc} -> + | {ptyp_desc = Ptyp_var _; ptyp_loc = loc; _} -> let attr = attribute_of_warning loc "The type of this injected value contains a type variable that could be wrongly inferred." diff --git a/src/ppx/ppx_eliom_utils.ml b/src/ppx/ppx_eliom_utils.ml index 55fdca4939..f25625012d 100644 --- a/src/ppx/ppx_eliom_utils.ml +++ b/src/ppx/ppx_eliom_utils.ml @@ -27,7 +27,7 @@ let punit ?loc ?attrs () = let flatmap f l = List.flatten @@ List.map f l let get_extension = function - | {pexp_desc = Pexp_extension ({txt}, _)} -> txt + | {pexp_desc = Pexp_extension ({txt; _}, _); _} -> txt | _ -> invalid_arg "Eliom ppx: Should be an extension." let in_context cref c f x = @@ -84,7 +84,7 @@ let module_hash_declaration loc = *) let file_position str = match str with - | {pstr_loc} :: _ -> Location.in_file @@ pstr_loc.loc_start.pos_fname + | {pstr_loc; _} :: _ -> Location.in_file @@ pstr_loc.loc_start.pos_fname | [] -> Location.none let lexing_position ~loc l = @@ -223,8 +223,8 @@ module Mli = struct let get_binding sig_item = match sig_item.psig_desc with - | Psig_value {pval_name = {txt}; pval_type = [%type: [%t? typ] option ref]} - -> + | Psig_value + {pval_name = {txt; _}; pval_type = [%type: [%t? typ] option ref]; _} -> if is_injected_ident txt || is_escaped_ident txt then Some (txt, suppress_underscore typ) else if is_fragment_ident txt @@ -277,9 +277,11 @@ module Cmo = struct (fun ev -> match ev with | { ev_loc = - { loc_start = {Lexing.pos_fname; pos_cnum} - ; loc_end = {Lexing.pos_cnum = pos_cnum'} } - ; ev_kind = Event_after ty } -> + { loc_start = {Lexing.pos_fname; pos_cnum; _} + ; loc_end = {Lexing.pos_cnum = pos_cnum'; _} + ; _ } + ; ev_kind = Event_after ty + ; _ } -> if pos_cnum' = pos_cnum + 1 then Hashtbl.add events (pos_fname, pos_cnum) ty | _ -> ()) @@ -385,7 +387,7 @@ module Cmo = struct Typ.class_ (mkloc (ident_of_out_ident id) Location.none) (List.map type_of_out_type tyl) - | ((Otyp_alias {aliased; alias}) [@if ocaml_version >= (5, 1, 0)]) -> + | ((Otyp_alias {aliased; alias; _}) [@if ocaml_version >= (5, 1, 0)]) -> Typ.alias (type_of_out_type aliased) (var alias) | ((Otyp_alias (ty, s)) [@if ocaml_version < (5, 1, 0)]) -> Typ.alias (type_of_out_type ty) (var s) @@ -446,7 +448,7 @@ module Cmo = struct type_of_out_type ty let find err loc = - let {Lexing.pos_fname; pos_cnum} = loc.Location.loc_start in + let {Lexing.pos_fname; pos_cnum; _} = loc.Location.loc_start in try typ (Hashtbl.find (Lazy.force events) (pos_fname, pos_cnum)) with Not_found -> Typ.extension ~loc @@ Location.Error.to_extension @@ -693,7 +695,7 @@ module Make (Pass : Pass) = struct let loc = expr.pexp_loc in let attr = expr.pexp_attributes in match expr, !context with - | {pexp_desc = Pexp_extension ({txt}, _)}, `Client + | {pexp_desc = Pexp_extension ({txt; _}, _); _}, `Client when is_annotation txt ["client"; "shared"; "client.unsafe"; "shared.unsafe"] -> let side = get_extension expr in @@ -702,7 +704,7 @@ module Make (Pass : Pass) = struct (Printf.sprintf "The syntax [%%%s ...] is not allowed inside client code." side) - | ( {pexp_desc = Pexp_extension ({txt}, _)} + | ( {pexp_desc = Pexp_extension ({txt; _}, _); _} , (`Fragment _ | `Escaped_value _ | `Injection _) ) when is_annotation txt ["client"; "shared"; "client.unsafe"; "shared.unsafe"] -> @@ -713,7 +715,8 @@ module Make (Pass : Pass) = struct (* [%shared ... ] *) | ( { pexp_desc = Pexp_extension - ({txt}, PStr [{pstr_desc = Pstr_eval (side_val, attr')}]) } + ({txt; _}, PStr [{pstr_desc = Pstr_eval (side_val, attr'); _}]) + ; _ } , (`Server | `Shared) ) when is_annotation txt ["shared"; "shared.unsafe"] -> let unsafe = is_annotation txt ["shared.unsafe"] in @@ -722,7 +725,8 @@ module Make (Pass : Pass) = struct (* [%client ... ] *) | ( { pexp_desc = Pexp_extension - ({txt}, PStr [{pstr_desc = Pstr_eval (side_val, attr)}]) } + ({txt; _}, PStr [{pstr_desc = Pstr_eval (side_val, attr); _}]) + ; _ } , ((`Server | `Shared) as c) ) when is_annotation txt ["client"; "client.unsafe"] -> Name.reset_escaped_ident (); @@ -783,14 +787,14 @@ module Make (Pass : Pass) = struct method! structure_item str = let loc = str.pstr_loc in match str.pstr_desc with - | Pstr_extension (({txt = "server" | "shared" | "client"}, _), _) -> + | Pstr_extension (({txt = "server" | "shared" | "client"; _}, _), _) -> Location.raise_errorf ~loc "Sections are only allowed at toplevel." | _ -> super#structure_item str method! signature_item sig_ = let loc = sig_.psig_loc in match sig_.psig_desc with - | Psig_extension (({txt = "server" | "shared" | "client"}, _), _) -> + | Psig_extension (({txt = "server" | "shared" | "client"; _}, _), _) -> Location.raise_errorf ~loc "Sections are only allowed at toplevel." | _ -> super#signature_item sig_ end @@ -832,7 +836,7 @@ module Make (Pass : Pass) = struct | _ -> () in match pstr.pstr_desc with - | Pstr_extension (({txt}, PStr strs), _) + | Pstr_extension (({txt; _}, PStr strs), _) when is_annotation txt ["shared.start"; "client.start"; "server.start"] -> if strs <> [] @@ -845,15 +849,16 @@ module Make (Pass : Pass) = struct maybe_reset_injected_idents !context; context := Context.of_string txt; []) - | Pstr_extension (({txt}, PStr strs), _) + | Pstr_extension (({txt; _}, PStr strs), _) when is_annotation txt ["shared"; "client"; "server"] -> let c = Context.of_string txt in let l = flatmap (dispatch_str c) strs in maybe_reset_injected_idents c; l | Pstr_include - { pincl_mod = {pmod_desc = Pmod_structure l; pmod_attributes = []} - ; pincl_attributes = [] } -> + { pincl_mod = {pmod_desc = Pmod_structure l; pmod_attributes = []; _} + ; pincl_attributes = [] + ; _ } -> flatmap f l | _ -> dispatch_str !context pstr in @@ -865,7 +870,7 @@ module Make (Pass : Pass) = struct let f psig = let loc = psig.psig_loc in match psig.psig_desc with - | Psig_extension (({txt}, PStr strs), _) + | Psig_extension (({txt; _}, PStr strs), _) when is_annotation txt ["shared.start"; "client.start"; "server.start"] -> if strs <> [] @@ -877,7 +882,7 @@ module Make (Pass : Pass) = struct else ( context := Context.of_string txt; []) - | Psig_extension (({txt}, PSig sigs), _) + | Psig_extension (({txt; _}, PSig sigs), _) when is_annotation txt ["shared"; "client"; "server"] -> let c = Context.of_string txt in flatmap (dispatch_sig c) sigs diff --git a/src/tools/distillery.ml b/src/tools/distillery.ml index 0120aeb797..db5a880a15 100644 --- a/src/tools/distillery.ml +++ b/src/tools/distillery.ml @@ -90,7 +90,7 @@ let copy_file_plain input_name output_name = let buffer_size = 8192 in let fd_in = Unix.openfile input_name [O_RDONLY] 0 and fd_out = - let {Unix.st_perm} = Unix.stat input_name in + let {Unix.st_perm; _} = Unix.stat input_name in Unix.openfile output_name [O_WRONLY; O_CREAT; O_TRUNC] st_perm and buffer = Bytes.create buffer_size in let rec copy_loop () = diff --git a/src/tools/dune b/src/tools/dune index 010927abdb..ea55f9cad9 100644 --- a/src/tools/dune +++ b/src/tools/dune @@ -9,6 +9,3 @@ (section bin) (files (eliomc.exe as eliomopt) (eliomc.exe as eliomcp) (eliomc.exe as js_of_eliom))) -(env - (_ - (flags (:standard -w -9 -warn-error -27-32)))) diff --git a/src/tools/eliomc.ml b/src/tools/eliomc.ml index 5002ce58a6..616b03a32e 100644 --- a/src/tools/eliomc.ml +++ b/src/tools/eliomc.ml @@ -57,7 +57,6 @@ type mode = let mode : mode ref = ref `Link let do_compile () = !mode <> `Infer -let do_interface () = !mode = `Interface let do_dump = ref false let create_process ?in_ ?out ?err ?on_error name args = diff --git a/src/tools/eliomdoc.ml b/src/tools/eliomdoc.ml index 8032437202..e4fac0c5bd 100644 --- a/src/tools/eliomdoc.ml +++ b/src/tools/eliomdoc.ml @@ -46,11 +46,6 @@ let get_default_args () = let eliom_inc_dirs = ref [] let eliom_inc_inodes = ref [] -let in_an_eliom_inc_dir s = - List.exists - (fun d_inode -> inode_of_dir (Filename.dirname s) = d_inode) - !eliom_inc_inodes - let compile_intf file = wait (create_process !compiler