From a69639ed756ab717f7236b2512605d4b6100008c Mon Sep 17 00:00:00 2001 From: John Christopher McAlpine Date: Thu, 4 Apr 2019 10:11:43 +0200 Subject: [PATCH 01/10] dunify eliom move *.client.ml* and *.server.ml* lib files into their respective directories move *.shared.ml* files into shared directory and add symlinks refactor the ppx to support standalone and factor .eliom files back out actually compile things fix building multiple tools delete ppx use external ppx tools fix a dependency issue and update some possibly-obsolete package names create eliomopt alias --- build/build.ml | 6 +- dune-project | 1 + opam => eliom.opam | 9 +- pkg/META | 6 +- src/lib/client/common/dune | 16 + .../common/eliom_client_value.ml} | 0 .../common/eliom_client_value.mli} | 0 src/lib/client/common/eliom_common_base.ml | 1 + .../common/eliom_config.ml} | 0 .../common/eliom_config.mli} | 0 .../common/eliom_content_core.ml} | 2 +- .../common/eliom_content_core.mli} | 0 .../common/eliom_lazy.ml} | 0 .../common/eliom_lazy.mli} | 0 .../common/eliom_lib.ml} | 12 +- .../common/eliom_lib.mli} | 0 src/lib/client/common/eliom_runtime.ml | 1 + src/lib/client/common/eliom_runtime.mli | 1 + .../common/eliom_unwrap.ml} | 2 +- .../common/eliom_unwrap.mli} | 0 src/lib/client/dune | 106 ++ .../eliom_bus.ml} | 10 +- .../eliom_bus.mli} | 0 .../eliom_client.ml} | 23 +- .../eliom_client.mli} | 0 src/lib/client/eliom_client_base.ml | 1 + .../eliom_client_core.ml} | 16 +- .../eliom_comet.ml} | 26 +- .../eliom_comet.mli} | 0 src/lib/client/eliom_comet_base.ml | 1 + src/lib/client/eliom_comet_base.mli | 1 + .../eliom_common.ml} | 6 +- .../eliom_content.mli} | 0 .../eliom_content_.ml} | 18 +- src/lib/client/eliom_content_sigs.mli | 1 + src/lib/client/eliom_cookies_base.ml | 1 + src/lib/client/eliom_form_sigs.mli | 1 + .../eliom_parameter.ml} | 8 +- .../eliom_parameter.mli} | 0 src/lib/client/eliom_parameter_base.ml | 1 + src/lib/client/eliom_parameter_sigs.mli | 1 + .../eliom_process.ml} | 0 .../eliom_react.ml} | 12 +- .../eliom_react.mli} | 0 .../eliom_registration.ml} | 10 +- .../eliom_registration.mli} | 0 src/lib/client/eliom_registration_sigs.mli | 1 + .../eliom_request.ml} | 10 +- .../eliom_request.mli} | 0 .../eliom_request_info.ml} | 2 +- .../eliom_route.ml} | 30 +- src/lib/client/eliom_route_base.ml | 1 + .../eliom_service.ml} | 10 +- .../eliom_service.mli} | 0 src/lib/client/eliom_service_sigs.mli | 1 + .../eliom_shared.mli} | 0 src/lib/client/eliom_shared_sigs.mli | 1 + .../eliom_types.ml} | 0 src/lib/client/eliom_types_base.ml | 1 + src/lib/client/eliom_types_base.mli | 1 + src/lib/client/eliom_uri.ml | 1 + src/lib/client/eliom_uri.mli | 1 + src/lib/client/eliommod_dom.ml | 6 +- src/lib/common/dune | 5 + src/lib/common/eliom_lib_base.ml | 1 + src/lib/common/eliom_lib_base.mli | 1 + .../eliom_wrap.ml} | 29 +- .../eliom_wrap.mli} | 0 src/lib/{ => eliom}/eliom_client_main.eliom | 0 src/lib/{ => eliom}/eliom_content.eliom | 0 src/lib/{ => eliom}/eliom_cscache.eliom | 0 src/lib/{ => eliom}/eliom_cscache.eliomi | 0 src/lib/{ => eliom}/eliom_form.eliom | 10 +- src/lib/{ => eliom}/eliom_form.eliomi | 0 src/lib/{ => eliom}/eliom_service_base.eliom | 22 +- src/lib/{ => eliom}/eliom_shared.eliom | 38 +- .../{ => eliom}/eliom_shared_content.eliom | 2 +- .../{ => eliom}/eliom_shared_content.eliomi | 0 src/lib/{ => eliom}/eliom_tools.eliom | 0 src/lib/{ => eliom}/eliom_tools.eliomi | 0 src/lib/eliom_wrap.client.mli | 7 - src/lib/server/common/dune | 7 + .../common/eliom_client_value.ml} | 0 .../common/eliom_client_value.mli} | 0 .../common/eliom_common.ml} | 20 +- .../common/eliom_common.mli} | 0 src/lib/server/common/eliom_common_base.ml | 1 + .../common/eliom_lazy.ml} | 0 .../common/eliom_lazy.mli} | 0 .../common/eliom_lib.ml} | 0 .../common/eliom_lib.mli} | 0 .../common/eliom_request_info.ml} | 0 .../common/eliom_request_info.mli} | 0 src/lib/server/common/eliom_runtime.ml | 1 + src/lib/server/common/eliom_runtime.mli | 1 + src/lib/server/dune | 101 ++ .../eliom_bus.ml} | 2 +- .../eliom_bus.mli} | 0 .../eliom_client.ml} | 0 .../eliom_client.mli} | 0 src/lib/server/eliom_client_base.ml | 1 + .../eliom_comet.ml} | 26 +- .../eliom_comet.mli} | 0 src/lib/server/eliom_comet_base.ml | 1 + src/lib/server/eliom_comet_base.mli | 1 + .../eliom_config.ml} | 2 +- .../eliom_config.mli} | 0 .../eliom_content.mli} | 0 .../eliom_content_.ml} | 0 .../eliom_content_core.ml} | 12 +- .../eliom_content_core.mli} | 0 src/lib/server/eliom_content_sigs.mli | 1 + .../eliom_cookie.ml} | 0 .../eliom_cookie.mli} | 0 src/lib/server/eliom_cookies_base.ml | 1 + .../eliom_error_pages.ml} | 48 +- .../eliom_extension.ml} | 2 +- .../eliom_extension.mli} | 0 .../eliom_extension_template.ml} | 2 +- src/lib/server/eliom_form_sigs.mli | 1 + .../eliom_mkreg.ml} | 9 +- .../eliom_mkreg.mli} | 0 .../eliom_notif.ml} | 2 +- .../eliom_notif.mli} | 0 .../eliom_parameter.ml} | 11 +- .../eliom_parameter.mli} | 0 src/lib/server/eliom_parameter_base.ml | 1 + src/lib/server/eliom_parameter_sigs.mli | 1 + .../eliom_process.ml} | 0 .../eliom_react.ml} | 18 +- .../eliom_react.mli} | 0 .../eliom_reference.ml} | 4 +- .../eliom_reference.mli} | 0 .../eliom_registration.ml} | 53 +- .../eliom_registration.mli} | 0 src/lib/server/eliom_registration_sigs.mli | 1 + .../eliom_route.ml} | 36 +- .../eliom_route.mli} | 0 src/lib/server/eliom_route_base.ml | 1 + .../eliom_service.ml} | 16 +- .../eliom_service.mli} | 0 src/lib/server/eliom_service_sigs.mli | 1 + .../eliom_shared.mli} | 0 src/lib/server/eliom_shared_sigs.mli | 1 + .../eliom_state.ml} | 30 +- .../eliom_state.mli} | 0 .../eliom_syntax.ml} | 0 .../eliom_syntax.mli} | 0 .../eliom_types.ml} | 0 .../eliom_types.mli} | 0 src/lib/server/eliom_types_base.ml | 1 + src/lib/server/eliom_types_base.mli | 1 + src/lib/server/eliom_uri.ml | 1 + src/lib/server/eliom_uri.mli | 1 + src/lib/server/eliommod.ml | 22 +- src/lib/server/eliommod_cli.ml | 2 +- src/lib/server/eliommod_cookies.ml | 14 +- src/lib/server/eliommod_datasess.ml | 10 +- src/lib/server/eliommod_gc.ml | 12 +- src/lib/server/eliommod_pagegen.ml | 24 +- src/lib/server/eliommod_persess.ml | 8 +- src/lib/server/eliommod_sersess.ml | 14 +- src/lib/server/eliommod_sessadmin.ml | 14 +- src/lib/server/eliommod_sessiongroups.ml | 4 +- src/lib/server/eliommod_timeouts.ml | 2 +- .../eliom_client_base.ml} | 0 .../eliom_comet_base.ml} | 2 + .../eliom_comet_base.mli} | 0 .../eliom_common_base.ml} | 16 +- .../eliom_content_sigs.mli} | 0 .../eliom_cookies_base.ml} | 4 + .../eliom_form_sigs.mli} | 0 .../eliom_lib_base.ml} | 0 .../eliom_lib_base.mli} | 0 .../eliom_parameter_base.ml} | 54 +- .../eliom_parameter_sigs.mli} | 0 .../eliom_registration_sigs.mli} | 0 .../eliom_route_base.ml} | 21 +- .../eliom_runtime.ml} | 12 +- .../eliom_runtime.mli} | 0 .../eliom_service_sigs.mli} | 0 .../eliom_shared_sigs.mli} | 0 .../eliom_types_base.ml} | 0 .../eliom_types_base.mli} | 0 .../eliom_uri.ml} | 14 +- .../eliom_uri.mli} | 0 src/ocamlbuild/ocamlbuild_eliom.ml | 6 +- src/ppx/.merlin | 4 - src/ppx/_tags | 1 - src/ppx/ppx_eliom.ml | 1 - src/ppx/ppx_eliom.mli | 4 - src/ppx/ppx_eliom_client.ml | 261 ----- src/ppx/ppx_eliom_client.mli | 2 - src/ppx/ppx_eliom_client_ex.ml | 2 - src/ppx/ppx_eliom_server.ml | 218 ---- src/ppx/ppx_eliom_server.mli | 2 - src/ppx/ppx_eliom_server_ex.ml | 2 - src/ppx/ppx_eliom_type.ml | 142 --- src/ppx/ppx_eliom_type.mli | 2 - src/ppx/ppx_eliom_types_ex.ml | 2 - src/ppx/ppx_eliom_utils.ml | 683 ------------- src/ppx/ppx_eliom_utils.mli | 89 -- src/syntax/pa_eliom_client_client.ml | 319 ------ src/syntax/pa_eliom_client_server.ml | 264 ----- src/syntax/pa_eliom_seed.ml | 963 ------------------ src/syntax/pa_eliom_type_filter.ml | 157 --- src/tools/dune | 33 + src/tools/eliomc.ml | 2 +- src/tools/utils.ml | 6 +- 209 files changed, 758 insertions(+), 3557 deletions(-) create mode 100644 dune-project rename opam => eliom.opam (91%) create mode 100644 src/lib/client/common/dune rename src/lib/{eliom_client_value.client.ml => client/common/eliom_client_value.ml} (100%) rename src/lib/{eliom_client_value.client.mli => client/common/eliom_client_value.mli} (100%) create mode 120000 src/lib/client/common/eliom_common_base.ml rename src/lib/{eliom_config.client.ml => client/common/eliom_config.ml} (100%) rename src/lib/{eliom_config.client.mli => client/common/eliom_config.mli} (100%) rename src/lib/{eliom_content_core.client.ml => client/common/eliom_content_core.ml} (99%) rename src/lib/{eliom_content_core.client.mli => client/common/eliom_content_core.mli} (100%) rename src/lib/{eliom_lazy.client.ml => client/common/eliom_lazy.ml} (100%) rename src/lib/{eliom_lazy.client.mli => client/common/eliom_lazy.mli} (100%) rename src/lib/{eliom_lib.client.ml => client/common/eliom_lib.ml} (94%) rename src/lib/{eliom_lib.client.mli => client/common/eliom_lib.mli} (100%) create mode 120000 src/lib/client/common/eliom_runtime.ml create mode 120000 src/lib/client/common/eliom_runtime.mli rename src/lib/{eliom_unwrap.client.ml => client/common/eliom_unwrap.ml} (98%) rename src/lib/{eliom_unwrap.client.mli => client/common/eliom_unwrap.mli} (100%) create mode 100644 src/lib/client/dune rename src/lib/{eliom_bus.client.ml => client/eliom_bus.ml} (94%) rename src/lib/{eliom_bus.client.mli => client/eliom_bus.mli} (100%) rename src/lib/{eliom_client.client.ml => client/eliom_client.ml} (98%) rename src/lib/{eliom_client.client.mli => client/eliom_client.mli} (100%) create mode 120000 src/lib/client/eliom_client_base.ml rename src/lib/{eliom_client_core.client.ml => client/eliom_client_core.ml} (99%) rename src/lib/{eliom_comet.client.ml => client/eliom_comet.ml} (96%) rename src/lib/{eliom_comet.client.mli => client/eliom_comet.mli} (100%) create mode 120000 src/lib/client/eliom_comet_base.ml create mode 120000 src/lib/client/eliom_comet_base.mli rename src/lib/{eliom_common.client.ml => client/eliom_common.ml} (94%) rename src/lib/{eliom_content.client.mli => client/eliom_content.mli} (100%) rename src/lib/{eliom_content_.client.ml => client/eliom_content_.ml} (99%) create mode 120000 src/lib/client/eliom_content_sigs.mli create mode 120000 src/lib/client/eliom_cookies_base.ml create mode 120000 src/lib/client/eliom_form_sigs.mli rename src/lib/{eliom_parameter.client.ml => client/eliom_parameter.ml} (96%) rename src/lib/{eliom_parameter.client.mli => client/eliom_parameter.mli} (100%) create mode 120000 src/lib/client/eliom_parameter_base.ml create mode 120000 src/lib/client/eliom_parameter_sigs.mli rename src/lib/{eliom_process.client.ml => client/eliom_process.ml} (100%) rename src/lib/{eliom_react.client.ml => client/eliom_react.ml} (88%) rename src/lib/{eliom_react.client.mli => client/eliom_react.mli} (100%) rename src/lib/{eliom_registration.client.ml => client/eliom_registration.ml} (97%) rename src/lib/{eliom_registration.client.mli => client/eliom_registration.mli} (100%) create mode 120000 src/lib/client/eliom_registration_sigs.mli rename src/lib/{eliom_request.client.ml => client/eliom_request.ml} (98%) rename src/lib/{eliom_request.client.mli => client/eliom_request.mli} (100%) rename src/lib/{eliom_request_info.client.ml => client/eliom_request_info.ml} (99%) rename src/lib/{eliom_route.client.ml => client/eliom_route.ml} (80%) create mode 120000 src/lib/client/eliom_route_base.ml rename src/lib/{eliom_service.client.ml => client/eliom_service.ml} (90%) rename src/lib/{eliom_service.client.mli => client/eliom_service.mli} (100%) create mode 120000 src/lib/client/eliom_service_sigs.mli rename src/lib/{eliom_shared.client.mli => client/eliom_shared.mli} (100%) create mode 120000 src/lib/client/eliom_shared_sigs.mli rename src/lib/{eliom_types.client.ml => client/eliom_types.ml} (100%) create mode 120000 src/lib/client/eliom_types_base.ml create mode 120000 src/lib/client/eliom_types_base.mli create mode 120000 src/lib/client/eliom_uri.ml create mode 120000 src/lib/client/eliom_uri.mli create mode 100644 src/lib/common/dune create mode 120000 src/lib/common/eliom_lib_base.ml create mode 120000 src/lib/common/eliom_lib_base.mli rename src/lib/{eliom_wrap.server.ml => common/eliom_wrap.ml} (93%) rename src/lib/{eliom_wrap.server.mli => common/eliom_wrap.mli} (100%) rename src/lib/{ => eliom}/eliom_client_main.eliom (100%) rename src/lib/{ => eliom}/eliom_content.eliom (100%) rename src/lib/{ => eliom}/eliom_cscache.eliom (100%) rename src/lib/{ => eliom}/eliom_cscache.eliomi (100%) rename src/lib/{ => eliom}/eliom_form.eliom (99%) rename src/lib/{ => eliom}/eliom_form.eliomi (100%) rename src/lib/{ => eliom}/eliom_service_base.eliom (97%) rename src/lib/{ => eliom}/eliom_shared.eliom (96%) rename src/lib/{ => eliom}/eliom_shared_content.eliom (99%) rename src/lib/{ => eliom}/eliom_shared_content.eliomi (100%) rename src/lib/{ => eliom}/eliom_tools.eliom (100%) rename src/lib/{ => eliom}/eliom_tools.eliomi (100%) delete mode 100644 src/lib/eliom_wrap.client.mli create mode 100644 src/lib/server/common/dune rename src/lib/{eliom_client_value.server.ml => server/common/eliom_client_value.ml} (100%) rename src/lib/{eliom_client_value.server.mli => server/common/eliom_client_value.mli} (100%) rename src/lib/{eliom_common.server.ml => server/common/eliom_common.ml} (99%) rename src/lib/{eliom_common.server.mli => server/common/eliom_common.mli} (100%) create mode 120000 src/lib/server/common/eliom_common_base.ml rename src/lib/{eliom_lazy.server.ml => server/common/eliom_lazy.ml} (100%) rename src/lib/{eliom_lazy.server.mli => server/common/eliom_lazy.mli} (100%) rename src/lib/{eliom_lib.server.ml => server/common/eliom_lib.ml} (100%) rename src/lib/{eliom_lib.server.mli => server/common/eliom_lib.mli} (100%) rename src/lib/{eliom_request_info.server.ml => server/common/eliom_request_info.ml} (100%) rename src/lib/{eliom_request_info.server.mli => server/common/eliom_request_info.mli} (100%) create mode 120000 src/lib/server/common/eliom_runtime.ml create mode 120000 src/lib/server/common/eliom_runtime.mli create mode 100644 src/lib/server/dune rename src/lib/{eliom_bus.server.ml => server/eliom_bus.ml} (98%) rename src/lib/{eliom_bus.server.mli => server/eliom_bus.mli} (100%) rename src/lib/{eliom_client.server.ml => server/eliom_client.ml} (100%) rename src/lib/{eliom_client.server.mli => server/eliom_client.mli} (100%) create mode 120000 src/lib/server/eliom_client_base.ml rename src/lib/{eliom_comet.server.ml => server/eliom_comet.ml} (98%) rename src/lib/{eliom_comet.server.mli => server/eliom_comet.mli} (100%) create mode 120000 src/lib/server/eliom_comet_base.ml create mode 120000 src/lib/server/eliom_comet_base.mli rename src/lib/{eliom_config.server.ml => server/eliom_config.ml} (98%) rename src/lib/{eliom_config.server.mli => server/eliom_config.mli} (100%) rename src/lib/{eliom_content.server.mli => server/eliom_content.mli} (100%) rename src/lib/{eliom_content_.server.ml => server/eliom_content_.ml} (100%) rename src/lib/{eliom_content_core.server.ml => server/eliom_content_core.ml} (98%) rename src/lib/{eliom_content_core.server.mli => server/eliom_content_core.mli} (100%) create mode 120000 src/lib/server/eliom_content_sigs.mli rename src/lib/{eliom_cookie.server.ml => server/eliom_cookie.ml} (100%) rename src/lib/{eliom_cookie.server.mli => server/eliom_cookie.mli} (100%) create mode 120000 src/lib/server/eliom_cookies_base.ml rename src/lib/{eliom_error_pages.server.ml => server/eliom_error_pages.ml} (52%) rename src/lib/{eliom_extension.server.ml => server/eliom_extension.ml} (95%) rename src/lib/{eliom_extension.server.mli => server/eliom_extension.mli} (100%) rename src/lib/{eliom_extension_template.server.ml => server/eliom_extension_template.ml} (99%) create mode 120000 src/lib/server/eliom_form_sigs.mli rename src/lib/{eliom_mkreg.server.ml => server/eliom_mkreg.ml} (99%) rename src/lib/{eliom_mkreg.server.mli => server/eliom_mkreg.mli} (100%) rename src/lib/{eliom_notif.server.ml => server/eliom_notif.ml} (99%) rename src/lib/{eliom_notif.server.mli => server/eliom_notif.mli} (100%) rename src/lib/{eliom_parameter.server.ml => server/eliom_parameter.ml} (97%) rename src/lib/{eliom_parameter.server.mli => server/eliom_parameter.mli} (100%) create mode 120000 src/lib/server/eliom_parameter_base.ml create mode 120000 src/lib/server/eliom_parameter_sigs.mli rename src/lib/{eliom_process.server.ml => server/eliom_process.ml} (100%) rename src/lib/{eliom_react.server.ml => server/eliom_react.ml} (95%) rename src/lib/{eliom_react.server.mli => server/eliom_react.mli} (100%) rename src/lib/{eliom_reference.server.ml => server/eliom_reference.ml} (99%) rename src/lib/{eliom_reference.server.mli => server/eliom_reference.mli} (100%) rename src/lib/{eliom_registration.server.ml => server/eliom_registration.ml} (97%) rename src/lib/{eliom_registration.server.mli => server/eliom_registration.mli} (100%) create mode 120000 src/lib/server/eliom_registration_sigs.mli rename src/lib/{eliom_route.server.ml => server/eliom_route.ml} (94%) rename src/lib/{eliom_route.server.mli => server/eliom_route.mli} (100%) create mode 120000 src/lib/server/eliom_route_base.ml rename src/lib/{eliom_service.server.ml => server/eliom_service.ml} (97%) rename src/lib/{eliom_service.server.mli => server/eliom_service.mli} (100%) create mode 120000 src/lib/server/eliom_service_sigs.mli rename src/lib/{eliom_shared.server.mli => server/eliom_shared.mli} (100%) create mode 120000 src/lib/server/eliom_shared_sigs.mli rename src/lib/{eliom_state.server.ml => server/eliom_state.ml} (98%) rename src/lib/{eliom_state.server.mli => server/eliom_state.mli} (100%) rename src/lib/{eliom_syntax.server.ml => server/eliom_syntax.ml} (100%) rename src/lib/{eliom_syntax.server.mli => server/eliom_syntax.mli} (100%) rename src/lib/{eliom_types.server.ml => server/eliom_types.ml} (100%) rename src/lib/{eliom_types.server.mli => server/eliom_types.mli} (100%) create mode 120000 src/lib/server/eliom_types_base.ml create mode 120000 src/lib/server/eliom_types_base.mli create mode 120000 src/lib/server/eliom_uri.ml create mode 120000 src/lib/server/eliom_uri.mli rename src/lib/{eliom_client_base.shared.ml => shared/eliom_client_base.ml} (100%) rename src/lib/{eliom_comet_base.shared.ml => shared/eliom_comet_base.ml} (98%) rename src/lib/{eliom_comet_base.shared.mli => shared/eliom_comet_base.mli} (100%) rename src/lib/{eliom_common_base.shared.ml => shared/eliom_common_base.ml} (98%) rename src/lib/{eliom_content_sigs.shared.mli => shared/eliom_content_sigs.mli} (100%) rename src/lib/{eliom_cookies_base.shared.ml => shared/eliom_cookies_base.ml} (95%) rename src/lib/{eliom_form_sigs.shared.mli => shared/eliom_form_sigs.mli} (100%) rename src/lib/{eliom_lib_base.shared.ml => shared/eliom_lib_base.ml} (100%) rename src/lib/{eliom_lib_base.shared.mli => shared/eliom_lib_base.mli} (100%) rename src/lib/{eliom_parameter_base.shared.ml => shared/eliom_parameter_base.ml} (95%) rename src/lib/{eliom_parameter_sigs.shared.mli => shared/eliom_parameter_sigs.mli} (100%) rename src/lib/{eliom_registration_sigs.shared.mli => shared/eliom_registration_sigs.mli} (100%) rename src/lib/{eliom_route_base.shared.ml => shared/eliom_route_base.ml} (96%) rename src/lib/{eliom_runtime.shared.ml => shared/eliom_runtime.ml} (96%) rename src/lib/{eliom_runtime.shared.mli => shared/eliom_runtime.mli} (100%) rename src/lib/{eliom_service_sigs.shared.mli => shared/eliom_service_sigs.mli} (100%) rename src/lib/{eliom_shared_sigs.shared.mli => shared/eliom_shared_sigs.mli} (100%) rename src/lib/{eliom_types_base.shared.ml => shared/eliom_types_base.ml} (100%) rename src/lib/{eliom_types_base.shared.mli => shared/eliom_types_base.mli} (100%) rename src/lib/{eliom_uri.shared.ml => shared/eliom_uri.ml} (98%) rename src/lib/{eliom_uri.shared.mli => shared/eliom_uri.mli} (100%) delete mode 100644 src/ppx/.merlin delete mode 100644 src/ppx/_tags delete mode 100644 src/ppx/ppx_eliom.ml delete mode 100644 src/ppx/ppx_eliom.mli delete mode 100644 src/ppx/ppx_eliom_client.ml delete mode 100644 src/ppx/ppx_eliom_client.mli delete mode 100644 src/ppx/ppx_eliom_client_ex.ml delete mode 100644 src/ppx/ppx_eliom_server.ml delete mode 100644 src/ppx/ppx_eliom_server.mli delete mode 100644 src/ppx/ppx_eliom_server_ex.ml delete mode 100644 src/ppx/ppx_eliom_type.ml delete mode 100644 src/ppx/ppx_eliom_type.mli delete mode 100644 src/ppx/ppx_eliom_types_ex.ml delete mode 100644 src/ppx/ppx_eliom_utils.ml delete mode 100644 src/ppx/ppx_eliom_utils.mli delete mode 100644 src/syntax/pa_eliom_client_client.ml delete mode 100644 src/syntax/pa_eliom_client_server.ml delete mode 100644 src/syntax/pa_eliom_seed.ml delete mode 100644 src/syntax/pa_eliom_type_filter.ml create mode 100644 src/tools/dune diff --git a/build/build.ml b/build/build.ml index 34fb034299..593dc52bb7 100644 --- a/build/build.ml +++ b/build/build.ml @@ -15,9 +15,9 @@ module Intern = struct end let with_package = function - | "eliom.ppx.type" -> "pkg_ppx_eliom_types" - | "eliom.ppx.client" - | "eliom.ppx.server" + | "ppx_eliom.ppx.type" -> "pkg_ppx_eliom_types" + | "ppx_eliom.ppx.client" + | "ppx_eliom.ppx.server" | "eliom.syntax.predef" | "eliom.client" | "eliom.server" -> (* do noting in this case *) "pkg_dummy" diff --git a/dune-project b/dune-project new file mode 100644 index 0000000000..fa5a9e4075 --- /dev/null +++ b/dune-project @@ -0,0 +1 @@ +(lang dune 1.8.2) \ No newline at end of file diff --git a/opam b/eliom.opam similarity index 91% rename from opam rename to eliom.opam index a1c00f448f..4e3d7e74e3 100644 --- a/opam +++ b/eliom.opam @@ -9,13 +9,20 @@ homepage: "http://ocsigen.org/eliom/" bug-reports: "https://github.com/ocsigen/eliom/issues/" license: "LGPL-2.1 with OCaml linking exception" dev-repo: "git+https://github.com/ocsigen/eliom.git" -build: [make] +build: [ + ["dune" "build" "--profile" "release"] +] +install: [ + ["dune" "install"] +] depends: [ + "dune" "ocaml" {>= "4.06.1"} "ocamlfind" "deriving" {>= "0.6"} "ppx_deriving" "ppx_tools" {>= "0.99.3"} + "ppx_eliom" {>= "6.7.0"} "js_of_ocaml" {>= "3.3"} "js_of_ocaml-lwt" {>= "3.3"} "js_of_ocaml-ocamlbuild" {build} diff --git a/pkg/META b/pkg/META index 7ab2a4d2d0..ad1fa76e71 100644 --- a/pkg/META +++ b/pkg/META @@ -109,15 +109,15 @@ package "ppx" ( directory = "ppx" package "server" ( description = "Ppx syntax extension: server side" - ppx = "ppx_eliom_server" + ppx = "ppx_eliom_server_standalone.exe" ) package "client" ( description = "Ppx syntax extension: client side" - ppx = "ppx_eliom_client" + ppx = "ppx_eliom_client_standalone.exe" ) package "type" ( description = "Ppx syntax extension: type inference" - ppx = "ppx_eliom_types" + ppx = "ppx_eliom_types_standalone.exe" ) ) diff --git a/src/lib/client/common/dune b/src/lib/client/common/dune new file mode 100644 index 0000000000..30c8ec4159 --- /dev/null +++ b/src/lib/client/common/dune @@ -0,0 +1,16 @@ +(library + (name internalclient) + (wrapped false) + (public_name eliom.client.common) + (libraries + eliom.common + js_of_ocaml + js_of_ocaml.tyxml + js_of_ocaml-lwt.logger + ocsigenserver + react + reactiveData) + (preprocess + (pps + js_of_ocaml-ppx + js_of_ocaml-ppx_deriving_json))) diff --git a/src/lib/eliom_client_value.client.ml b/src/lib/client/common/eliom_client_value.ml similarity index 100% rename from src/lib/eliom_client_value.client.ml rename to src/lib/client/common/eliom_client_value.ml diff --git a/src/lib/eliom_client_value.client.mli b/src/lib/client/common/eliom_client_value.mli similarity index 100% rename from src/lib/eliom_client_value.client.mli rename to src/lib/client/common/eliom_client_value.mli diff --git a/src/lib/client/common/eliom_common_base.ml b/src/lib/client/common/eliom_common_base.ml new file mode 120000 index 0000000000..9e7b831fcc --- /dev/null +++ b/src/lib/client/common/eliom_common_base.ml @@ -0,0 +1 @@ +../../shared/eliom_common_base.ml \ No newline at end of file diff --git a/src/lib/eliom_config.client.ml b/src/lib/client/common/eliom_config.ml similarity index 100% rename from src/lib/eliom_config.client.ml rename to src/lib/client/common/eliom_config.ml diff --git a/src/lib/eliom_config.client.mli b/src/lib/client/common/eliom_config.mli similarity index 100% rename from src/lib/eliom_config.client.mli rename to src/lib/client/common/eliom_config.mli diff --git a/src/lib/eliom_content_core.client.ml b/src/lib/client/common/eliom_content_core.ml similarity index 99% rename from src/lib/eliom_content_core.client.ml rename to src/lib/client/common/eliom_content_core.ml index 592d0f1356..a0fbb729b5 100644 --- a/src/lib/eliom_content_core.client.ml +++ b/src/lib/client/common/eliom_content_core.ml @@ -72,7 +72,7 @@ module Xml = struct Lazy.force elt.elt 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.client.mli b/src/lib/client/common/eliom_content_core.mli similarity index 100% rename from src/lib/eliom_content_core.client.mli rename to src/lib/client/common/eliom_content_core.mli diff --git a/src/lib/eliom_lazy.client.ml b/src/lib/client/common/eliom_lazy.ml similarity index 100% rename from src/lib/eliom_lazy.client.ml rename to src/lib/client/common/eliom_lazy.ml diff --git a/src/lib/eliom_lazy.client.mli b/src/lib/client/common/eliom_lazy.mli similarity index 100% rename from src/lib/eliom_lazy.client.mli rename to src/lib/client/common/eliom_lazy.mli diff --git a/src/lib/eliom_lib.client.ml b/src/lib/client/common/eliom_lib.ml similarity index 94% rename from src/lib/eliom_lib.client.ml rename to src/lib/client/common/eliom_lib.ml index 382fff5c7c..12b15ce4eb 100644 --- a/src/lib/eliom_lib.client.ml +++ b/src/lib/client/common/eliom_lib.ml @@ -67,9 +67,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 = @@ -148,8 +148,8 @@ end (* We do not use the deriving (un)marshaling even if typ is available because direct jsn (un)marshaling is very fast client side *) -let to_json ?typ s = Js.to_string (Json.output s) -let of_json ?typ v = Json.unsafe_input (Js.string v) +let to_json ?typ:_ s = Js.to_string (Json.output s) +let of_json ?typ:_ v = Json.unsafe_input (Js.string v) (* to marshal data and put it in a form *) let encode_form_value x = to_json x @@ -166,5 +166,5 @@ let unmarshal_js var = type file_info = File.file Js.t -let make_cryptographic_safe_string ?len () = +let make_cryptographic_safe_string ?len:_ () = failwith "make_cryptographic_safe_string not implemented client-side" diff --git a/src/lib/eliom_lib.client.mli b/src/lib/client/common/eliom_lib.mli similarity index 100% rename from src/lib/eliom_lib.client.mli rename to src/lib/client/common/eliom_lib.mli diff --git a/src/lib/client/common/eliom_runtime.ml b/src/lib/client/common/eliom_runtime.ml new file mode 120000 index 0000000000..6d80d46c3a --- /dev/null +++ b/src/lib/client/common/eliom_runtime.ml @@ -0,0 +1 @@ +../../shared/eliom_runtime.ml \ No newline at end of file diff --git a/src/lib/client/common/eliom_runtime.mli b/src/lib/client/common/eliom_runtime.mli new file mode 120000 index 0000000000..8f3cee3f4d --- /dev/null +++ b/src/lib/client/common/eliom_runtime.mli @@ -0,0 +1 @@ +../../shared/eliom_runtime.mli \ No newline at end of file diff --git a/src/lib/eliom_unwrap.client.ml b/src/lib/client/common/eliom_unwrap.ml similarity index 98% rename from src/lib/eliom_unwrap.client.ml rename to src/lib/client/common/eliom_unwrap.ml index ee8821a7ea..1363a52103 100644 --- a/src/lib/eliom_unwrap.client.ml +++ b/src/lib/client/common/eliom_unwrap.ml @@ -34,7 +34,7 @@ let map : (Obj.t,Obj.t) weakMap Js.t = jsnew weakMap () open Js_of_ocaml open Eliom_lib -let section = Lwt_log.Section.make "eliom:unwrap" +let _section = Lwt_log.Section.make "eliom:unwrap" module Mark : sig type t diff --git a/src/lib/eliom_unwrap.client.mli b/src/lib/client/common/eliom_unwrap.mli similarity index 100% rename from src/lib/eliom_unwrap.client.mli rename to src/lib/client/common/eliom_unwrap.mli diff --git a/src/lib/client/dune b/src/lib/client/dune new file mode 100644 index 0000000000..def0d78631 --- /dev/null +++ b/src/lib/client/dune @@ -0,0 +1,106 @@ +(library + (name client) + (public_name eliom.client) + (wrapped false) + (libraries + eliom.common + eliom.client.common + ipaddr + lwt + js_of_ocaml + js_of_ocaml-lwt + js_of_ocaml-lwt.logger + js_of_ocaml.tyxml + lwt_log + lwt_react + netstring-pcre + ocsigenserver + ocsigenserver.cookies + ocsigenserver.ext + react + reactiveData + tyxml) + (preprocess + (pps + js_of_ocaml-ppx + js_of_ocaml-ppx_deriving_json + lwt_ppx)) + (modules_without_implementation + eliom_content_sigs + eliom_form_sigs + eliom_parameter_sigs + eliom_registration_sigs + eliom_service_sigs + eliom_shared_sigs)) + +(rule + (targets eliom_content.ml) + (deps ../eliom/eliom_content.eliom) + (action + (with-stdout-to + %{targets} + (run %{bin:ppxfind} -legacy ppx_eliom.ppx.client --impl %{deps})))) + +(rule + (targets eliom_cscache.ml) + (deps ../eliom/eliom_cscache.eliom) + (action + (with-stdout-to + %{targets} + (run %{bin:ppxfind} -legacy ppx_eliom.ppx.client --impl %{deps})))) + +(rule + (targets eliom_cscache.mli) + (deps ../eliom/eliom_cscache.eliomi) + (action + (with-stdout-to + %{targets} + (run %{bin:ppxfind} -legacy ppx_eliom.ppx.client --intf %{deps})))) + +(rule + (targets eliom_form.ml) + (deps ../eliom/eliom_form.eliom) + (action + (with-stdout-to + %{targets} + (run %{bin:ppxfind} -legacy ppx_eliom.ppx.client --impl %{deps})))) + +(rule + (targets eliom_form.mli) + (deps ../eliom/eliom_form.eliomi) + (action + (with-stdout-to + %{targets} + (run %{bin:ppxfind} -legacy ppx_eliom.ppx.client --intf %{deps})))) + +(rule + (targets eliom_service_base.ml) + (deps ../eliom/eliom_service_base.eliom) + (action + (with-stdout-to + %{targets} + (run %{bin:ppxfind} -legacy ppx_eliom.ppx.client --impl %{deps})))) + +(rule + (targets eliom_shared.ml) + (deps ../eliom/eliom_shared.eliom) + (action + (with-stdout-to + %{targets} + (run %{bin:ppxfind} -legacy ppx_eliom.ppx.client --impl %{deps})))) + +(rule + (targets eliom_shared_content.ml) + (deps ../eliom/eliom_shared_content.eliom) + (action + (with-stdout-to + %{targets} + (run %{bin:ppxfind} -legacy ppx_eliom.ppx.client --impl %{deps})))) + +(rule + (targets eliom_tools.ml) + (deps ../eliom/eliom_tools.eliom) + (action + (with-stdout-to + %{targets} + (run %{bin:ppxfind} -legacy ppx_eliom.ppx.client --impl %{deps})))) diff --git a/src/lib/eliom_bus.client.ml b/src/lib/client/eliom_bus.ml similarity index 94% rename from src/lib/eliom_bus.client.ml rename to src/lib/client/eliom_bus.ml index 6465e3a61a..099c6ee7d4 100644 --- a/src/lib/eliom_bus.client.ml +++ b/src/lib/client/eliom_bus.ml @@ -46,6 +46,7 @@ let consume (t,u) s = | Lwt.Sleep -> Lwt.wakeup_exn u e; | _ -> ()); [%lwt raise ( e)] + [@ocaml.warning "-22"] in Lwt.choose [Lwt.bind t (fun _ -> Lwt.return_unit);t'] @@ -57,7 +58,8 @@ let clone_exn (t,u) s = (match Lwt.state t with | Lwt.Sleep -> Lwt.wakeup_exn u e; | _ -> ()); - [%lwt raise ( e)]) + [%lwt raise ( e)] + [@ocaml.warning "-22"]) type ('a, 'att, 'co, 'ext, 'reg) callable_bus_service = (unit, 'a list, Eliom_service.post, @@ -78,7 +80,7 @@ let create service channel waiter = in let error_h = let t,u = Lwt.wait () in - (try%lwt let%lwt _ = t in assert false with e -> [%lwt raise ( e)]), u in + (try%lwt let%lwt _ = t in assert false with e -> [%lwt raise ( e)][@ocaml.warning "-22"]), u in let stream = lazy ( let stream = Eliom_comet.register channel in @@ -108,7 +110,7 @@ let create service channel waiter = in t -let internal_unwrap ((wrapped_bus:('a, 'b) Ecb.wrapped_bus),unwrapper) = +let internal_unwrap ((wrapped_bus:('a, 'b) Ecb.wrapped_bus),_unwrapper) = let waiter () = Lwt_js.sleep 0.05 in let channel, Eliom_comet_base.Bus_send_service service = wrapped_bus in create service channel waiter @@ -141,7 +143,7 @@ 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 diff --git a/src/lib/eliom_bus.client.mli b/src/lib/client/eliom_bus.mli similarity index 100% rename from src/lib/eliom_bus.client.mli rename to src/lib/client/eliom_bus.mli diff --git a/src/lib/eliom_client.client.ml b/src/lib/client/eliom_client.ml similarity index 98% rename from src/lib/eliom_client.client.ml rename to src/lib/client/eliom_client.ml index 8253250f45..b2533cd652 100644 --- a/src/lib/eliom_client.client.ml +++ b/src/lib/client/eliom_client.ml @@ -59,7 +59,7 @@ let get_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 | _ -> @@ -153,12 +153,12 @@ let init () = match Url.url_of_string (Js.to_string (Js.Unsafe.global##.___eliom_server_)) with - | Some (Http { hu_host; hu_port; hu_path; _ }) -> + | Some (Http { hu_host; hu_port; hu_path = _; _ }) -> init_client_app ~app_name ~ssl:false ~hostname:hu_host ~port:hu_port ~site_dir () - | Some (Https { hu_host; hu_port; hu_path; _ }) -> + | Some (Https { hu_host; hu_port; hu_path = _; _ }) -> init_client_app ~app_name ~ssl:true ~hostname:hu_host ~port:hu_port ~site_dir () @@ -196,7 +196,7 @@ let init () = let onload_handler = ref None in - let onload ev = + let onload _ev = let js_data = Lazy.force js_data in Lwt_log.ign_debug ~section "onload (client main)"; begin match !onload_handler with @@ -361,7 +361,7 @@ let raw_call_service ?progress ?upload_progress ?override_mime_type uri post_params Eliom_request.string_result in match content with - | None -> [%lwt raise ( (Eliom_request.Failed_request 204))] + | None -> [%lwt raise ( (Eliom_request.Failed_request 204))][@ocaml.warning "-22"] | Some content -> Lwt.return (uri, content) let call_service @@ -507,11 +507,13 @@ let garbage_collect_cached_doms () = in let rec accum_past = function | Some idx when !size < n -> + begin try let dom = HistCache.find idx !history_doms in add idx dom; accum_past dom.page.previous_page with Not_found -> () + end | _ -> () in let _, _, future = HistCache.split cur_index !history_doms in @@ -697,8 +699,7 @@ let set_template_content ~replace ~uri ?fragment = (match fragment with | None -> change_url_string ~replace uri | Some fragment -> - change_url_string ~replace (uri ^ "#" ^ fragment) - | _ -> ()); + change_url_string ~replace (uri ^ "#" ^ fragment)); let%lwt () = Lwt_mutex.lock load_mutex in let%lwt (), request_data = unwrap_caml_content content in do_request_data request_data; @@ -782,6 +783,7 @@ let set_content_local ?offset ?fragment new_page = recover (); Lwt_log.ign_debug ~section ~exn "set_content_local"; [%lwt raise ( exn)] + [@@ocaml.warning "-22"] (* Function to be called for server side services: *) let set_content ~replace ~uri ?offset ?fragment content = @@ -885,6 +887,7 @@ let set_content ~replace ~uri ?offset ?fragment content = recover (); Lwt_log.ign_debug ~section ~exn "set_content"; [%lwt raise ( exn)] + [@@ocaml.warning "-22"] let ocamlify_params = List.map @@ -939,7 +942,7 @@ let make_uri subpath params = Eliom_uri.make_string_uri_from_components (base, params, None) let route ~replace ?(keep_url = false) - ({ Eliom_route.i_subpath ; i_get_params ; i_post_params } as info) = + ({ Eliom_route.i_subpath ; i_get_params ; i_post_params; _ } as info) = Lwt_log.ign_debug ~section:section_page "Route"; let r = !Eliom_request_info.get_sess_info and info, i_subpath = @@ -966,7 +969,7 @@ let perform_reload () = Lwt_log.ign_debug ~section:section_page "Perform reload"; let uri = !current_uri in let - ({ Eliom_common.si_all_get_params ; si_all_post_params } + ({ Eliom_common.si_all_get_params ; si_all_post_params = _; _ } as i_sess_info) = !Eliom_request_info.get_sess_info () and i_subpath = Url.path_of_url_string uri in @@ -1111,7 +1114,7 @@ type _ redirection = 'a redirection let change_page_unknown - ?meth ?hostname ?(replace = false) i_subpath i_get_params i_post_params = + ?meth ?hostname:_ ?(replace = false) i_subpath i_get_params i_post_params = Lwt_log.ign_debug ~section:section_page "Change page unknown"; let i_sess_info = !Eliom_request_info.get_sess_info () and i_meth = diff --git a/src/lib/eliom_client.client.mli b/src/lib/client/eliom_client.mli similarity index 100% rename from src/lib/eliom_client.client.mli rename to src/lib/client/eliom_client.mli diff --git a/src/lib/client/eliom_client_base.ml b/src/lib/client/eliom_client_base.ml new file mode 120000 index 0000000000..facae97b2f --- /dev/null +++ b/src/lib/client/eliom_client_base.ml @@ -0,0 +1 @@ +../shared/eliom_client_base.ml \ No newline at end of file diff --git a/src/lib/eliom_client_core.client.ml b/src/lib/client/eliom_client_core.ml similarity index 99% rename from src/lib/eliom_client_core.client.ml rename to src/lib/client/eliom_client_core.ml index 0b15f11da2..ebe2812cab 100644 --- a/src/lib/eliom_client_core.client.ml +++ b/src/lib/client/eliom_client_core.ml @@ -193,7 +193,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 value marked for late unwrapping. How to do this efficiently? *) @@ -269,7 +269,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 {Eliom_runtime.closure_id; value} -> + (fun {Eliom_runtime.closure_id; value; _} -> let instance_id = Eliom_runtime.Client_value_server_repr.instance_id value in @@ -404,14 +404,14 @@ let in_onload, broadcast_load_end, wait_load_end, set_loading_phase = (* forward declaration... *) let change_page_uri_ : (?cookies_info:bool * string list -> ?tmpl:string -> string -> unit) ref - = ref (fun ?cookies_info ?tmpl href -> assert false) + = ref (fun ?cookies_info:_ ?tmpl:_ _href -> assert false) let change_page_get_form_ : (?cookies_info:bool * string list -> ?tmpl:string -> Dom_html.formElement Js.t -> string -> unit) ref - = ref (fun ?cookies_info ?tmpl form href -> assert false) + = ref (fun ?cookies_info:_ ?tmpl:_ _form _href -> assert false) let change_page_post_form_ = - ref (fun ?cookies_info ?tmpl form href -> assert false) + ref (fun ?cookies_info:_ ?tmpl:_ _form _href -> assert false) type client_form_handler = Dom_html.event Js.t -> bool Lwt.t @@ -540,7 +540,7 @@ let rebuild_attrib_val = function let class_list_of_racontent = function | Xml.AStr s -> [s] - | Xml.AStrL (space, l) -> + | Xml.AStrL (_space, l) -> l | _ -> failwith "attribute class is not a string" @@ -861,7 +861,7 @@ let form_handler (fun () -> Lwt_log.raise_error_f ~section "not a form element") in let kind = - if String.lowercase(Js.to_string form##._method) = "get" + if String.lowercase_ascii(Js.to_string form##._method) = "get" then `Form_get else `Form_post and f _ = Lwt.return_false in @@ -1008,7 +1008,7 @@ let is_attrib_attrib,get_attrib_id = attr##.name##(substring (0) n_len) = n_prefix_js), (fun attr -> attr##.value##(substring_toEnd v_len)) -let relink_attrib root table (node:Dom_html.element Js.t) = +let relink_attrib _root table (node:Dom_html.element Js.t) = Lwt_log.ign_debug ~section "Relink attribute"; let aux attr = if is_attrib_attrib attr diff --git a/src/lib/eliom_comet.client.ml b/src/lib/client/eliom_comet.ml similarity index 96% rename from src/lib/eliom_comet.client.ml rename to src/lib/client/eliom_comet.ml index a2e43e31d8..1ec50ccae0 100644 --- a/src/lib/eliom_comet.client.ml +++ b/src/lib/client/eliom_comet.ml @@ -393,14 +393,14 @@ struct let call_service_after_load_end service p1 p2 = let%lwt () = Eliom_client.wait_load_end () in - Eliom_client.call_service service p1 p2 + Eliom_client.call_service ~service p1 p2 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) !map [] + (fun channel { position; _ } l -> (channel,position)::l) !map [] in Ecb.Stateless (Array.of_list l) @@ -414,8 +414,8 @@ struct | Stateful_state r -> incr r; List.iter (function - | ( chan_id, Ecb.Data _ ) -> () - | ( chan_id, Ecb.Closed ) -> + | ( _chan_id, Ecb.Data _ ) -> () + | ( _chan_id, Ecb.Closed ) -> Eliom_lib.Lwt_log.ign_warning ~section "update_stateful_state: received Closed: should not happen, this is an eliom bug, please report it" | ( chan_id, Ecb.Full ) -> @@ -468,7 +468,7 @@ struct raise (Comet_error ("update_stateless_state on stateful one")) let call_service - ({ hd_activity; hd_service = Ecb.Comet_service srv } as hd) = + ({ hd_activity; hd_service = Ecb.Comet_service srv; _ } as hd) = let%lwt () = Configuration.sleep_before_next_request (fun () -> hd_activity.focused) @@ -554,7 +554,7 @@ struct update_activity hd; aux 0 - let call_commands {hd_service = Ecb.Comet_service srv} command = + let call_commands {hd_service = Ecb.Comet_service srv; _} command = ignore (try%lwt call_service_after_load_end srv () @@ -684,22 +684,22 @@ let get_stateless_hd (service:Ecb.comet_service) : Service_handler.stateless han | Not_found -> init service Service_handler.stateless stateless_handler_table let activate () = - let f _ { hd_service_handler } = + 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 + | Ecb.Stateless_channel (chan_service,chan_id,_kind) -> + 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 @@ -738,7 +738,7 @@ let check_and_update_position position msg_pos data = (* stateless channels are registered with a position: when a channel is registered more than one time, it is possible to receive old messages: the position is used to filter them out. *) -let register' hd position (chan_service:Ecb.comet_service) (chan_id:'a Ecb.chan_id) = +let register' hd position (_chan_service:Ecb.comet_service) (chan_id:'a Ecb.chan_id) = let chan_id = Ecb.string_of_chan_id chan_id in let stream = Lwt_stream.filter_map_s (function @@ -786,7 +786,7 @@ let register ?(wake=true) (wrapped_chan:'a Ecb.wrapped_channel) = | Ecb.Stateless_channel (s,c,kind) -> register_stateless ~wake s c kind -let internal_unwrap ( wrapped_chan, unwrapper ) = register wrapped_chan +let internal_unwrap ( wrapped_chan, _unwrapper ) = register wrapped_chan let () = Eliom_unwrap.register_unwrapper Eliom_common.comet_channel_unwrap_id internal_unwrap diff --git a/src/lib/eliom_comet.client.mli b/src/lib/client/eliom_comet.mli similarity index 100% rename from src/lib/eliom_comet.client.mli rename to src/lib/client/eliom_comet.mli diff --git a/src/lib/client/eliom_comet_base.ml b/src/lib/client/eliom_comet_base.ml new file mode 120000 index 0000000000..0fae8e0136 --- /dev/null +++ b/src/lib/client/eliom_comet_base.ml @@ -0,0 +1 @@ +../shared/eliom_comet_base.ml \ No newline at end of file diff --git a/src/lib/client/eliom_comet_base.mli b/src/lib/client/eliom_comet_base.mli new file mode 120000 index 0000000000..7c7653ca52 --- /dev/null +++ b/src/lib/client/eliom_comet_base.mli @@ -0,0 +1 @@ +../shared/eliom_comet_base.mli \ No newline at end of file diff --git a/src/lib/eliom_common.client.ml b/src/lib/client/eliom_common.ml similarity index 94% rename from src/lib/eliom_common.client.ml rename to src/lib/client/eliom_common.ml index 15a661b2ff..dcb3188029 100644 --- a/src/lib/eliom_common.client.ml +++ b/src/lib/client/eliom_common.ml @@ -26,7 +26,7 @@ let get_sp_option () = Some () type 'a wrapper = unit -let make_wrapper f :'a wrapper = () +let make_wrapper _f :'a wrapper = () let empty_wrapper () :'a wrapper = () type unwrap_id = Eliom_unwrap.unwrap_id @@ -54,9 +54,9 @@ module To_and_of_shared = struct type 'a t = 'a to_and_of - let of_string {of_string} = of_string + let of_string {of_string; _} = of_string - let to_string {to_string} = to_string + let to_string {to_string; _} = to_string let to_and_of tao = tao diff --git a/src/lib/eliom_content.client.mli b/src/lib/client/eliom_content.mli similarity index 100% rename from src/lib/eliom_content.client.mli rename to src/lib/client/eliom_content.mli diff --git a/src/lib/eliom_content_.client.ml b/src/lib/client/eliom_content_.ml similarity index 99% rename from src/lib/eliom_content_.client.ml rename to src/lib/client/eliom_content_.ml index d6917362c0..a69fce189f 100644 --- a/src/lib/eliom_content_.client.ml +++ b/src/lib/client/eliom_content_.ml @@ -27,7 +27,9 @@ module Xml = Xml module MakeManip (Kind : sig type +'a elt - val tot: Xml.elt -> 'a elt + + val tot: Xml.elt -> 'a elt [@@ocaml.warning "-32"] + val toelt: 'a elt -> Xml.elt end) (To_dom : sig @@ -48,9 +50,9 @@ module MakeManip let get_unique_node context (elt: 'a Kind.elt) : Dom.node Js.t = match Xml.get_node (Kind.toelt elt) with | Xml.DomNode node -> node - | Xml.ReactNode s -> get_node elt - | Xml.ReactChildren (node,rl) -> get_node elt - | Xml.TyXMLNode desc -> + | Xml.ReactNode _s -> get_node elt + | Xml.ReactChildren (_node,_rl) -> get_node elt + | Xml.TyXMLNode _desc -> let elt' = Kind.toelt elt in match Xml.get_node_id elt' with | Xml.NoId -> @@ -321,8 +323,8 @@ module Svg = struct module D = Svg.D module R = Svg.R module C = struct - let node ?init x = x - let attr ?init x = x + let node ?init:_ x = x + let attr ?init:_ x = x end type +'a elt = 'a F.elt @@ -419,8 +421,8 @@ module Html = struct end module C = struct - let node ?init x = x - let attr ?init x = x + let node ?init:_ x = x + let attr ?init:_ x = x end type +'a elt = 'a F.elt diff --git a/src/lib/client/eliom_content_sigs.mli b/src/lib/client/eliom_content_sigs.mli new file mode 120000 index 0000000000..2296d13813 --- /dev/null +++ b/src/lib/client/eliom_content_sigs.mli @@ -0,0 +1 @@ +../shared/eliom_content_sigs.mli \ No newline at end of file diff --git a/src/lib/client/eliom_cookies_base.ml b/src/lib/client/eliom_cookies_base.ml new file mode 120000 index 0000000000..f8f958fb69 --- /dev/null +++ b/src/lib/client/eliom_cookies_base.ml @@ -0,0 +1 @@ +../shared/eliom_cookies_base.ml \ No newline at end of file diff --git a/src/lib/client/eliom_form_sigs.mli b/src/lib/client/eliom_form_sigs.mli new file mode 120000 index 0000000000..ff33d4f763 --- /dev/null +++ b/src/lib/client/eliom_form_sigs.mli @@ -0,0 +1 @@ +../shared/eliom_form_sigs.mli \ No newline at end of file diff --git a/src/lib/eliom_parameter.client.ml b/src/lib/client/eliom_parameter.ml similarity index 96% rename from src/lib/eliom_parameter.client.ml rename to src/lib/client/eliom_parameter.ml index 8e5e60721b..c0abd26497 100644 --- a/src/lib/eliom_parameter.client.ml +++ b/src/lib/client/eliom_parameter.ml @@ -110,7 +110,7 @@ and reconstruct_params_form : Some ((x1, x2), m) | TUnit -> Some ((), m) - | TOption (TAtom (_, TString) as y, b) -> + | TOption (TAtom (_, TString) as y, _b) -> (match reconstruct_params_form m y with | Some ("", m) -> Some (None, m) @@ -118,7 +118,7 @@ and reconstruct_params_form : Some (Some s, m) | None -> Some (None, m)) - | TOption (y, b) -> + | TOption (y, _b) -> (match reconstruct_params_form m y with | Some (x, m) -> Some (Some x, m) @@ -141,7 +141,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}) -> + | TUserType (name, {of_string = f; _}) -> reconstruct_atom ~f m name | _ -> None @@ -156,7 +156,7 @@ 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.client.mli b/src/lib/client/eliom_parameter.mli similarity index 100% rename from src/lib/eliom_parameter.client.mli rename to src/lib/client/eliom_parameter.mli diff --git a/src/lib/client/eliom_parameter_base.ml b/src/lib/client/eliom_parameter_base.ml new file mode 120000 index 0000000000..e58afb653c --- /dev/null +++ b/src/lib/client/eliom_parameter_base.ml @@ -0,0 +1 @@ +../shared/eliom_parameter_base.ml \ No newline at end of file diff --git a/src/lib/client/eliom_parameter_sigs.mli b/src/lib/client/eliom_parameter_sigs.mli new file mode 120000 index 0000000000..4208352c3b --- /dev/null +++ b/src/lib/client/eliom_parameter_sigs.mli @@ -0,0 +1 @@ +../shared/eliom_parameter_sigs.mli \ No newline at end of file diff --git a/src/lib/eliom_process.client.ml b/src/lib/client/eliom_process.ml similarity index 100% rename from src/lib/eliom_process.client.ml rename to src/lib/client/eliom_process.ml diff --git a/src/lib/eliom_react.client.ml b/src/lib/client/eliom_react.ml similarity index 88% rename from src/lib/eliom_react.client.ml rename to src/lib/client/eliom_react.ml index ae4030b709..deb63c8ea4 100644 --- a/src/lib/eliom_react.client.ml +++ b/src/lib/client/eliom_react.ml @@ -42,17 +42,17 @@ struct ((fun ?exn () -> !r ?exn ()), (fun f -> r := f)) - let internal_unwrap ( channel, unwrapper ) = + let internal_unwrap ( channel, _unwrapper ) = (* We want to catch more exceptions here than the usual exceptions caught in Eliom_comet. For example Channel_full. *) (* We transform the stream into a stream with exception: *) - let stream = Lwt_stream.map_exn channel in + let stream = Lwt_stream.wrap_exn channel in Lwt.async (fun () -> Lwt_stream.iter_s (function - | Lwt_stream.Error exn -> + | Error exn -> let%lwt () = handle_react_exn ~exn () in Lwt.fail exn - | Lwt_stream.Value _ -> Lwt.return_unit) + | Ok _ -> Lwt.return_unit) stream); E.of_stream channel @@ -67,7 +67,7 @@ struct type 'a t = ('a -> unit Lwt.t) - let internal_unwrap ( service, unwrapper ) = + let internal_unwrap ( service, _unwrapper ) = fun x -> Eliom_client.call_service ~service () x >|= fun _ -> () let () = @@ -82,7 +82,7 @@ struct struct type 'a t = 'a React.S.t - let internal_unwrap ( channel, value, unwrapper ) = + let internal_unwrap ( channel, value, _unwrapper ) = let e = E.of_stream channel in S.hold ~eq:(fun _ _ -> false) value e diff --git a/src/lib/eliom_react.client.mli b/src/lib/client/eliom_react.mli similarity index 100% rename from src/lib/eliom_react.client.mli rename to src/lib/client/eliom_react.mli diff --git a/src/lib/eliom_registration.client.ml b/src/lib/client/eliom_registration.ml similarity index 97% rename from src/lib/eliom_registration.client.ml rename to src/lib/client/eliom_registration.ml index b78a7d4f69..a9cc696392 100644 --- a/src/lib/eliom_registration.client.ml +++ b/src/lib/client/eliom_registration.ml @@ -108,7 +108,7 @@ let wrap service att f _ suffix = let wrap_na (service : (_, _, _, _, _, _, _, _, _, _, _) Eliom_service.t) - non_att f _ suffix = + _non_att f _ suffix = let gp = Eliom_service.get_params_type service and pp = Eliom_service.post_params_type service and si = !Eliom_request_info.get_sess_info () @@ -177,7 +177,7 @@ module Make (P : PARAM) = struct type return = P.return type result = P.result - let send ?options ?charset ?code ?content_type ?headers page = + let send ?options ?charset:_ ?code:_ ?content_type:_ ?headers:_ page = P.send ?options page let register @@ -218,7 +218,7 @@ module Action = Make (struct let reset_reload_fun = true - let send ?options page = + let send ?options _page = match options with | Some `Reload | None -> Eliom_client.perform_reload () @@ -236,7 +236,7 @@ module Unit = Make (struct let reset_reload_fun = true - let send ?options:_ page = + let send ?options:_ _page = Lwt.return_unit end) @@ -319,7 +319,7 @@ module Any = struct Lwt.return page let register - ?app ?scope:_ ?options ?charset:_ ?code:_ ?content_type:_ + ?app ?scope:_ ?options:_ ?charset:_ ?code:_ ?content_type:_ ?headers:_ ?secure_session:_ ~service ?error_handler:_ f = let f g p = let%lwt page = f g p in send page in diff --git a/src/lib/eliom_registration.client.mli b/src/lib/client/eliom_registration.mli similarity index 100% rename from src/lib/eliom_registration.client.mli rename to src/lib/client/eliom_registration.mli diff --git a/src/lib/client/eliom_registration_sigs.mli b/src/lib/client/eliom_registration_sigs.mli new file mode 120000 index 0000000000..ab28cbf30e --- /dev/null +++ b/src/lib/client/eliom_registration_sigs.mli @@ -0,0 +1 @@ +../shared/eliom_registration_sigs.mli \ No newline at end of file diff --git a/src/lib/eliom_request.client.ml b/src/lib/client/eliom_request.ml similarity index 98% rename from src/lib/eliom_request.client.ml rename to src/lib/client/eliom_request.ml index 20a18057a2..023a167003 100644 --- a/src/lib/eliom_request.client.ml +++ b/src/lib/client/eliom_request.ml @@ -56,9 +56,9 @@ let get_cookie_info_for_uri_js uri_js = (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 @@ -89,7 +89,7 @@ let redirect_post url params = in i##.value := v; Dom.appendChild f i - | `File i -> + | `File _i -> Lwt_log.raise_error ~section "redirect_post not implemented for files") params; f##.style##.display := (Js.string "none"); @@ -258,7 +258,7 @@ let send (match r.XmlHttpRequest.headers Eliom_common.half_xhr_redir_header with | None | Some "" -> Lwt.return (r.XmlHttpRequest.url, None) - | Some uri -> + | Some _uri -> redirect_post url (match post_args with | Some post_args -> post_args diff --git a/src/lib/eliom_request.client.mli b/src/lib/client/eliom_request.mli similarity index 100% rename from src/lib/eliom_request.client.mli rename to src/lib/client/eliom_request.mli diff --git a/src/lib/eliom_request_info.client.ml b/src/lib/client/eliom_request_info.ml similarity index 99% rename from src/lib/eliom_request_info.client.ml rename to src/lib/client/eliom_request_info.ml index 4cb1fd1808..52ce648291 100644 --- a/src/lib/eliom_request_info.client.ml +++ b/src/lib/client/eliom_request_info.ml @@ -84,7 +84,7 @@ let current_path_ = ref (remove_first_slash Url.Current.path) let set_current_path uri = current_path_ := Url.path_of_url_string (if uri = "./" then "" else uri) -let get_original_full_path_sp sp = +let get_original_full_path_sp _sp = (* returns current path, not the one when application started *) if Eliom_process.history_api && not !client_app_initialised then match Url.Current.get () with diff --git a/src/lib/eliom_route.client.ml b/src/lib/client/eliom_route.ml similarity index 80% rename from src/lib/eliom_route.client.ml rename to src/lib/client/eliom_route.ml index 3268aaaa59..bcb99ae0f7 100644 --- a/src/lib/eliom_route.client.ml +++ b/src/lib/client/eliom_route.ml @@ -21,11 +21,11 @@ module A = struct let site_data _ = () - let sess_info_of_info {i_sess_info} = i_sess_info + let sess_info_of_info {i_sess_info; _} = i_sess_info - let subpath_of_info {i_subpath} = i_subpath + let subpath_of_info {i_subpath; _} = i_subpath - let meth_of_info {i_meth} = i_meth + let meth_of_info {i_meth; _} = i_meth let make_params _ _ suffix _ = suffix @@ -54,15 +54,15 @@ module A = struct type t = table - let add {Eliom_common.key_meth} 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 @@ -71,9 +71,9 @@ module A = struct type t = unit - let up n = () + let up _n = () - let remove n = () + let remove _n = () end @@ -90,7 +90,7 @@ module A = struct ) 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 @@ -98,7 +98,7 @@ module A = struct let set tables l = tables.t_services <- l - let dlist_add ?sp:_ tables srv = () + let dlist_add ?sp:_ _tables _srv = () end @@ -114,19 +114,19 @@ let global_tables = A.Container.{ t_na_services = Hashtbl.create 256 } -let add_naservice {A.Container.t_na_services} k f = +let add_naservice {A.Container.t_na_services; _} k f = Hashtbl.add t_na_services k f -let call_naservice {A.Container.t_na_services} k = +let call_naservice {A.Container.t_na_services; _} k = try (Hashtbl.find t_na_services k) true None with Not_found -> Lwt.fail Eliom_common.Eliom_404 let rec na_key_of_params ~get = function - | (k, v) :: l when k = Eliom_common.naservice_name -> + | (k, v) :: _l when k = Eliom_common.naservice_name -> Some (if get then Eliom_common.SNa_get_ v else Eliom_common.SNa_post_ v) - | (k, v) :: l when k = Eliom_common.naservice_num -> + | (k, v) :: _l when k = Eliom_common.naservice_num -> Some (if get then Eliom_common.SNa_get' v else Eliom_common.SNa_post' v) | _ :: l -> na_key_of_params ~get l @@ -142,7 +142,7 @@ let rec remove_site_dir p p' = | _ -> 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 diff --git a/src/lib/client/eliom_route_base.ml b/src/lib/client/eliom_route_base.ml new file mode 120000 index 0000000000..e94824dbcd --- /dev/null +++ b/src/lib/client/eliom_route_base.ml @@ -0,0 +1 @@ +../shared/eliom_route_base.ml \ No newline at end of file diff --git a/src/lib/eliom_service.client.ml b/src/lib/client/eliom_service.ml similarity index 90% rename from src/lib/eliom_service.client.ml rename to src/lib/client/eliom_service.ml index c83b810df3..2e819f0ec3 100644 --- a/src/lib/eliom_service.client.ml +++ b/src/lib/client/eliom_service.ml @@ -53,8 +53,10 @@ 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) @@ -63,8 +65,8 @@ let reload_fun : let reset_reload_fun service = service.reload_fun <- Rf_keep -let register_delayed_get_or_na_coservice ~sp s = +let register_delayed_get_or_na_coservice ~sp:_ _s = failwith "CSRF coservice not implemented client side for now" -let register_delayed_post_coservice ~sp s getname = +let register_delayed_post_coservice ~sp:_ _s _getname = failwith "CSRF coservice not implemented client side for now" diff --git a/src/lib/eliom_service.client.mli b/src/lib/client/eliom_service.mli similarity index 100% rename from src/lib/eliom_service.client.mli rename to src/lib/client/eliom_service.mli diff --git a/src/lib/client/eliom_service_sigs.mli b/src/lib/client/eliom_service_sigs.mli new file mode 120000 index 0000000000..e92688d810 --- /dev/null +++ b/src/lib/client/eliom_service_sigs.mli @@ -0,0 +1 @@ +../shared/eliom_service_sigs.mli \ No newline at end of file diff --git a/src/lib/eliom_shared.client.mli b/src/lib/client/eliom_shared.mli similarity index 100% rename from src/lib/eliom_shared.client.mli rename to src/lib/client/eliom_shared.mli diff --git a/src/lib/client/eliom_shared_sigs.mli b/src/lib/client/eliom_shared_sigs.mli new file mode 120000 index 0000000000..e073cdca27 --- /dev/null +++ b/src/lib/client/eliom_shared_sigs.mli @@ -0,0 +1 @@ +../shared/eliom_shared_sigs.mli \ No newline at end of file diff --git a/src/lib/eliom_types.client.ml b/src/lib/client/eliom_types.ml similarity index 100% rename from src/lib/eliom_types.client.ml rename to src/lib/client/eliom_types.ml diff --git a/src/lib/client/eliom_types_base.ml b/src/lib/client/eliom_types_base.ml new file mode 120000 index 0000000000..5fa16e6096 --- /dev/null +++ b/src/lib/client/eliom_types_base.ml @@ -0,0 +1 @@ +../shared/eliom_types_base.ml \ No newline at end of file diff --git a/src/lib/client/eliom_types_base.mli b/src/lib/client/eliom_types_base.mli new file mode 120000 index 0000000000..3ad05bdc91 --- /dev/null +++ b/src/lib/client/eliom_types_base.mli @@ -0,0 +1 @@ +../shared/eliom_types_base.mli \ No newline at end of file diff --git a/src/lib/client/eliom_uri.ml b/src/lib/client/eliom_uri.ml new file mode 120000 index 0000000000..5e190bb44f --- /dev/null +++ b/src/lib/client/eliom_uri.ml @@ -0,0 +1 @@ +../shared/eliom_uri.ml \ No newline at end of file diff --git a/src/lib/client/eliom_uri.mli b/src/lib/client/eliom_uri.mli new file mode 120000 index 0000000000..59abb18a68 --- /dev/null +++ b/src/lib/client/eliom_uri.mli @@ -0,0 +1 @@ +../shared/eliom_uri.mli \ No newline at end of file diff --git a/src/lib/client/eliommod_dom.ml b/src/lib/client/eliommod_dom.ml index 05d11bd39e..86696ff860 100644 --- a/src/lib/client/eliommod_dom.ml +++ b/src/lib/client/eliommod_dom.ml @@ -546,7 +546,7 @@ let rewrite_css_url ~prefix css pos = if pos < String.length css then match Regexp.search url_re css pos with | None -> Buffer.add_substring buf css pos (String.length css - pos) - | Some (i, res) -> + | Some (i, _res) -> Buffer.add_substring buf css pos (i - pos); try let i, href = parse_url ~prefix css i in @@ -575,7 +575,7 @@ let rec rewrite_css ~max (media, href, css) = if !Eliom_config.debug_timings then Firebug.console##(timeEnd (Js.string ("rewrite_CSS: "^href))); Lwt.return (imports @ [(media, css)]) - with e -> + with _e -> Lwt.return [(media, Printf.sprintf "@import url(%s);" href)] and rewrite_css_import ?(charset = "") ~max ~prefix ~media css pos = @@ -697,7 +697,7 @@ let _ = ignore (Dom.addEventListener Dom_html.document (Dom.Event.make "scroll") - (Dom_html.handler (fun event -> + (Dom_html.handler (fun _event -> current_position := createDocumentScroll (); Js._false)) Js._true : Dom_html.event_listener_id) diff --git a/src/lib/common/dune b/src/lib/common/dune new file mode 100644 index 0000000000..f2106e263f --- /dev/null +++ b/src/lib/common/dune @@ -0,0 +1,5 @@ +(library + (name common) + (public_name eliom.common) + (libraries lwt_log ocsigenserver) + (wrapped false)) \ No newline at end of file diff --git a/src/lib/common/eliom_lib_base.ml b/src/lib/common/eliom_lib_base.ml new file mode 120000 index 0000000000..e2cd37b961 --- /dev/null +++ b/src/lib/common/eliom_lib_base.ml @@ -0,0 +1 @@ +../shared/eliom_lib_base.ml \ No newline at end of file diff --git a/src/lib/common/eliom_lib_base.mli b/src/lib/common/eliom_lib_base.mli new file mode 120000 index 0000000000..508f7352b6 --- /dev/null +++ b/src/lib/common/eliom_lib_base.mli @@ -0,0 +1 @@ +../shared/eliom_lib_base.mli \ No newline at end of file diff --git a/src/lib/eliom_wrap.server.ml b/src/lib/common/eliom_wrap.ml similarity index 93% rename from src/lib/eliom_wrap.server.ml rename to src/lib/common/eliom_wrap.ml index 0796000601..9f788242fc 100644 --- a/src/lib/eliom_wrap.server.ml +++ b/src/lib/common/eliom_wrap.ml @@ -98,7 +98,7 @@ let none = Obj.repr 0 (* Unallocated entry in an array or in a hash-table *) module DynArray = struct type 'a t = 'a array ref - let rec check_size a i = + let rec check_size (a:'a t) i = let len = Array.length !a in if i > len then begin let old_a = !a in @@ -235,35 +235,8 @@ module Tbl = struct slight chance to perform an allocation; in which case, the table will no longer be up to date... *) let was_up_to_date tbl = tbl.gc = gc_count () - - let add_on_resize tbl f = tbl.on_resize <- f :: tbl.on_resize; end -(* Returns whether we should recursively scan the value or should - consider it as opaque. Also check for values that cannot be - serialized. *) -let can_scan v = - Obj.is_block v && - let tag = Obj.tag v in - if tag >= Obj.no_scan_tag then - false - else if - tag <= Obj.last_non_constant_constructor_tag || tag = Obj.forward_tag - then - true - else begin - if tag = Obj.lazy_tag then - failwith "lazy values must be forced before wrapping"; - if tag = Obj.object_tag then failwith "cannot wrap object values"; - if tag = Obj.closure_tag then failwith "cannot wrap functional values"; - if tag = Obj.infix_tag then - failwith "cannot wrap functional values: infix tag"; - (* Should not happen (in case a new kind of value is added) *) - failwith (Printf.sprintf "cannot wrap value (unexpected tag %d)" tag) - end - -type kind = Opaque | Scannable | Forward - let obj_kind v = if not (Obj.is_block v) then `Opaque diff --git a/src/lib/eliom_wrap.server.mli b/src/lib/common/eliom_wrap.mli similarity index 100% rename from src/lib/eliom_wrap.server.mli rename to src/lib/common/eliom_wrap.mli diff --git a/src/lib/eliom_client_main.eliom b/src/lib/eliom/eliom_client_main.eliom similarity index 100% rename from src/lib/eliom_client_main.eliom rename to src/lib/eliom/eliom_client_main.eliom diff --git a/src/lib/eliom_content.eliom b/src/lib/eliom/eliom_content.eliom similarity index 100% rename from src/lib/eliom_content.eliom rename to src/lib/eliom/eliom_content.eliom diff --git a/src/lib/eliom_cscache.eliom b/src/lib/eliom/eliom_cscache.eliom similarity index 100% rename from src/lib/eliom_cscache.eliom rename to src/lib/eliom/eliom_cscache.eliom diff --git a/src/lib/eliom_cscache.eliomi b/src/lib/eliom/eliom_cscache.eliomi similarity index 100% rename from src/lib/eliom_cscache.eliomi rename to src/lib/eliom/eliom_cscache.eliomi diff --git a/src/lib/eliom_form.eliom b/src/lib/eliom/eliom_form.eliom similarity index 99% rename from src/lib/eliom_form.eliom rename to src/lib/eliom/eliom_form.eliom index 2ea0674258..0809c3f36c 100644 --- a/src/lib/eliom_form.eliom +++ b/src/lib/eliom/eliom_form.eliom @@ -168,7 +168,7 @@ module Make_links (Html : Html) = struct Html.a_src uri :: (a :> Html_types.script_attrib attrib list) in - Html.script ~a (Html.pcdata "") + Html.script ~a (Html.txt "") end @@ -248,7 +248,7 @@ module Make (Html : Html) = struct let make_textarea ?(a = []) ~name ?(value = "") () = let a = a_name name :: (a :> Html_types.textarea_attrib attrib list) in - textarea ~a (pcdata value) + textarea ~a (txt value) let make_select ?(a = []) ~multiple ~name elt elts = let a = if multiple then a_multiple () :: a else a in @@ -327,7 +327,7 @@ module Make (Html : Html) = struct let get_form ?absolute ?absolute_path ?https ?a ~service ?hostname ?port - ?fragment ?keep_nl_params ?nl_params ?xhr f = + ?fragment ?keep_nl_params ?nl_params ?xhr:_ f = get_form_ (fun x f -> f x) (fun x -> x) ?absolute ?absolute_path @@ -375,7 +375,7 @@ module Make (Html : Html) = struct let post_form ?absolute ?absolute_path ?https ?a ~service ?hostname ?port - ?fragment ?keep_nl_params ?keep_get_na_params ?nl_params ?xhr + ?fragment ?keep_nl_params ?keep_get_na_params ?nl_params ?xhr:_ f getparams = post_form_ (fun x f -> f x) (fun x -> x) ?absolute ?absolute_path ?https ?a ~service ?hostname ?port @@ -531,7 +531,7 @@ module Make (Html : Html) = struct let make_opt (a, cv, co, sel) = (match co with | None -> - make_option ~a ~selected:sel (pcdata (string_of cv)) + make_option ~a ~selected:sel (txt (string_of cv)) | Some c -> make_option ~a ~selected:sel ~value:(string_of cv) c) in let make_optg = function diff --git a/src/lib/eliom_form.eliomi b/src/lib/eliom/eliom_form.eliomi similarity index 100% rename from src/lib/eliom_form.eliomi rename to src/lib/eliom/eliom_form.eliomi diff --git a/src/lib/eliom_service_base.eliom b/src/lib/eliom/eliom_service_base.eliom similarity index 97% rename from src/lib/eliom_service_base.eliom rename to src/lib/eliom/eliom_service_base.eliom index 2823c224e3..a2c8b159ca 100644 --- a/src/lib/eliom_service_base.eliom +++ b/src/lib/eliom/eliom_service_base.eliom @@ -170,7 +170,7 @@ let pre_wrap s = { 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 @@ -191,11 +191,11 @@ let priority s = s.priority let internal_set_client_fun ~service f = service.client_fun <- Some [%client 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 @@ -288,7 +288,7 @@ type clvpreapp = { } let preapply_client_fun = { - clvpreapp_f = fun f getparams -> failwith "preapply_client_fun" + clvpreapp_f = fun _f _getparams -> failwith "preapply_client_fun" } (* will be initialized later (in Eliom_content for now), when client @@ -299,7 +299,7 @@ let rec append_suffix l m = match l with | [] -> m - | [eliom_suffix_internal_name] -> + | [_eliom_suffix_internal_name] -> m | a :: ll -> a :: append_suffix ll m @@ -328,7 +328,7 @@ let preapply ~service getparams = | Some suff -> append_suffix k.fullpath suff | _ -> k.fullpath); }; - | k -> k); + | _ -> .); client_fun = Some [%client ref @@ -444,16 +444,16 @@ let default_csrf_scope = function exception Unreachable_exn let attached_info = function - | {info = Attached k} -> + | {info = Attached k; _} -> k | _ -> - failwith "attached_info" + . let non_attached_info = function - | {info = Nonattached k} -> + | {info = Nonattached k; _} -> k | _ -> - failwith "non_attached_info" + . (** Create a main service (not a coservice), internal or external *) let main_service @@ -521,7 +521,7 @@ let extern ~reload_fun:Rf_keep () -let which_meth {meth} = meth +let which_meth {meth; _} = meth let which_meth_untyped (type m) (s : (_, _, m, _, _, _, _, _, _, _, _) t) = diff --git a/src/lib/eliom_shared.eliom b/src/lib/eliom/eliom_shared.eliom similarity index 96% rename from src/lib/eliom_shared.eliom rename to src/lib/eliom/eliom_shared.eliom index 98aba9df1f..e44b4a6a9d 100644 --- a/src/lib/eliom_shared.eliom +++ b/src/lib/eliom/eliom_shared.eliom @@ -51,7 +51,7 @@ module Value = struct sh_mark : 'a t Eliom_wrap.wrapper } - 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 @@ -62,9 +62,9 @@ module Value = struct sh_mark = shared_value_mark () } - let client {sh_client} = sh_client + let client {sh_client; _} = sh_client - let local {sh_server} = sh_server + let local {sh_server; _} = sh_server end ] @@ -72,8 +72,12 @@ end [%%client module React = struct + [@@@ocaml.warning "-34"] + type step = React.step + [@@@ocaml.warning "+34"] + module S = struct include React.S @@ -161,7 +165,7 @@ module ReactiveData = struct let new_waiter = Lwt.wait () in waiter := new_waiter; let%lwt new_msg = map_msg_p_lwt f msg in - let%lwt rr, rhandle = r_th in + let%lwt _rr, rhandle = r_th in let%lwt () = fst waiter1 in (match new_msg with | ReactiveData.RList.Set s -> @@ -198,7 +202,7 @@ module ReactiveData = struct Lwt.return (ReactiveData.RList.create r) in let effectul_event = map_p_aux r_th f l in - let%lwt rr, rhandle = r_th in + let%lwt rr, _rhandle = r_th in (* We keep a reference to the effectul_event in the resulting reactive list in order that the effectul_event is garbage collected only if the resulting list is garbage @@ -272,26 +276,26 @@ module FakeReact = struct type 'a t = 'a * bool let create ?synced:(synced = false) x = ((x, synced), - fun ?step _ -> + fun ?step:_ _ -> failwith "Fact react values cannot be changed on server side") let value (x, _) = x let const ?synced:(synced = false) x = (x, synced) let synced (_, b) = b - let map ?eq (f : 'a -> 'b) ((x, b) : 'a t) : 'b t = f x, b - let fmap ?eq f i (s, b) = + let map ?eq:_ (f : 'a -> 'b) ((x, b) : 'a t) : 'b t = f x, b + let fmap ?eq:_ f i (s, b) = (match f s with Some v -> v | None -> i), b - let merge ?eq f acc l = + let merge ?eq:_ f acc l = let f (acc, acc_b) (x, b) = f acc x, acc_b && b in List.fold_left f (acc, true) l - let l2 ?eq f (x1, b1) (x2, b2) = + let l2 ?eq:_ f (x1, b1) (x2, b2) = f x1 x2, b1 && b2 - let l3 ?eq f (x1, b1) (x2, b2) (x3, b3) = + let l3 ?eq:_ f (x1, b1) (x2, b2) (x3, b3) = f x1 x2 x3, b1 && b2 && b3 - let l4 ?eq f (x1, b1) (x2, b2) (x3, b3) (x4, b4) = + let l4 ?eq:_ f (x1, b1) (x2, b2) (x3, b3) (x4, b4) = f x1 x2 x3 x4, b1 && b2 && b3 && b4 - let l5 ?eq f (x1, b1) (x2, b2) (x3, b3) (x4, b4) (x5, b5) = + let l5 ?eq:_ f (x1, b1) (x2, b2) (x3, b3) (x4, b4) (x5, b5) = f x1 x2 x3 x4 x5, b1 && b2 && b3 && b4 && b5 - let l6 ?eq f (x1, b1) (x2, b2) (x3, b3) (x4, b4) (x5, b5) (x6, b6) = + let l6 ?eq:_ f (x1, b1) (x2, b2) (x3, b3) (x4, b4) (x5, b5) (x6, b6) = f x1 x2 x3 x4 x5 x6, b1 && b2 && b3 && b4 && b5 && b6 end end @@ -318,9 +322,9 @@ module FakeReactiveData = struct let singleton_s s = [FakeReact.S.value s], FakeReact.S.synced s let value (l, _) = l let synced (_, b) = b - let signal ?eq (l, synced) = fst (FakeReact.S.create ~synced l) + let signal ?eq:_ (l, synced) = fst (FakeReact.S.create ~synced l) let map f (l, b) = List.map f l, b - let from_signal ?eq s = FakeReact.S.(value s, synced s) + let from_signal ?eq:_ s = FakeReact.S.(value s, synced s) end end ] @@ -585,7 +589,7 @@ module React = struct let merge_s ?eq (f : ('a -> 'b -> 'a Lwt.t) Value.t) (acc : 'a) (l : 'b t list) : 'a t Lwt.t = let%lwt server_result, synced = - let f (acc, acc_b) v = + let f (acc, _acc_b) v = let v = Value.local v and f = Value.local f in let%lwt acc = f acc (FakeReact.S.value v) in let acc_b = FakeReact.S.synced v in diff --git a/src/lib/eliom_shared_content.eliom b/src/lib/eliom/eliom_shared_content.eliom similarity index 99% rename from src/lib/eliom_shared_content.eliom rename to src/lib/eliom/eliom_shared_content.eliom index a1d53820c6..aab10d9351 100644 --- a/src/lib/eliom_shared_content.eliom +++ b/src/lib/eliom/eliom_shared_content.eliom @@ -435,7 +435,7 @@ module Html = struct include Eliom_content_core.Html.Make(Xml)(Wrapped_functions)(Svg.R) - let pcdata x = pcdata x |> Unsafe.coerce_elt + let pcdata x = txt x |> Unsafe.coerce_elt end diff --git a/src/lib/eliom_shared_content.eliomi b/src/lib/eliom/eliom_shared_content.eliomi similarity index 100% rename from src/lib/eliom_shared_content.eliomi rename to src/lib/eliom/eliom_shared_content.eliomi diff --git a/src/lib/eliom_tools.eliom b/src/lib/eliom/eliom_tools.eliom similarity index 100% rename from src/lib/eliom_tools.eliom rename to src/lib/eliom/eliom_tools.eliom diff --git a/src/lib/eliom_tools.eliomi b/src/lib/eliom/eliom_tools.eliomi similarity index 100% rename from src/lib/eliom_tools.eliomi rename to src/lib/eliom/eliom_tools.eliomi diff --git a/src/lib/eliom_wrap.client.mli b/src/lib/eliom_wrap.client.mli deleted file mode 100644 index 61e19572c7..0000000000 --- a/src/lib/eliom_wrap.client.mli +++ /dev/null @@ -1,7 +0,0 @@ - -type poly -type 'a wrapped_value = poly * 'a - -(**/**) - -type unwrapper diff --git a/src/lib/server/common/dune b/src/lib/server/common/dune new file mode 100644 index 0000000000..ffc628d0c6 --- /dev/null +++ b/src/lib/server/common/dune @@ -0,0 +1,7 @@ +(library + (name internalserver) + (wrapped false) + (public_name eliom.server.common) + (libraries eliom.common js_of_ocaml ocsigenserver ocsigenserver.ext react) + (preprocess + (pps js_of_ocaml-ppx_deriving_json lwt_ppx))) diff --git a/src/lib/eliom_client_value.server.ml b/src/lib/server/common/eliom_client_value.ml similarity index 100% rename from src/lib/eliom_client_value.server.ml rename to src/lib/server/common/eliom_client_value.ml diff --git a/src/lib/eliom_client_value.server.mli b/src/lib/server/common/eliom_client_value.mli similarity index 100% rename from src/lib/eliom_client_value.server.mli rename to src/lib/server/common/eliom_client_value.mli diff --git a/src/lib/eliom_common.server.ml b/src/lib/server/common/eliom_common.ml similarity index 99% rename from src/lib/eliom_common.server.ml rename to src/lib/server/common/eliom_common.ml index d60e4e708f..692c860f68 100644 --- a/src/lib/eliom_common.server.ml +++ b/src/lib/server/common/eliom_common.ml @@ -523,7 +523,7 @@ let make_full_state_name2 site_dir_string) 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 @@ -794,7 +794,7 @@ let empty_tables max forsession = then let dlist = Ocsigen_cache.Dlist.create max in Ocsigen_cache.Dlist.set_finaliser_before (dlist_finaliser t2) dlist; - fun ?sp v -> add_dlist_ dlist v + fun ?sp:_ v -> add_dlist_ dlist v else fun ?sp v -> let ip, max, sitedata = @@ -846,7 +846,7 @@ sessionkind|S?|sitedirstring|"ref" ou "comet" ou ""|hiername *) let full_state_name_of_cookie_name cookie_level cookiename = - let pref, cookiename = Ocsigen_lib.String.sep '|' cookiename in + let _pref, cookiename = Ocsigen_lib.String.sep '|' cookiename in let secure, cookiename = Ocsigen_lib.String.sep '|' cookiename in let sitedirstring, cookiename = Ocsigen_lib.String.sep '|' cookiename in let hier1, hiername = Ocsigen_lib.String.sep '|' cookiename in @@ -887,6 +887,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 () +[@@@ocaml.warning "-39-32"] + type cpi = client_process_info = { cpi_ssl : bool; cpi_hostname : string; @@ -894,6 +896,8 @@ type cpi = client_process_info = { cpi_original_full_path : string list; } [@@deriving json] +[@@@ocaml.warning "+39+32"] + let get_session_info req previous_extension_err = let req_whole = req and ri = req.Ocsigen_extensions.request_info @@ -1359,19 +1363,19 @@ module To_and_of_shared = struct let wrapper : wrapper = Obj.magic @@ Eliom_wrap.create_wrapper @@ function - | {client = Some tao} -> + | {client = Some tao; _} -> tao - | {client = None} -> + | {client = None; _} -> failwith "Cannot wrap user type parameter.\n\ Use the ?client_to_and_of parameter of Eliom_parameter.user_type\n\ or (Eliom_parameter.all_suffix_user)" - let to_string {server = {to_string}} = to_string + let to_string {server = {to_string; _}; _} = to_string - let of_string {server = {of_string}} = of_string + let of_string {server = {of_string; _}; _} = of_string - let to_and_of {server} = server + let to_and_of {server; _} = server let create ?client_to_and_of server = { server ; diff --git a/src/lib/eliom_common.server.mli b/src/lib/server/common/eliom_common.mli similarity index 100% rename from src/lib/eliom_common.server.mli rename to src/lib/server/common/eliom_common.mli diff --git a/src/lib/server/common/eliom_common_base.ml b/src/lib/server/common/eliom_common_base.ml new file mode 120000 index 0000000000..9e7b831fcc --- /dev/null +++ b/src/lib/server/common/eliom_common_base.ml @@ -0,0 +1 @@ +../../shared/eliom_common_base.ml \ No newline at end of file diff --git a/src/lib/eliom_lazy.server.ml b/src/lib/server/common/eliom_lazy.ml similarity index 100% rename from src/lib/eliom_lazy.server.ml rename to src/lib/server/common/eliom_lazy.ml diff --git a/src/lib/eliom_lazy.server.mli b/src/lib/server/common/eliom_lazy.mli similarity index 100% rename from src/lib/eliom_lazy.server.mli rename to src/lib/server/common/eliom_lazy.mli diff --git a/src/lib/eliom_lib.server.ml b/src/lib/server/common/eliom_lib.ml similarity index 100% rename from src/lib/eliom_lib.server.ml rename to src/lib/server/common/eliom_lib.ml diff --git a/src/lib/eliom_lib.server.mli b/src/lib/server/common/eliom_lib.mli similarity index 100% rename from src/lib/eliom_lib.server.mli rename to src/lib/server/common/eliom_lib.mli diff --git a/src/lib/eliom_request_info.server.ml b/src/lib/server/common/eliom_request_info.ml similarity index 100% rename from src/lib/eliom_request_info.server.ml rename to src/lib/server/common/eliom_request_info.ml diff --git a/src/lib/eliom_request_info.server.mli b/src/lib/server/common/eliom_request_info.mli similarity index 100% rename from src/lib/eliom_request_info.server.mli rename to src/lib/server/common/eliom_request_info.mli diff --git a/src/lib/server/common/eliom_runtime.ml b/src/lib/server/common/eliom_runtime.ml new file mode 120000 index 0000000000..6d80d46c3a --- /dev/null +++ b/src/lib/server/common/eliom_runtime.ml @@ -0,0 +1 @@ +../../shared/eliom_runtime.ml \ No newline at end of file diff --git a/src/lib/server/common/eliom_runtime.mli b/src/lib/server/common/eliom_runtime.mli new file mode 120000 index 0000000000..8f3cee3f4d --- /dev/null +++ b/src/lib/server/common/eliom_runtime.mli @@ -0,0 +1 @@ +../../shared/eliom_runtime.mli \ No newline at end of file diff --git a/src/lib/server/dune b/src/lib/server/dune new file mode 100644 index 0000000000..8e2c97c85d --- /dev/null +++ b/src/lib/server/dune @@ -0,0 +1,101 @@ +(library + (name server) + (public_name eliom.server) + (wrapped false) + (libraries + eliom.common + eliom.server.common + ipaddr + lwt + lwt_log + lwt_react + netstring-pcre + ocsigenserver + ocsigenserver.cookies + ocsigenserver.ext + react + tyxml) + (preprocess + (pps + lwt_ppx + js_of_ocaml-ppx + js_of_ocaml-ppx_deriving_json)) + (modules_without_implementation + eliom_content_sigs + eliom_form_sigs + eliom_parameter_sigs + eliom_registration_sigs + eliom_service_sigs + eliom_shared_sigs)) + +(rule + (targets eliom_content.ml) + (deps ../eliom/eliom_content.eliom) + (action + (with-stdout-to + %{targets} + (run %{bin:ppxfind} -legacy ppx_eliom.ppx.server --impl %{deps})))) + +(rule + (targets eliom_cscache.ml) + (deps ../eliom/eliom_cscache.eliom) + (action + (with-stdout-to + %{targets} + (run %{bin:ppxfind} -legacy ppx_eliom.ppx.server --impl %{deps})))) + +(rule + (targets eliom_cscache.mli) + (deps ../eliom/eliom_cscache.eliomi) + (action + (with-stdout-to + %{targets} + (run %{bin:ppxfind} -legacy ppx_eliom.ppx.server --intf %{deps})))) + +(rule + (targets eliom_form.ml) + (deps ../eliom/eliom_form.eliom) + (action + (with-stdout-to + %{targets} + (run %{bin:ppxfind} -legacy ppx_eliom.ppx.server --impl %{deps})))) + +(rule + (targets eliom_form.mli) + (deps ../eliom/eliom_form.eliomi) + (action + (with-stdout-to + %{targets} + (run %{bin:ppxfind} -legacy ppx_eliom.ppx.server --intf %{deps})))) + +(rule + (targets eliom_service_base.ml) + (deps ../eliom/eliom_service_base.eliom) + (action + (with-stdout-to + %{targets} + (run %{bin:ppxfind} -legacy ppx_eliom.ppx.server --impl %{deps})))) + +(rule + (targets eliom_shared.ml) + (deps ../eliom/eliom_shared.eliom) + (action + (with-stdout-to + %{targets} + (run %{bin:ppxfind} -legacy ppx_eliom.ppx.server --impl %{deps})))) + +(rule + (targets eliom_shared_content.ml) + (deps ../eliom/eliom_shared_content.eliom) + (action + (with-stdout-to + %{targets} + (run %{bin:ppxfind} -legacy ppx_eliom.ppx.server --impl %{deps})))) + +(rule + (targets eliom_tools.ml) + (deps ../eliom/eliom_tools.eliom) + (action + (with-stdout-to + %{targets} + (run %{bin:ppxfind} -legacy ppx_eliom.ppx.server --impl %{deps})))) diff --git a/src/lib/eliom_bus.server.ml b/src/lib/server/eliom_bus.ml similarity index 98% rename from src/lib/eliom_bus.server.ml rename to src/lib/server/eliom_bus.ml index eadff36b7f..71b2d6a61f 100644 --- a/src/lib/eliom_bus.server.ml +++ b/src/lib/server/eliom_bus.ml @@ -56,7 +56,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 :> (_, _ list, _, _, _, Eliom_service.non_ext, _, _, _, _, _) diff --git a/src/lib/eliom_bus.server.mli b/src/lib/server/eliom_bus.mli similarity index 100% rename from src/lib/eliom_bus.server.mli rename to src/lib/server/eliom_bus.mli diff --git a/src/lib/eliom_client.server.ml b/src/lib/server/eliom_client.ml similarity index 100% rename from src/lib/eliom_client.server.ml rename to src/lib/server/eliom_client.ml diff --git a/src/lib/eliom_client.server.mli b/src/lib/server/eliom_client.mli similarity index 100% rename from src/lib/eliom_client.server.mli rename to src/lib/server/eliom_client.mli diff --git a/src/lib/server/eliom_client_base.ml b/src/lib/server/eliom_client_base.ml new file mode 120000 index 0000000000..facae97b2f --- /dev/null +++ b/src/lib/server/eliom_client_base.ml @@ -0,0 +1 @@ +../shared/eliom_client_base.ml \ No newline at end of file diff --git a/src/lib/eliom_comet.server.ml b/src/lib/server/eliom_comet.ml similarity index 98% rename from src/lib/eliom_comet.server.ml rename to src/lib/server/eliom_comet.ml index f184c95493..c05d323533 100644 --- a/src/lib/eliom_comet.server.ml +++ b/src/lib/server/eliom_comet.ml @@ -150,6 +150,7 @@ struct match Weak.get channel 0 with | None -> [%lwt raise ( Not_found)] + [@warning "-22"] (* terminates the loop: remove reference on the stream, etc ... *) | Some channel -> channel.ch_index <- succ channel.ch_index; @@ -231,17 +232,17 @@ struct | Eliom_lib.Left (channel, position) -> match position with | Eliom_comet_base.Newest i when i > channel.ch_index -> false - | Eliom_comet_base.Newest i -> true + | Eliom_comet_base.Newest _i -> true | Eliom_comet_base.After i when i > channel.ch_index -> false - | Eliom_comet_base.After i -> true - | Eliom_comet_base.Last n when (Dlist.size channel.ch_content) > 0 -> true - | Eliom_comet_base.Last n -> false + | Eliom_comet_base.After _i -> true + | Eliom_comet_base.Last _n when (Dlist.size channel.ch_content) > 0 -> true + | Eliom_comet_base.Last _n -> false let really_wait_data requests = let rec make_list = function | [] -> [] | (Eliom_lib.Left (channel,_))::q -> (Lwt_condition.wait channel.ch_wakeup)::(make_list q) - | Eliom_lib.Right _ :: q -> + | Eliom_lib.Right _ :: _q -> assert false (* closed channels are considered to have data *) in Lwt.pick (make_list requests) @@ -283,9 +284,9 @@ struct Eliom_comet_base.Comet_service (Eliom_common.force_lazy_site_value global_service) - 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) @@ -493,6 +494,7 @@ end = struct let ri = Eliom_request_info.get_ri () in let%lwt () = Ocsigen_extensions.Ocsigen_request_info.connection_closed ri in [%lwt raise ( Connection_closed)] + [@ocaml.warning "-22"] (* register the service handler.hd_service *) let run_handler handler = @@ -548,7 +550,7 @@ end = struct Lwt.return (encode_downgoing []) in let - {hd_service = Eliom_comet_base.Internal_comet_service service} = + {hd_service = Eliom_comet_base.Internal_comet_service service; _} = handler in Comet.register ~scope:handler.hd_scope ~service f @@ -667,11 +669,11 @@ end = struct ch_stream = stream; ch_id = name; } - let get_id {ch_id} = + let get_id {ch_id;_} = ch_id - let get_service {ch_handler} = - let {hd_service = Ecb.Internal_comet_service srv} = ch_handler in + let get_service {ch_handler;_} = + let {hd_service = Ecb.Internal_comet_service srv; _} = ch_handler in Ecb.Comet_service srv end @@ -818,7 +820,7 @@ end = struct let create ?scope ?name ?(size=1000) stream = match scope with | None -> create_stateful ?name ~size stream - | Some ((`Client_process n) as scope) -> create_stateful ~scope ?name ~size stream + | Some ((`Client_process _n) as scope) -> create_stateful ~scope ?name ~size stream | Some `Site -> create_stateless ?name ~size stream let external_channel ?(history=1) ?(newest=false) ~prefix ~name () = diff --git a/src/lib/eliom_comet.server.mli b/src/lib/server/eliom_comet.mli similarity index 100% rename from src/lib/eliom_comet.server.mli rename to src/lib/server/eliom_comet.mli diff --git a/src/lib/server/eliom_comet_base.ml b/src/lib/server/eliom_comet_base.ml new file mode 120000 index 0000000000..0fae8e0136 --- /dev/null +++ b/src/lib/server/eliom_comet_base.ml @@ -0,0 +1 @@ +../shared/eliom_comet_base.ml \ No newline at end of file diff --git a/src/lib/server/eliom_comet_base.mli b/src/lib/server/eliom_comet_base.mli new file mode 120000 index 0000000000..7c7653ca52 --- /dev/null +++ b/src/lib/server/eliom_comet_base.mli @@ -0,0 +1 @@ +../shared/eliom_comet_base.mli \ No newline at end of file diff --git a/src/lib/eliom_config.server.ml b/src/lib/server/eliom_config.ml similarity index 98% rename from src/lib/eliom_config.server.ml rename to src/lib/server/eliom_config.ml index 8d8e31d019..2c65c845b5 100644 --- a/src/lib/eliom_config.server.ml +++ b/src/lib/server/eliom_config.ml @@ -38,7 +38,7 @@ let get_default_links_xhr () = let sitedata = Eliom_request_info.find_sitedata "get_default_links_xhr" in sitedata.Eliom_common.default_links_xhr#get -let set_default_links_xhr ?override_configfile v = +let set_default_links_xhr ?override_configfile:_ v = let sitedata = Eliom_request_info.find_sitedata "set_default_links_xhr" in sitedata.Eliom_common.default_links_xhr#set v diff --git a/src/lib/eliom_config.server.mli b/src/lib/server/eliom_config.mli similarity index 100% rename from src/lib/eliom_config.server.mli rename to src/lib/server/eliom_config.mli diff --git a/src/lib/eliom_content.server.mli b/src/lib/server/eliom_content.mli similarity index 100% rename from src/lib/eliom_content.server.mli rename to src/lib/server/eliom_content.mli diff --git a/src/lib/eliom_content_.server.ml b/src/lib/server/eliom_content_.ml similarity index 100% rename from src/lib/eliom_content_.server.ml rename to src/lib/server/eliom_content_.ml diff --git a/src/lib/eliom_content_core.server.ml b/src/lib/server/eliom_content_core.ml similarity index 98% rename from src/lib/eliom_content_core.server.ml rename to src/lib/server/eliom_content_core.ml index e48250eca1..a1751e6873 100644 --- a/src/lib/eliom_content_core.server.ml +++ b/src/lib/server/eliom_content_core.ml @@ -56,7 +56,7 @@ module Xml = struct wrapper_mark : elt Eliom_wrap.wrapper } - let content { elt } = match elt.recontent with + let content { elt; _ } = match elt.recontent with | RE e -> e | RELazy e -> Eliom_lazy.force e @@ -64,14 +64,14 @@ module Xml = struct let node_ids_in_content = ref Node_id_set.empty let wrapper_mark = Eliom_wrap.create_wrapper - (fun { elt } -> + (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 @@ -85,7 +85,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 @@ -242,7 +242,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 diff --git a/src/lib/eliom_content_core.server.mli b/src/lib/server/eliom_content_core.mli similarity index 100% rename from src/lib/eliom_content_core.server.mli rename to src/lib/server/eliom_content_core.mli diff --git a/src/lib/server/eliom_content_sigs.mli b/src/lib/server/eliom_content_sigs.mli new file mode 120000 index 0000000000..2296d13813 --- /dev/null +++ b/src/lib/server/eliom_content_sigs.mli @@ -0,0 +1 @@ +../shared/eliom_content_sigs.mli \ No newline at end of file diff --git a/src/lib/eliom_cookie.server.ml b/src/lib/server/eliom_cookie.ml similarity index 100% rename from src/lib/eliom_cookie.server.ml rename to src/lib/server/eliom_cookie.ml diff --git a/src/lib/eliom_cookie.server.mli b/src/lib/server/eliom_cookie.mli similarity index 100% rename from src/lib/eliom_cookie.server.mli rename to src/lib/server/eliom_cookie.mli diff --git a/src/lib/server/eliom_cookies_base.ml b/src/lib/server/eliom_cookies_base.ml new file mode 120000 index 0000000000..f8f958fb69 --- /dev/null +++ b/src/lib/server/eliom_cookies_base.ml @@ -0,0 +1 @@ +../shared/eliom_cookies_base.ml \ No newline at end of file diff --git a/src/lib/eliom_error_pages.server.ml b/src/lib/server/eliom_error_pages.ml similarity index 52% rename from src/lib/eliom_error_pages.server.ml rename to src/lib/server/eliom_error_pages.ml index 31c1f677d1..1380319eaa 100644 --- a/src/lib/eliom_error_pages.server.ml +++ b/src/lib/server/eliom_error_pages.ml @@ -22,15 +22,15 @@ open Html.F let page_error_param_type l = let s = match l with - [] -> [pcdata "Wrong type for parameter"] - | [(n,_)] -> [pcdata "Wrong type for parameter ";em [pcdata n];pcdata "."] + [] -> [txt "Wrong type for parameter"] + | [(n,_)] -> [txt "Wrong type for parameter ";em [txt n];txt "."] | (n,_)::ll -> - (pcdata "Wrong type for parameters "):: - (List.fold_left (fun deb (n,_) -> (em [pcdata n])::(pcdata ", ")::deb) - [em [pcdata n];pcdata "."] ll) + (txt "Wrong type for parameters "):: + (List.fold_left (fun deb (n,_) -> (em [txt n])::(txt ", ")::deb) + [em [txt n];txt "."] ll) in html - (head (title (pcdata "")) []) + (head (title (txt "")) []) (body [h1 s] ) @@ -38,36 +38,36 @@ let page_error_param_type l = let page_bad_param after_action gl pl = let s = "Wrong parameters" in html - (head (title (pcdata s)) []) + (head (title (txt s)) []) (body - ((h1 [pcdata s]):: + ((h1 [txt s]):: (if Ocsigen_config.get_debugmode () then - [h2 [pcdata "Debugging information:"]; + [h2 [txt "Debugging information:"]; (if after_action then - (p [pcdata "An action occurred successfully. But Eliom was unable to find the service for displaying the page."]) + (p [txt "An action occurred successfully. But Eliom was unable to find the service for displaying the page."]) else - (p [pcdata "Eliom was unable to find a service matching these parameters."])); + (p [txt "Eliom was unable to find a service matching these parameters."])); (match gl with - | [] -> p [pcdata "No GET parameters have been given to services."] + | [] -> p [txt "No GET parameters have been given to services."] | (n, a)::l -> - p ((pcdata "GET parameters given to services: "):: + p ((txt "GET parameters given to services: "):: [em - ((pcdata n)::(pcdata "=")::(pcdata a):: + ((txt n)::(txt "=")::(txt a):: (List.fold_right (fun (n, a) b -> - (pcdata "&"):: - (pcdata n)::(pcdata "=")::(pcdata a)::b) - l [pcdata "."]))])); + (txt "&"):: + (txt n)::(txt "=")::(txt a)::b) + l [txt "."]))])); (match pl with - | [] -> p [pcdata "No POST parameters have been given to services."] + | [] -> p [txt "No POST parameters have been given to services."] | a::l -> - p ((pcdata "Names of POST parameters given to services: "):: - (em [pcdata a]):: + p ((txt "Names of POST parameters given to services: "):: + (em [txt a]):: (List.fold_right - (fun n b -> (pcdata ", ")::(em [pcdata n])::b) - l [pcdata "."])))] + (fun n b -> (txt ", ")::(em [txt n])::b) + l [txt "."])))] else []) ) ) @@ -75,7 +75,7 @@ let page_bad_param after_action gl pl = let page_session_expired = let s = "Session expired" in html - (head (title (pcdata s)) []) + (head (title (txt s)) []) (body - [h1 [pcdata s]] + [h1 [txt s]] ) diff --git a/src/lib/eliom_extension.server.ml b/src/lib/server/eliom_extension.ml similarity index 95% rename from src/lib/eliom_extension.server.ml rename to src/lib/server/eliom_extension.ml index e885c6ab5f..31cedadde6 100644 --- a/src/lib/eliom_extension.server.ml +++ b/src/lib/server/eliom_extension.ml @@ -35,6 +35,6 @@ let register_eliom_extension f = let get_eliom_extension () = !module_action -let run_eliom_extension (fext : eliom_extension_sig) now info sitedata = +let run_eliom_extension (fext : eliom_extension_sig) _now info sitedata = let sp = Eliom_common.make_server_params sitedata info None None in Lwt.with_value Eliom_common.sp_key (Some sp) fext diff --git a/src/lib/eliom_extension.server.mli b/src/lib/server/eliom_extension.mli similarity index 100% rename from src/lib/eliom_extension.server.mli rename to src/lib/server/eliom_extension.mli diff --git a/src/lib/eliom_extension_template.server.ml b/src/lib/server/eliom_extension_template.ml similarity index 99% rename from src/lib/eliom_extension_template.server.ml rename to src/lib/server/eliom_extension_template.ml index ca4991dafc..2c9c3870bb 100644 --- a/src/lib/eliom_extension_template.server.ml +++ b/src/lib/server/eliom_extension_template.ml @@ -27,7 +27,7 @@ let _ = Eliom_extension.register_eliom_extension - (fun sp -> + (fun _sp -> Lwt.return (Ocsigen_extensions.Ext_found (fun () -> diff --git a/src/lib/server/eliom_form_sigs.mli b/src/lib/server/eliom_form_sigs.mli new file mode 120000 index 0000000000..ff33d4f763 --- /dev/null +++ b/src/lib/server/eliom_form_sigs.mli @@ -0,0 +1 @@ +../shared/eliom_form_sigs.mli \ No newline at end of file diff --git a/src/lib/eliom_mkreg.server.ml b/src/lib/server/eliom_mkreg.ml similarity index 99% rename from src/lib/eliom_mkreg.server.ml rename to src/lib/server/eliom_mkreg.ml index 499a8381c9..40ee4838a3 100644 --- a/src/lib/eliom_mkreg.server.ml +++ b/src/lib/server/eliom_mkreg.ml @@ -120,6 +120,7 @@ let check_process_redir sp f param = (Lazy.force (Ocsigen_extensions.Ocsigen_request_info.get_params ri)) ))))] + [@ocaml.warning "-22"] (* We do not put hostname and port. It is ok with half or full xhr redirections. *) (* If an action occured before, @@ -205,7 +206,7 @@ let register_aux pages | None -> None | Some t -> Some (t, ref (t +. Unix.time ())) in - let f table ((attserget, attserpost) as attsernames) = + let f table attsernames = Eliom_route.add_service priority table @@ -518,7 +519,7 @@ let send pages Lwt.return (pages.result_of_http_result result) let register pages - ?app + ?app:_ ?scope ?options ?charset @@ -556,8 +557,8 @@ let register pages | _ -> raise (Eliom_common.Eliom_site_information_not_available "register")) - | None, Some sp - | Some `Site, Some sp -> + | None, Some _sp + | Some `Site, Some _sp -> register_aux pages ?options ?charset diff --git a/src/lib/eliom_mkreg.server.mli b/src/lib/server/eliom_mkreg.mli similarity index 100% rename from src/lib/eliom_mkreg.server.mli rename to src/lib/server/eliom_mkreg.mli diff --git a/src/lib/eliom_notif.server.ml b/src/lib/server/eliom_notif.ml similarity index 99% rename from src/lib/eliom_notif.server.ml rename to src/lib/server/eliom_notif.ml index 978615a815..2a9263c88b 100644 --- a/src/lib/eliom_notif.server.ml +++ b/src/lib/server/eliom_notif.ml @@ -174,7 +174,7 @@ module Make (A : ARG) : S I.remove identity id module Ext = struct - let unlisten ?sitedata state (key : A.key) = + let unlisten ?sitedata:_ state (key : A.key) = let uc = Eliom_reference.Volatile.Ext.get state identity_r in I.remove uc key end diff --git a/src/lib/eliom_notif.server.mli b/src/lib/server/eliom_notif.mli similarity index 100% rename from src/lib/eliom_notif.server.mli rename to src/lib/server/eliom_notif.mli diff --git a/src/lib/eliom_parameter.server.ml b/src/lib/server/eliom_parameter.ml similarity index 97% rename from src/lib/eliom_parameter.server.ml rename to src/lib/server/eliom_parameter.ml index 315b6497fc..f172d66ca8 100644 --- a/src/lib/eliom_parameter.server.ml +++ b/src/lib/server/eliom_parameter.ml @@ -57,7 +57,7 @@ let all_suffix_user let regexp reg dest ~to_string n = user_type - (fun s -> + ~of_string:(fun s -> match Netstring_pcre.string_match reg s 0 with | Some _ -> begin @@ -68,13 +68,13 @@ let regexp reg dest ~to_string n = raise (Failure "User does not exist") end | _ -> raise (Failure "Regexp not matching")) - to_string + ~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 Netstring_pcre.string_match reg s 0 with | Some _ -> begin @@ -85,7 +85,7 @@ let all_suffix_regexp reg dest ~(to_string : 'a -> string) (n : string) : raise (Failure "User does not exist") end | _ -> raise (Failure "Regexp not matching")) - to_string + ~to_string n (* Non localized parameters *) @@ -94,7 +94,8 @@ let get_non_localized_parameters params files ~getorpost ~sp {name; get; post; - param = paramtype} = + param = paramtype; + _} = (* non localized parameters are parsed only once, and cached in request_cache *) let key = match getorpost with `Get -> get | `Post -> post in diff --git a/src/lib/eliom_parameter.server.mli b/src/lib/server/eliom_parameter.mli similarity index 100% rename from src/lib/eliom_parameter.server.mli rename to src/lib/server/eliom_parameter.mli diff --git a/src/lib/server/eliom_parameter_base.ml b/src/lib/server/eliom_parameter_base.ml new file mode 120000 index 0000000000..e58afb653c --- /dev/null +++ b/src/lib/server/eliom_parameter_base.ml @@ -0,0 +1 @@ +../shared/eliom_parameter_base.ml \ No newline at end of file diff --git a/src/lib/server/eliom_parameter_sigs.mli b/src/lib/server/eliom_parameter_sigs.mli new file mode 120000 index 0000000000..4208352c3b --- /dev/null +++ b/src/lib/server/eliom_parameter_sigs.mli @@ -0,0 +1 @@ +../shared/eliom_parameter_sigs.mli \ No newline at end of file diff --git a/src/lib/eliom_process.server.ml b/src/lib/server/eliom_process.ml similarity index 100% rename from src/lib/eliom_process.server.ml rename to src/lib/server/eliom_process.ml diff --git a/src/lib/eliom_react.server.ml b/src/lib/server/eliom_react.ml similarity index 95% rename from src/lib/eliom_react.server.ml rename to src/lib/server/eliom_react.ml index cf41ea1461..b4587d46ff 100644 --- a/src/lib/eliom_react.server.ml +++ b/src/lib/server/eliom_react.ml @@ -59,8 +59,8 @@ 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 @@ -87,7 +87,7 @@ struct match scope with | Some `Site -> stateless ?throttling ?name ?size e | None -> stateful ?throttling ?name ?size e - | Some ((`Client_process n) as scope) -> + | Some ((`Client_process _n) as scope) -> stateful ~scope ?throttling ?name ?size e in { t; react_down_mark=react_down_mark () } @@ -212,7 +212,8 @@ struct let wrap_stateful {throttling=t; signal=s; - name=name} = + name=name; + _} = let s : 'a S.t = (match t with | None -> s @@ -226,13 +227,14 @@ struct let wrap_stateless {sl_signal=s; - channel} = + 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 @@ -264,7 +266,7 @@ struct match scope with | Some `Site -> stateless ?throttling ?name s | None -> stateful ?throttling ?name s - | Some ((`Client_process n) as scope) -> + | Some ((`Client_process _n) as scope) -> stateful ~scope ?throttling ?name s in { t; signal_down_mark=signal_down_mark () } diff --git a/src/lib/eliom_react.server.mli b/src/lib/server/eliom_react.mli similarity index 100% rename from src/lib/eliom_react.server.mli rename to src/lib/server/eliom_react.mli diff --git a/src/lib/eliom_reference.server.ml b/src/lib/server/eliom_reference.ml similarity index 99% rename from src/lib/eliom_reference.server.ml rename to src/lib/server/eliom_reference.ml index 88f1add3ad..815c81ade1 100644 --- a/src/lib/eliom_reference.server.ml +++ b/src/lib/server/eliom_reference.ml @@ -154,7 +154,7 @@ module Volatile = struct let modify state eref f = set state eref (f (get state eref)) - let unset state (f, _, table : _ eref) = + let unset state (_f, _, table : _ eref) = match table with | Vol t -> Eliom_state.Ext.Low_level.remove_volatile_data ~state ~table:(Lazy.force t); @@ -245,7 +245,7 @@ let set (_, _, table as eref) value = let modify eref f = get eref >>= fun x -> set eref (f x) -let unset (f, _, table as eref) = +let unset (_f, _, table as eref) = match table with | Per t -> t >>= fun t -> diff --git a/src/lib/eliom_reference.server.mli b/src/lib/server/eliom_reference.mli similarity index 100% rename from src/lib/eliom_reference.server.mli rename to src/lib/server/eliom_reference.mli diff --git a/src/lib/eliom_registration.server.ml b/src/lib/server/eliom_registration.ml similarity index 97% rename from src/lib/eliom_registration.server.ml rename to src/lib/server/eliom_registration.ml index e80dcfb76c..6fb7e12a1c 100644 --- a/src/lib/eliom_registration.server.ml +++ b/src/lib/server/eliom_registration.ml @@ -94,6 +94,7 @@ module Html_make_reg_base | Some headers -> Http_headers.with_defaults headers (Ocsigen_http_frame.Result.headers r)) ()) + [@@ocaml.warning "-27"] end @@ -158,6 +159,7 @@ module Make_typed_xml_registration Http_headers.with_defaults headers (Ocsigen_http_frame.Result.headers r)) ()) + [@@ocaml.warning "-27"] end @@ -281,6 +283,7 @@ module HtmlText_reg_base = struct | Some headers -> Http_headers.with_defaults headers (Ocsigen_http_frame.Result.headers r)) ()) + [@@ocaml.warning "-27"] end @@ -309,11 +312,13 @@ module Action_reg_base = struct in the configuration file (they have already been taken into account) *) fun ri res -> Polytables.set - (Ocsigen_extensions.Ocsigen_request_info.request_cache ri) Eliom_common.found_stop_key (); + ~table:(Ocsigen_extensions.Ocsigen_request_info.request_cache ri) + ~key:Eliom_common.found_stop_key + ~value:(); res let send - ?(options = `Reload) ?charset ?(code = 204) + ?(options = `Reload) ?charset:_ ?(code = 204) ?content_type ?headers () = let user_cookies = Eliom_request_info.get_user_cookies () in if options = `NoReload @@ -354,7 +359,7 @@ module Action_reg_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 @@ -413,9 +418,9 @@ module Action_reg_base = struct (* no post params, GET attached coservice *) -> Polytables.set - (Ocsigen_extensions.Ocsigen_request_info.request_cache ri.Ocsigen_extensions.request_info) - Eliom_common.eliom_params_after_action - (si.Eliom_common.si_all_get_params, + ~table:(Ocsigen_extensions.Ocsigen_request_info.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, @@ -443,9 +448,9 @@ module Action_reg_base = struct (* retry without POST params *) Polytables.set - (Ocsigen_extensions.Ocsigen_request_info.request_cache ri.Ocsigen_extensions.request_info) - Eliom_common.eliom_params_after_action - (si.Eliom_common.si_all_get_params, + ~table:(Ocsigen_extensions.Ocsigen_request_info.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, si.Eliom_common.si_all_file_params, si.Eliom_common.si_nl_get_params, @@ -475,9 +480,9 @@ module Action_reg_base = struct (we impose GET to prevent that) *) Polytables.set - (Ocsigen_extensions.Ocsigen_request_info.request_cache ri.Ocsigen_extensions.request_info) - Eliom_common.eliom_params_after_action - (si.Eliom_common.si_all_get_params, + ~table:(Ocsigen_extensions.Ocsigen_request_info.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, si.Eliom_common.si_all_file_params, si.Eliom_common.si_nl_get_params, @@ -518,8 +523,8 @@ module Unit_reg_base = struct let send_appl_content = Eliom_service.XAlways - let send ?options ?charset ?(code = 204) - ?content_type ?headers content = + let send ?options:_ ?charset:_ ?(code = 204) + ?content_type ?headers _content = let empty_result = Ocsigen_http_frame.Result.empty () in Lwt.return (Ocsigen_http_frame.Result.update empty_result @@ -551,7 +556,7 @@ module Any_reg_base = struct (* let send_appl_content = Eliom_service.XNever *) let send_appl_content = Eliom_service.XAlways - let send ?options ?charset ?code + let send ?options:_ ?charset ?code:_ ?content_type ?headers (res:'a kind) = let res = Result_types.cast_kind res in Lwt.return @@ -619,7 +624,7 @@ module File_reg_base = struct let sp = Eliom_common.get_sp () in let request = Eliom_request_info.get_request_sp sp in let file = - 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? *) | Ocsigen_local_files.Failed_404 @@ -657,7 +662,7 @@ 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 () : Ocsigen_local_files.resolved); true with @@ -682,7 +687,7 @@ module File_ct_reg_base = struct let sp = Eliom_common.get_sp () in let request = Eliom_request_info.get_request_sp sp in let file = - 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? *) | Ocsigen_local_files.Failed_404 @@ -720,7 +725,7 @@ 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 () : Ocsigen_local_files.resolved); true with @@ -740,7 +745,7 @@ module Streamlist_reg_base = struct let send_appl_content = Eliom_service.XNever - let send ?options ?charset ?code + let send ?options:_ ?charset ?code ?content_type ?headers content = Ocsigen_senders.Streamlist_content.result_of_content content >>= fun r -> Lwt.return @@ -944,7 +949,7 @@ module Ocaml_reg_base = struct let send_appl_content = Eliom_service.XNever - let send ?options ?charset ?code + let send ?options:_ ?charset ?code ?content_type ?headers content = Result_types.cast_kind_lwt (Text.send ?charset ?code @@ -1348,7 +1353,7 @@ module Eliom_appl_reg_make_param @ [Eliom_content.Html.F.a_src uri] in - Eliom_content.Html.F.script ~a (Eliom_content.Html.F.pcdata "") :: rem + Eliom_content.Html.F.script ~a (Eliom_content.Html.F.txt "") :: rem end else rem @@ -1650,7 +1655,7 @@ module String_redir_reg_base = struct let send_appl_content = Eliom_service.XAlways (* actually, the service will decide itself *) - let send ?(options = `Found) ?charset ?code + let send ?(options = `Found) ?charset:_ ?code ?content_type ?headers content = let uri = content in let empty_result = Ocsigen_http_frame.Result.empty () in @@ -1729,7 +1734,7 @@ module Redir_reg_base = struct let send_appl_content = Eliom_service.XAlways (* actually, the service will decide itself *) - let send ?(options = `Found) ?charset ?code + let send ?(options = `Found) ?charset:_ ?code ?content_type ?headers (Redirection service) = let uri = Eliom_uri.make_string_uri ~service () in let empty_result = Ocsigen_http_frame.Result.empty () in diff --git a/src/lib/eliom_registration.server.mli b/src/lib/server/eliom_registration.mli similarity index 100% rename from src/lib/eliom_registration.server.mli rename to src/lib/server/eliom_registration.mli diff --git a/src/lib/server/eliom_registration_sigs.mli b/src/lib/server/eliom_registration_sigs.mli new file mode 120000 index 0000000000..ab28cbf30e --- /dev/null +++ b/src/lib/server/eliom_registration_sigs.mli @@ -0,0 +1 @@ +../shared/eliom_registration_sigs.mli \ No newline at end of file diff --git a/src/lib/eliom_route.server.ml b/src/lib/server/eliom_route.ml similarity index 94% rename from src/lib/eliom_route.server.ml rename to src/lib/server/eliom_route.ml index fb90ea9665..5873f240f5 100644 --- a/src/lib/eliom_route.server.ml +++ b/src/lib/server/eliom_route.ml @@ -12,7 +12,7 @@ include Eliom_route_base.Make (struct let sess_info_of_info (_, i, _, _, _) = i - let meth_of_info ({request_info}, _, _, _, _) = + let meth_of_info ({request_info; _}, _, _, _, _) = match Ocsigen_request_info.meth request_info with | Ocsigen_http_frame.Http_header.GET -> `Get @@ -25,7 +25,7 @@ include Eliom_route_base.Make (struct | _ -> `Other - let subpath_of_info ({request_info}, _, _, _, _) = + let subpath_of_info ({request_info; _}, _, _, _, _) = Ocsigen_request_info.sub_path request_info module Container = struct @@ -34,7 +34,7 @@ include Eliom_route_base.Make (struct 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 @@ -87,7 +87,7 @@ include Eliom_route_base.Make (struct end) -let find_aux now sitedata info e sci : Ocsigen_http_frame.Result.result Lwt.t = +let find_aux now sitedata info _e sci : Ocsigen_http_frame.Result.result Lwt.t = Eliom_common.Full_state_name_table.fold (fun fullsessname (_, r) beg -> try%lwt @@ -174,9 +174,9 @@ let get_page *) Lwt_log.ign_info ~section "Link too old. Try without POST parameters:"; Polytables.set - (Ocsigen_request_info.request_cache ri.request_info) - Eliom_common.eliom_link_too_old - true; + ~table:(Ocsigen_request_info.request_cache ri.request_info) + ~key:Eliom_common.eliom_link_too_old + ~value:true; fail (Eliom_common.Eliom_retry_with ({ri with request_info = Ocsigen_request_info.update ri.request_info @@ -208,9 +208,9 @@ let get_page *) Lwt_log.ign_info ~section "Link to old. Trying without GET state parameters and POST parameters:"; Polytables.set - (Ocsigen_request_info.request_cache ri.request_info) - Eliom_common.eliom_link_too_old - true; + ~table:(Ocsigen_request_info.request_cache ri.request_info) + ~key:Eliom_common.eliom_link_too_old + ~value:true; fail (Eliom_common.Eliom_retry_with ({ri with request_info = Ocsigen_request_info.update ri.request_info @@ -401,9 +401,9 @@ let make_naservice (*VVV (Some, Some) or (_, Some)? *) Lwt_log.ign_info ~section "Link too old to a non-attached POST coservice. Try without POST parameters:"; Polytables.set - (Ocsigen_request_info.request_cache ri.request_info) - Eliom_common.eliom_link_too_old - true; + ~table:(Ocsigen_request_info.request_cache ri.request_info) + ~key:Eliom_common.eliom_link_too_old + ~value:true; Eliom_common.get_session_info {ri with Ocsigen_extensions.request_info = Ocsigen_request_info.update ri.request_info @@ -418,7 +418,7 @@ let make_naservice () } si.Eliom_common.si_previous_extension_error - >>= fun (ri', si', previous_tab_cookies_info) -> + >>= fun (ri', si', _previous_tab_cookies_info) -> Lwt.fail (Eliom_common.Eliom_retry_with (ri', si', all_cookie_info, @@ -429,9 +429,9 @@ let make_naservice | Eliom_common.RNa_get' _ -> Lwt_log.ign_info ~section "Link too old. Try without non-attached parameters:"; Polytables.set - (Ocsigen_request_info.request_cache ri.request_info) - Eliom_common.eliom_link_too_old - true; + ~table:(Ocsigen_request_info.request_cache ri.request_info) + ~key:Eliom_common.eliom_link_too_old + ~value:true; Eliom_common.get_session_info {ri with request_info = Ocsigen_request_info.update ri.request_info @@ -446,7 +446,7 @@ let make_naservice () } si.Eliom_common.si_previous_extension_error - >>= fun (ri', si', previous_tab_cookies_info) -> + >>= fun (ri', si', _previous_tab_cookies_info) -> Lwt.fail (Eliom_common.Eliom_retry_with (ri', si', all_cookie_info, all_tab_cookie_info, diff --git a/src/lib/eliom_route.server.mli b/src/lib/server/eliom_route.mli similarity index 100% rename from src/lib/eliom_route.server.mli rename to src/lib/server/eliom_route.mli diff --git a/src/lib/server/eliom_route_base.ml b/src/lib/server/eliom_route_base.ml new file mode 120000 index 0000000000..e94824dbcd --- /dev/null +++ b/src/lib/server/eliom_route_base.ml @@ -0,0 +1 @@ +../shared/eliom_route_base.ml \ No newline at end of file diff --git a/src/lib/eliom_service.server.ml b/src/lib/server/eliom_service.ml similarity index 97% rename from src/lib/eliom_service.server.ml rename to src/lib/server/eliom_service.ml index 94f0450b13..4a0321fc87 100644 --- a/src/lib/eliom_service.server.ml +++ b/src/lib/server/eliom_service.ml @@ -242,7 +242,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 = @@ -253,16 +253,16 @@ let attach : | SNa_get_ s -> SAtt_na_named s | SNa_get' s -> SAtt_na_anon s | SNa_get_csrf_safe a -> SAtt_na_csrf_safe a - | SNa_post_ s -> fallbackkind.get_name (*VVV check *) - | SNa_post' s -> fallbackkind.get_name (*VVV check *) - | SNa_post_csrf_safe a -> fallbackkind.get_name (*VVV check *) + | SNa_post_ _s -> fallbackkind.get_name (*VVV check *) + | SNa_post' _s -> fallbackkind.get_name (*VVV check *) + | SNa_post_csrf_safe _a -> fallbackkind.get_name (*VVV check *) | _ -> failwith error_msg (*VVV Do we want to make possible to attach POST na coservices on GET attached coservices? *) and post_name = match na_name with - | SNa_get_ s -> SAtt_no - | SNa_get' s -> SAtt_no - | SNa_get_csrf_safe a -> SAtt_no + | SNa_get_ _s -> SAtt_no + | SNa_get' _s -> SAtt_no + | SNa_get_csrf_safe _a -> SAtt_no | SNa_post_ s -> SAtt_na_named s | SNa_post' s -> SAtt_na_anon s | SNa_post_csrf_safe a -> SAtt_na_csrf_safe a @@ -393,7 +393,7 @@ let unregister ?scope ?secure raise (Eliom_common.Eliom_site_information_not_available "unregister")) - | Some sp -> + | Some _sp -> Eliom_state.get_global_table () in remove_service table service diff --git a/src/lib/eliom_service.server.mli b/src/lib/server/eliom_service.mli similarity index 100% rename from src/lib/eliom_service.server.mli rename to src/lib/server/eliom_service.mli diff --git a/src/lib/server/eliom_service_sigs.mli b/src/lib/server/eliom_service_sigs.mli new file mode 120000 index 0000000000..e92688d810 --- /dev/null +++ b/src/lib/server/eliom_service_sigs.mli @@ -0,0 +1 @@ +../shared/eliom_service_sigs.mli \ No newline at end of file diff --git a/src/lib/eliom_shared.server.mli b/src/lib/server/eliom_shared.mli similarity index 100% rename from src/lib/eliom_shared.server.mli rename to src/lib/server/eliom_shared.mli diff --git a/src/lib/server/eliom_shared_sigs.mli b/src/lib/server/eliom_shared_sigs.mli new file mode 120000 index 0000000000..e073cdca27 --- /dev/null +++ b/src/lib/server/eliom_shared_sigs.mli @@ -0,0 +1 @@ +../shared/eliom_shared_sigs.mli \ No newline at end of file diff --git a/src/lib/eliom_state.server.ml b/src/lib/server/eliom_state.ml similarity index 98% rename from src/lib/eliom_state.server.ml rename to src/lib/server/eliom_state.ml index 7a773abac6..e1c4d8ace5 100644 --- a/src/lib/eliom_state.server.ml +++ b/src/lib/server/eliom_state.ml @@ -161,7 +161,7 @@ let set_global_persistent_data_state_timeout 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 @@ -394,7 +394,7 @@ let rec close_volatile_state_if_empty ~scope ?secure () = -let close_persistent_state_if_empty ~scope ?secure () = +let close_persistent_state_if_empty ~scope:_ ?secure:_ () = Lwt.return_unit (*VVV Can we implement this function? *) @@ -481,7 +481,7 @@ let get_service_session_group_size in match !(c.Eliom_common.sc_session_group) with | _, _, Right _ -> None - | _, _, Left v -> + | _, _, Left _v -> Some (Eliommod_sessiongroups.Serv.group_size !(c.Eliom_common.sc_session_group)) with | Not_found @@ -564,7 +564,7 @@ let get_volatile_data_session_group_size in match !(c.Eliom_common.dc_session_group) with | _, _, Right _ -> None - | _, _, Left v -> + | _, _, Left _v -> Some (Eliommod_sessiongroups.Data.group_size !(c.Eliom_common.dc_session_group)) with | Not_found @@ -971,7 +971,7 @@ let create_volatile_table ~scope ?secure () = | None -> raise (Eliom_common.Eliom_site_information_not_available "create_volatile_table")) - | Some sp -> + | Some _sp -> let sp = Eliom_common.get_sp () in let sitedata = Eliom_request_info.get_sitedata_sp ~sp in let secure = Eliom_common.get_secure ~secure_o:secure ~sitedata () in @@ -1276,16 +1276,16 @@ module Ext = struct in Eliommod_sessiongroups.Pers.remove_group ~cookie_level:`Session sitedata sgr_o - | (_, `Service, (cookie : string)) -> + | (_, `Service, (_cookie : string)) -> let (_, (_, _, _, _, _sgr, sgrnode)) = get_service_cookie_info state in Eliommod_sessiongroups.Serv.remove sgrnode; Lwt.return_unit - | (_, `Data, cookie) -> + | (_, `Data, _cookie) -> let (_, (_, _, _, _sgr, sgrnode)) = get_volatile_data_cookie_info state in Eliommod_sessiongroups.Data.remove sgrnode; Lwt.return_unit - | (_, `Pers, cookie) -> + | (_, `Pers, _cookie) -> get_persistent_cookie_info state >>= fun (cookie, ((scope, _, _), _, _, sgr_o)) -> let sitedata = get_sitedata () in @@ -1307,8 +1307,8 @@ module Ext = struct | `Client_process _ -> failwith "fold_sub_states" in let reduce_level = function - | `Session_group n -> `Session - | `Session n -> `Client_process + | `Session_group _n -> `Session + | `Session _n -> `Client_process | `Client_process _ -> failwith "fold_sub_states" in let sub_states_level = reduce_level s in @@ -1338,7 +1338,7 @@ module Ext = struct ~(state : Eliom_common.user_scope * [> `Data | `Service ] * string) f e = let state' = (state :> ('aa, 'bb) state) in - let (sitedata, sub_states_level, id, f) as a = + let (_sitedata, _sub_states_level, _id, _f) as a = fold_sub_states_aux_aux ?sitedata ~state:state' f in fold_sub_states_aux Ocsigen_cache.Dlist.fold Ocsigen_lib.id a e state @@ -1350,7 +1350,7 @@ module Ext = struct | (_, `Pers, _) -> (Eliommod_sessiongroups.Pers.find (Eliom_common.make_persistent_full_group_name - sub_states_level sitedata.Eliom_common.site_dir_string (Some id)) + ~cookie_level:sub_states_level sitedata.Eliom_common.site_dir_string (Some id)) >>= fun l -> Lwt_list.fold_left_s f e l) | _ -> @@ -1384,7 +1384,7 @@ module Ext = struct (*VVV Does not work with volatile group data *) let get_volatile_data ~state:((state_scope, _, cookie) : ('s, [ `Data ]) state) - ~table:(table_scope, secure, t : 'a volatile_table) = + ~table:(table_scope, _secure, t : 'a volatile_table) = check_scopes table_scope state_scope; Eliom_common.SessionCookies.find t cookie @@ -1396,7 +1396,7 @@ module Ext = struct let set_volatile_data ~state:((state_scope, _, cookie) : ('s, [ `Data ]) state) - ~table:(table_scope, secure, t : 'a volatile_table) + ~table:(table_scope, _secure, t : 'a volatile_table) value = check_scopes table_scope state_scope; Eliom_common.SessionCookies.replace t cookie value @@ -1464,7 +1464,7 @@ module Ext = struct let unset_service_cookie_timeout ~cookie:(_, (_, _, _, r, _, _)) = r := TGlobal - let unset_volatile_data_cookie_timeout ~cookie:(cookie, (_, _, r, _, _)) = + let unset_volatile_data_cookie_timeout ~cookie:(_cookie, (_, _, r, _, _)) = r := TGlobal let unset_persistent_data_cookie_timeout diff --git a/src/lib/eliom_state.server.mli b/src/lib/server/eliom_state.mli similarity index 100% rename from src/lib/eliom_state.server.mli rename to src/lib/server/eliom_state.mli diff --git a/src/lib/eliom_syntax.server.ml b/src/lib/server/eliom_syntax.ml similarity index 100% rename from src/lib/eliom_syntax.server.ml rename to src/lib/server/eliom_syntax.ml diff --git a/src/lib/eliom_syntax.server.mli b/src/lib/server/eliom_syntax.mli similarity index 100% rename from src/lib/eliom_syntax.server.mli rename to src/lib/server/eliom_syntax.mli diff --git a/src/lib/eliom_types.server.ml b/src/lib/server/eliom_types.ml similarity index 100% rename from src/lib/eliom_types.server.ml rename to src/lib/server/eliom_types.ml diff --git a/src/lib/eliom_types.server.mli b/src/lib/server/eliom_types.mli similarity index 100% rename from src/lib/eliom_types.server.mli rename to src/lib/server/eliom_types.mli diff --git a/src/lib/server/eliom_types_base.ml b/src/lib/server/eliom_types_base.ml new file mode 120000 index 0000000000..5fa16e6096 --- /dev/null +++ b/src/lib/server/eliom_types_base.ml @@ -0,0 +1 @@ +../shared/eliom_types_base.ml \ No newline at end of file diff --git a/src/lib/server/eliom_types_base.mli b/src/lib/server/eliom_types_base.mli new file mode 120000 index 0000000000..3ad05bdc91 --- /dev/null +++ b/src/lib/server/eliom_types_base.mli @@ -0,0 +1 @@ +../shared/eliom_types_base.mli \ No newline at end of file diff --git a/src/lib/server/eliom_uri.ml b/src/lib/server/eliom_uri.ml new file mode 120000 index 0000000000..5e190bb44f --- /dev/null +++ b/src/lib/server/eliom_uri.ml @@ -0,0 +1 @@ +../shared/eliom_uri.ml \ No newline at end of file diff --git a/src/lib/server/eliom_uri.mli b/src/lib/server/eliom_uri.mli new file mode 120000 index 0000000000..59abb18a68 --- /dev/null +++ b/src/lib/server/eliom_uri.mli @@ -0,0 +1 @@ +../shared/eliom_uri.mli \ No newline at end of file diff --git a/src/lib/server/eliommod.ml b/src/lib/server/eliommod.ml index a5a12303ad..51b8129fb5 100644 --- a/src/lib/server/eliommod.ml +++ b/src/lib/server/eliommod.ml @@ -123,8 +123,8 @@ let new_sitedata = session_services = Eliommod_cookies.new_service_cookie_table (); session_data = Eliommod_cookies.new_data_cookie_table (); group_of_groups = gog; - remove_session_data = (fun cookie -> ()); - not_bound_in_data_tables = (fun cookie -> true); + remove_session_data = (fun _cookie -> ()); + not_bound_in_data_tables = (fun _cookie -> true); exn_handler = Eliommod_pagegen.def_handler; unregistered_services = []; unregistered_na_services = []; @@ -257,7 +257,7 @@ let parse_eliom_option | ("level", "clientprocess")::l | ("level", "process")::l | ("level", "tab")::l -> aux (v, sn, `Client_process) l - | ("level", _)::l -> + | ("level", _)::_l -> raise (Error_in_config_file ("Eliom: Wrong attribute value for level in "^tn^" tag")) @@ -514,7 +514,7 @@ let parse_eliom_options f l = let rec parse_global_config = function | [] -> () - | (Xml.Element ("sessiongcfrequency", [("value", s)], p))::ll -> + | (Xml.Element ("sessiongcfrequency", [("value", s)], _p))::ll -> (try let t = float_of_string s in Eliommod_gc.set_servicesessiongcfrequency (Some t); @@ -528,7 +528,7 @@ let rec parse_global_config = function else raise (Error_in_config_file "Eliom: Wrong value for ")); parse_global_config ll - | (Xml.Element ("servicesessiongcfrequency", [("value", s)], p))::ll -> + | (Xml.Element ("servicesessiongcfrequency", [("value", s)], _p))::ll -> (try Eliommod_gc.set_servicesessiongcfrequency (Some (float_of_string s)) with Failure _ -> @@ -537,7 +537,7 @@ let rec parse_global_config = function else raise (Error_in_config_file "Eliom: Wrong value for ")); parse_global_config ll - | (Xml.Element ("datasessiongcfrequency", [("value", s)], p))::ll -> + | (Xml.Element ("datasessiongcfrequency", [("value", s)], _p))::ll -> (try Eliommod_gc.set_datasessiongcfrequency (Some (float_of_string s)) with Failure _ -> @@ -547,7 +547,7 @@ let rec parse_global_config = function "Eliom: Wrong value for ")); parse_global_config ll | (Xml.Element ("persistentsessiongcfrequency", - [("value", s)], p))::ll -> + [("value", s)], _p))::ll -> (try Eliommod_gc.set_persistentsessiongcfrequency (Some (float_of_string s)) @@ -698,7 +698,7 @@ let config_in_tag = ref "" (* the parent tag of the currently handled tag *) type module_to_load = Files of string list | Name of string -let load_eliom_module sitedata cmo_or_name parent_tag content = +let load_eliom_module _sitedata cmo_or_name parent_tag content = let preload () = config := content; config_in_tag := parent_tag; @@ -790,7 +790,7 @@ let parse_config hostpattern conf_info site_dir = | (s, _)::_ -> raise (Error_in_config_file ("Wrong attribute for : "^s)) - in fun _ parse_site -> function + in fun _ _parse_site -> function | Xml.Element ("eliommodule", atts, content) -> Eliom_extension.register_eliom_extension default_module_action; @@ -825,9 +825,9 @@ let parse_config hostpattern conf_info site_dir = let state_hier : Eliom_common.scope_hierarchy = match state_hier with | None -> Eliom_common_base.Default_ref_hier - | Some s when String.lowercase s = "default" -> + | Some s when String.lowercase_ascii s = "default" -> Eliom_common_base.Default_ref_hier - | Some s when String.lowercase s = "comet" -> + | Some s when String.lowercase_ascii s = "comet" -> Eliom_common_base.Default_comet_hier | Some s -> Eliom_common_base.User_hier s in diff --git a/src/lib/server/eliommod_cli.ml b/src/lib/server/eliommod_cli.ml index 9bf730961a..be610569c0 100644 --- a/src/lib/server/eliommod_cli.ml +++ b/src/lib/server/eliommod_cli.ml @@ -23,7 +23,7 @@ let fresh_id = fun () -> c := !c+1; "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 bd6790b3c9..df27ed518b 100644 --- a/src/lib/server/eliommod_cookies.ml +++ b/src/lib/server/eliommod_cookies.ml @@ -50,7 +50,7 @@ let get_cookie_info Eliom_common.Full_state_name_table.fold (fun name value (oktable, failedlist) -> try - let full_state_name, ta, expref, timeout_ref, sessgrpref, sessgrpnode = + let _full_state_name, ta, expref, timeout_ref, sessgrpref, sessgrpnode = Eliom_common.SessionCookies.find sitedata.Eliom_common.session_services value in @@ -106,7 +106,7 @@ let get_cookie_info (fun value -> lazy (try - let full_state_name, expref, timeout_ref, sessgrpref, sessgrpnode = + let _full_state_name, expref, timeout_ref, sessgrpref, sessgrpnode = Eliom_common.SessionCookies.find sitedata.Eliom_common.session_data value in @@ -154,7 +154,7 @@ let get_cookie_info (fun () -> Lazy.force Eliom_common.persistent_cookies_table >>= fun table -> Ocsipersist.find table value >>= - fun (full_state_name, persexp, perstimeout, sessgrp) -> + fun (_full_state_name, persexp, perstimeout, sessgrp) -> Eliommod_sessiongroups.Pers.up value sessgrp >>= fun () -> match persexp with @@ -391,12 +391,12 @@ let compute_new_ri_cookies' (*VVV We always keep secure cookies, event if the protocol is not secure, because this function is for actions only. Is that right? *) match v with - | Ocsigen_cookies.OSet (Some exp, value, secure) + | Ocsigen_cookies.OSet (Some exp, value, _secure) when exp>now -> CookiesTable.add name value cookies - | Ocsigen_cookies.OSet (None, value, secure) -> + | Ocsigen_cookies.OSet (None, value, _secure) -> CookiesTable.add name value cookies - | Ocsigen_cookies.OSet (Some exp, value, secure) + | Ocsigen_cookies.OSet (Some exp, _value, _secure) when exp<=now -> CookiesTable.remove name cookies | Ocsigen_cookies.OUnset -> @@ -425,7 +425,7 @@ let compute_new_ri_cookies compute_new_ri_cookies' now ripath ricookies cookies_set_by_page in (* then session cookies: *) - let f secure (service_cookie_info, data_cookie_info, pers_cookie_info) ric = + let f _secure (service_cookie_info, data_cookie_info, pers_cookie_info) ric = let ric = Eliom_common.Full_state_name_table.fold (fun ((sc, _, _) as full_st_name) (_, v) beg -> diff --git a/src/lib/server/eliommod_datasess.ml b/src/lib/server/eliommod_datasess.ml index 6cd5c781df..712f4ceb7b 100644 --- a/src/lib/server/eliommod_datasess.ml +++ b/src/lib/server/eliommod_datasess.ml @@ -41,7 +41,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 @@ -156,14 +156,14 @@ 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 let full_st_name = Eliom_common.make_full_state_name ~sp ~secure ~scope:cookie_scope in try - let (old, ior) = + let (_old, ior) = Lazy.force (Eliom_common.Full_state_name_table.find full_st_name !cookie_info) in @@ -182,7 +182,7 @@ let rec find_or_create_data_cookie ?set_session_group | Eliom_common.SC c -> (match set_session_group with | None -> () - | Some session_group -> + | Some _session_group -> let fullsessgrp = fullsessgrp ~cookie_level ~sp set_session_group in let node = Eliommod_sessiongroups.Data.move sitedata @@ -228,7 +228,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 5aaf0d0096..1e9ea4d0f4 100644 --- a/src/lib/server/eliommod_gc.ml +++ b/src/lib/server/eliommod_gc.ml @@ -63,10 +63,10 @@ let gc_timeouted_services now tables = Eliom_common.Serv_Table.fold (*VVV not tail recursive: may be a problem if lots of coservices *) (fun ptk (`Ptc (nodeopt, l)) thr -> - thr >>= fun thr -> (* we wait for the previous one + thr >>= fun _thr -> (* 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 -> @@ -87,7 +87,7 @@ let gc_timeouted_services now tables = then match List.fold_right - (fun ({Eliom_common.s_expire} as a) + (fun ({Eliom_common.s_expire; _} as a) foll -> match s_expire with | Some (_, e) when !e < now -> foll @@ -194,7 +194,7 @@ let service_session_gc sitedata = (* private continuation tables: *) Eliom_common.SessionCookies.fold - (fun k (sessname, + (fun k (_sessname, tables, exp, _, @@ -214,7 +214,7 @@ let service_session_gc sitedata = tables.Eliom_common.table_naservices else return_unit) >>= fun () -> (match !session_group_ref with - | (_, scope, Right _) (* no group *) + | (_, _scope, Right _) (* no group *) (*VVV check this *) when (Eliommod_sessiongroups.Serv.group_size @@ -254,7 +254,7 @@ let data_session_gc sitedata = Lwt_log.ign_info ~section "GC of session data"; (* private continuation tables: *) Eliom_common.SessionCookies.fold - (fun k (sessname, + (fun k (_sessname, exp, _, session_group_ref, session_group_node) thr -> diff --git a/src/lib/server/eliommod_pagegen.ml b/src/lib/server/eliommod_pagegen.ml index 592246fbf6..a30ce07fbd 100644 --- a/src/lib/server/eliommod_pagegen.ml +++ b/src/lib/server/eliommod_pagegen.ml @@ -50,7 +50,7 @@ let update_cookie_table ?now sitedata (ci, sci) = (* Update service expiration date and value *) Eliom_common.Full_state_name_table.iter - (fun name (oldvalue, newr) -> + (fun name (_oldvalue, newr) -> (* catch fun () -> *) match !newr with | Eliom_common.SCData_session_expired @@ -82,7 +82,7 @@ let update_cookie_table ?now sitedata (ci, sci) = Keeping same duration is important for example for comet (which is using both service and volatile data sessions). *) - let (oldvalue, newr) = Lazy.force v in + let (_oldvalue, newr) = Lazy.force v in match !newr with | Eliom_common.SCData_session_expired | Eliom_common.SCNo_data -> () (* The cookie has been removed *) @@ -144,7 +144,7 @@ let update_cookie_table ?now sitedata (ci, sci) = oldgrp = !(newc.Eliom_common.pc_session_group) && oldv = newc.Eliom_common.pc_value) -> return_unit (* nothing to do *) - | Some (oldv, oldti, oldexp, oldgrp) when + | Some (oldv, _oldti, _oldexp, _oldgrp) when oldv = newc.Eliom_common.pc_value -> catch (fun () -> @@ -195,13 +195,13 @@ let update_cookie_table ?now sitedata (ci, sci) = let execute now generate_page - ((ri, - si, + ((_ri, + _si, ((service_cookies_info, data_cookies_info, pers_cookies_info), secure_ci), ((service_tab_cookies_info, data_tab_cookies_info, pers_tab_cookies_info), secure_ci_tab), - user_tab_cookies) as info) + _user_tab_cookies) as info) sitedata = catch @@ -225,10 +225,10 @@ let set_expired_sessions ri closedservsessions = then () else Polytables.set - (Ocsigen_extensions.Ocsigen_request_info.request_cache + ~table:(Ocsigen_extensions.Ocsigen_request_info.request_cache ri.Ocsigen_extensions.request_info) - Eliom_common.eliom_service_session_expired - closedservsessions + ~key:Eliom_common.eliom_service_session_expired + ~value:closedservsessions open Ocsigen_extensions @@ -280,8 +280,8 @@ let gen is_eliom_extension sitedata = function set_expired_sessions ri (closedsessions, closedsessions_tab); let rec gen_aux ((ri, si, all_cookie_info, - all_tab_cookie_info, - user_tab_cookies) as info) = + _all_tab_cookie_info, + _user_tab_cookies) as info) = match is_eliom_extension with | Some ext -> Eliom_extension.run_eliom_extension ext now info sitedata @@ -417,5 +417,5 @@ let gen is_eliom_extension sitedata = function | e -> fail e) in gen_aux (ri, si, all_cookie_info, all_tab_cookie_info, user_tab_cookies) - | Ocsigen_extensions.Req_not_found (_, ri) -> + | Ocsigen_extensions.Req_not_found (_, _ri) -> Lwt.return Ocsigen_extensions.Ext_do_nothing diff --git a/src/lib/server/eliommod_persess.ml b/src/lib/server/eliommod_persess.ml index 3398b461e9..6669df9808 100644 --- a/src/lib/server/eliommod_persess.ml +++ b/src/lib/server/eliommod_persess.ml @@ -77,7 +77,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 @@ -167,7 +167,7 @@ let rec find_or_create_persistent_cookie_ 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 @@ -177,7 +177,7 @@ let rec find_or_create_persistent_cookie_ (fun () -> Lazy.force (Eliom_common.Full_state_name_table.find full_st_name !cookie_info) - >>= fun (old, ior) -> + >>= fun (_old, ior) -> match !ior with | Eliom_common.SCData_session_expired (* We do not trust the value sent by the client, @@ -232,7 +232,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 478b0d5b53..7d1c4e2b8d 100644 --- a/src/lib/server/eliommod_sersess.ml +++ b/src/lib/server/eliommod_sersess.ml @@ -39,7 +39,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 @@ -64,7 +64,7 @@ let close_service_state ~scope ~secure_o ?sp () = !(c.Eliom_common.sc_session_group) with | None -> Lwt_log.ign_error ~section:Lwt_log.eliom "No group of groups. Please report this problem." - | Some (service_table, g) -> + | Some (_service_table, g) -> Eliommod_sessiongroups.Serv.remove g end | `Session _ @@ -80,7 +80,7 @@ let close_service_state ~scope ~secure_o ?sp () = 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 @@ -155,7 +155,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 @@ -164,7 +164,7 @@ let rec find_or_create_service_cookie_ ?set_session_group try - let (old, ior) = + let (_old, ior) = Eliom_common.Full_state_name_table.find full_st_name !cookie_info in match !ior with @@ -182,7 +182,7 @@ let rec find_or_create_service_cookie_ ?set_session_group | Eliom_common.SC c -> (match set_session_group with | None -> () - | Some session_group -> + | Some _session_group -> let fullsessgrp = fullsessgrp ~cookie_level ~sp set_session_group in let node = Eliommod_sessiongroups.Serv.move sitedata @@ -236,7 +236,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 248c500a1e..38f763ab08 100644 --- a/src/lib/server/eliommod_sessadmin.ml +++ b/src/lib/server/eliommod_sessadmin.ml @@ -39,8 +39,8 @@ let iter_persistent_sessions f = let close_all_service_states2 full_st_name sitedata = Eliom_common.SessionCookies.fold - (fun k (full_st_name2, table, expref, timeoutref, - sessgrpref, sessgrpnode) thr -> + (fun _k (full_st_name2, _table, _expref, timeoutref, + _sessgrpref, sessgrpnode) thr -> thr >>= fun () -> if full_st_name = full_st_name2 && !timeoutref = Eliom_common.TGlobal then Eliommod_sessiongroups.Serv.remove sessgrpnode; @@ -67,7 +67,7 @@ let close_all_service_states ~scope ~secure sitedata = let close_all_data_states2 full_st_name sitedata = Eliom_common.SessionCookies.fold - (fun k (full_st_name2, expref, timeoutref, sessgrpref, sessgrpnode) thr -> + (fun _k (full_st_name2, _expref, timeoutref, _sessgrpref, sessgrpnode) thr -> thr >>= fun () -> if full_st_name = full_st_name2 && !timeoutref = Eliom_common.TGlobal then Eliommod_sessiongroups.Data.remove sessgrpnode; @@ -96,7 +96,7 @@ let close_all_data_states ~scope ~secure sitedata = let close_all_persistent_states2 full_st_name sitedata = Lazy.force Eliommod_persess.persistent_cookies_table >>= Ocsipersist.iter_table - (fun k ((scope, _, _) as full_st_name2, old_exp, old_t, sessiongrp) -> + (fun k ((scope, _, _) as full_st_name2, _old_exp, old_t, sessiongrp) -> if full_st_name = full_st_name2 && old_t = Eliom_common.TGlobal then Eliommod_persess.close_persistent_state2 ~scope sitedata sessiongrp k >>= @@ -133,8 +133,8 @@ let update_serv_exp full_st_name sitedata old_glob_timeout new_glob_timeout = | _ -> let now = Unix.time () in Eliom_common.SessionCookies.fold - (fun k (full_st_name2, table, expref, timeoutref, - sessgrpref, sessgrpnode) thr -> + (fun _k (full_st_name2, _table, expref, timeoutref, + _sessgrpref, sessgrpnode) thr -> thr >>= fun () -> (if full_st_name = full_st_name2 && !timeoutref = Eliom_common.TGlobal @@ -165,7 +165,7 @@ let update_data_exp full_st_name sitedata old_glob_timeout new_glob_timeout = | _ -> let now = Unix.time () in Eliom_common.SessionCookies.fold - (fun k (full_st_name2, expref, timeoutref, sessgrpref, sessgrpnode) thr -> + (fun _k (full_st_name2, expref, timeoutref, _sessgrpref, sessgrpnode) thr -> thr >>= fun () -> (if full_st_name = full_st_name2 && !timeoutref = Eliom_common.TGlobal then diff --git a/src/lib/server/eliommod_sessiongroups.ml b/src/lib/server/eliommod_sessiongroups.ml index 562d2bf27a..fd7b8fa87a 100644 --- a/src/lib/server/eliommod_sessiongroups.ml +++ b/src/lib/server/eliommod_sessiongroups.ml @@ -367,7 +367,7 @@ Besides, volatile sessions are (hopefully) going to disappear soon. | (_, `Client_process, Left sess_id) -> (try - let (_, tables, _, _, sgr, sgn) = + let (_, tables, _, _, _sgr, sgn) = Eliom_common.SessionCookies.find sitedata.Eliom_common.session_services sess_id in @@ -553,7 +553,7 @@ module Pers = struct | e -> Lwt.fail e) - and remove sitedata sess_id sess_grp = + and remove _sitedata sess_id sess_grp = match sess_grp with | Some sg0 -> let sg = Eliom_common.string_of_perssessgrp sg0 in diff --git a/src/lib/server/eliommod_timeouts.ml b/src/lib/server/eliommod_timeouts.ml index c2a46284ac..b4d85b44ae 100644 --- a/src/lib/server/eliommod_timeouts.ml +++ b/src/lib/server/eliommod_timeouts.ml @@ -27,7 +27,7 @@ open Eliom_lib open Lwt -let fst3 (a,b,c) = a +let fst3 (a,_b,_c) = a type kind = [ `Service | `Data | `Persistent ] diff --git a/src/lib/eliom_client_base.shared.ml b/src/lib/shared/eliom_client_base.ml similarity index 100% rename from src/lib/eliom_client_base.shared.ml rename to src/lib/shared/eliom_client_base.ml diff --git a/src/lib/eliom_comet_base.shared.ml b/src/lib/shared/eliom_comet_base.ml similarity index 98% rename from src/lib/eliom_comet_base.shared.ml rename to src/lib/shared/eliom_comet_base.ml index 7c0036cd68..515c720189 100644 --- a/src/lib/eliom_comet_base.shared.ml +++ b/src/lib/shared/eliom_comet_base.ml @@ -24,6 +24,7 @@ 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" +[@@@ocaml.warning "-39"] type position = | Newest of int | After of int @@ -64,6 +65,7 @@ type answer = | State_closed | Comet_error of string [@@deriving json] +[@@@ocaml.warning "+39"] type comet_service = Comet_service : diff --git a/src/lib/eliom_comet_base.shared.mli b/src/lib/shared/eliom_comet_base.mli similarity index 100% rename from src/lib/eliom_comet_base.shared.mli rename to src/lib/shared/eliom_comet_base.mli diff --git a/src/lib/eliom_common_base.shared.ml b/src/lib/shared/eliom_common_base.ml similarity index 98% rename from src/lib/eliom_common_base.shared.ml rename to src/lib/shared/eliom_common_base.ml index 9fe214d5e1..ca78d4f60b 100644 --- a/src/lib/eliom_common_base.shared.ml +++ b/src/lib/shared/eliom_common_base.ml @@ -55,14 +55,14 @@ type cookie_scope = [ `Session of scope_hierarchy | `Client_process of scope_hierarchy ] let level_of_user_scope : [< user_scope ] -> [> user_level ] = function - | `Session n -> `Session - | `Session_group n -> `Session_group - | `Client_process n -> `Client_process + | `Session _n -> `Session + | `Session_group _n -> `Session_group + | `Client_process _n -> `Client_process let cookie_level_of_user_scope : [< user_scope ] -> [> cookie_level ] = function - | `Session n - | `Session_group n -> `Session - | `Client_process n -> `Client_process + | `Session _n + | `Session_group _n -> `Session + | `Client_process _n -> `Client_process let cookie_scope_of_user_scope : [< user_scope ] -> [> cookie_scope ] = function | `Session n @@ -314,7 +314,7 @@ let prefixlengthminusone = prefixlength - 1 let split_nl_prefix_param l = let rec aux other map = function | [] -> (map, other) - | ((n, v) as a)::l -> + | ((n, _v) as a)::l -> if String.first_diff n nl_param_prefix 0 prefixlengthminusone = prefixlength then @@ -349,7 +349,7 @@ let remove_prefixed_param pref l = let len = String.length pref in let rec aux = function | [] -> [] - | ((n,v) as a)::l -> + | ((n,_v) as a)::l -> try if (String.sub n 0 len) = pref then aux l diff --git a/src/lib/eliom_content_sigs.shared.mli b/src/lib/shared/eliom_content_sigs.mli similarity index 100% rename from src/lib/eliom_content_sigs.shared.mli rename to src/lib/shared/eliom_content_sigs.mli diff --git a/src/lib/eliom_cookies_base.shared.ml b/src/lib/shared/eliom_cookies_base.ml similarity index 95% rename from src/lib/eliom_cookies_base.shared.ml rename to src/lib/shared/eliom_cookies_base.ml index aff3913e41..6d4a33d31b 100644 --- a/src/lib/eliom_cookies_base.shared.ml +++ b/src/lib/shared/eliom_cookies_base.ml @@ -1,5 +1,7 @@ open Ocsigen_cookies +[@@@ocaml.warning "-39"] + type cookie = Ocsigen_cookies.cookie = | OSet of float option (* exp date *) * string (* value *) * bool (* secure *) | OUnset @@ -9,6 +11,8 @@ type cookie_array = ( string array * (( string * cookie ) array )) array [@@deriving json] +[@@@ocaml.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_form_sigs.shared.mli b/src/lib/shared/eliom_form_sigs.mli similarity index 100% rename from src/lib/eliom_form_sigs.shared.mli rename to src/lib/shared/eliom_form_sigs.mli diff --git a/src/lib/eliom_lib_base.shared.ml b/src/lib/shared/eliom_lib_base.ml similarity index 100% rename from src/lib/eliom_lib_base.shared.ml rename to src/lib/shared/eliom_lib_base.ml diff --git a/src/lib/eliom_lib_base.shared.mli b/src/lib/shared/eliom_lib_base.mli similarity index 100% rename from src/lib/eliom_lib_base.shared.mli rename to src/lib/shared/eliom_lib_base.mli diff --git a/src/lib/eliom_parameter_base.shared.ml b/src/lib/shared/eliom_parameter_base.ml similarity index 95% rename from src/lib/eliom_parameter_base.shared.ml rename to src/lib/shared/eliom_parameter_base.ml index 583cdd9c98..e6e6d13e33 100644 --- a/src/lib/eliom_parameter_base.shared.ml +++ b/src/lib/shared/eliom_parameter_base.ml @@ -193,12 +193,12 @@ 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 n -> (make_suffix (TAtom ("",TInt)) (params.abscissa))@ + | TCoord _n -> (make_suffix (TAtom ("",TInt)) (params.abscissa))@ (make_suffix (TAtom ("",TInt)) (params.ordinate)) | TUnit -> [""] | TConst v -> [v] @@ -220,7 +220,7 @@ let rec make_suffix : type a c. (a,'b,c) params_type -> a -> string list = fun t (make_suffix typ l)) | TUserType (_, tao) -> [ Eliom_common.To_and_of_shared.to_string tao params ] - | TTypeFilter (t, check) -> make_suffix t params + | TTypeFilter (t, _check) -> make_suffix t params | TSum (t1, t2) -> (match params with | Inj1 p -> make_suffix t1 p @@ -239,7 +239,7 @@ let rec aux : type a c. (a,'b,c) params_type -> string list option -> 'y -> a -> 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) -> @@ -283,7 +283,7 @@ let rec aux : type a c. (a,'b,c) params_type -> string list option -> 'y -> a -> psuff, nlp, ((pref ^ name ^ suff), insert_string (Eliom_common.To_and_of_shared.to_string tao params)) :: l - | TTypeFilter (t, check) -> aux t psuff nlp params pref suff l + | TTypeFilter (t, _check) -> aux t psuff nlp params pref suff l | TUnit -> psuff, nlp, l | TAny -> psuff, nlp, l@(List.map (fun (x,v) -> x,insert_string v) params) | TConst _ -> psuff, nlp, l @@ -359,11 +359,11 @@ let rec walk_parameter_tree : type a c. string -> (a,'b,c) params_type -> a to_a | TAny -> None | TNLParams _ -> None | TUnit -> None - | TOption (o,_) -> failwith "walk_parameter_tree with option" - | TSet o -> failwith "walk_parameter_tree with set" - | TList (_, o) -> failwith "walk_parameter_tree with list" - | TProd (a, b) -> failwith "walk_parameter_tree with tuple" - | TSum (a, b) -> failwith "walk_parameter_tree with sum" + | TOption (_o,_) -> failwith "walk_parameter_tree with option" + | TSet _o -> failwith "walk_parameter_tree with set" + | TList (_, _o) -> failwith "walk_parameter_tree with list" + | TProd (_a, _b) -> failwith "walk_parameter_tree with tuple" + | TSum (_a, _b) -> failwith "walk_parameter_tree with sum" | TRaw_post_data -> failwith "walk_parameter_tree with raw post data" @@ -385,12 +385,12 @@ let construct_params nonlocparams typ p = let make_params_names params = let rec aux : type a c. bool -> string -> string -> (a,'b,c) params_type -> bool * c = 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 issuffix, (a, b) - | TAtom(name,a) -> issuffix, prefix^name^suffix + | TAtom(name,_a) -> issuffix, prefix^name^suffix | TCoord(name) -> issuffix, prefix^name^suffix | TFile name -> issuffix, prefix^name^suffix | TUserType (name, _) -> issuffix, prefix^name^suffix @@ -471,7 +471,7 @@ let nl_prod specification *) 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 @@ -594,8 +594,8 @@ let reconstruct_params_ typ params files nosuffixversion urlsuffix : 'a = [] with e -> raise (Eliom_common.Eliom_Typing_Error [("", e)])) - | TOption (t,_), [] -> None, [] - | TOption (t,_), ""::l -> None, l + | TOption (_t,_), [] -> None, [] + | TOption (_t,_), ""::l -> None, l | TOption (t,_), l -> let r, ll = parse_suffix t l in Some r, ll @@ -629,14 +629,14 @@ let reconstruct_params_ typ params files nosuffixversion urlsuffix : 'a = | r, l -> let rr, ll = parse_suffix t2 l in (r, rr), ll) - | TAtom (name, t), v::l -> + | TAtom (_name, t), v::l -> (try atom_of_string t v, l with e -> raise (Eliom_common.Eliom_Typing_Error [("", e)])) - | TUserType (name, tao), v::l -> + | TUserType (_name, tao), v::l -> (try Eliom_common.To_and_of_shared.of_string tao v, l with e -> raise (Eliom_common.Eliom_Typing_Error [("", e)])) - | TTypeFilter (t, None), _ -> failwith "Type filter without filter" + | TTypeFilter (_t, None), _ -> failwith "Type filter without filter" | TTypeFilter (t, Some check), l -> let (v, _) as a = parse_suffix t l in check v; @@ -658,7 +658,7 @@ let reconstruct_params_ typ params files nosuffixversion urlsuffix : 'a = | TNLParams _, _ -> failwith "It is not possible to have non localized parameters in suffix" | TJson (_, Some typ), v::l -> Deriving_Json.from_string typ v, l - | TJson (_, None), v::l -> assert false (* client side only *) + | TJson (_, None), _v::_l -> assert false (* client side only *) | TAny, _ -> failwith "It is not possible to use any in suffix. May be try with all_suffix ?" | TFile _, _ -> assert false | TRaw_post_data, _ -> assert false @@ -689,7 +689,7 @@ let reconstruct_params_ typ params files nosuffixversion urlsuffix : 'a = and aux : type a c. (a, 'b, c) params_type -> params' -> files -> string -> string -> a res_reconstr_param = 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) -> @@ -710,7 +710,7 @@ let reconstruct_params_ typ params files nosuffixversion urlsuffix : 'a = | Errors_ (errs, ll, ff) when List.for_all (fun (_,s,_) -> s="") errs -> Res_ (None, ll, ff) | Errors_ err -> Errors_ err) with Not_found -> Res_ (None, params, files)) - | TOption (t,b) -> + | TOption (t,_b) -> (try (match aux t params files pref suff with | Res_ (v, l, f) -> Res_ (Some v, l, f) @@ -733,7 +733,7 @@ let reconstruct_params_ typ params files nosuffixversion urlsuffix : 'a = | Res_ (vv2, ll2, ff2) -> Res_ (vv::vv2, ll2, ff2) | err -> err) - | Errors_ (errs, ll, ff) when ll = params && ff = files -> + | Errors_ (_errs, ll, ff) when ll = params && ff = files -> Res_ ([], params, files) | Errors_ (errs, ll, ff) -> (match aux_set ll ff with @@ -765,7 +765,7 @@ let reconstruct_params_ typ params files nosuffixversion urlsuffix : 'a = end | TAtom (name,TBool) -> (try - let v,l = (List.assoc_remove (pref^name^suff) params) in + let _v,l = (List.assoc_remove (pref^name^suff) params) in Res_ (true,l,files) with Not_found -> Res_ (false, params, files)) @@ -804,7 +804,7 @@ let reconstruct_params_ typ params files nosuffixversion urlsuffix : 'a = let v,l = (List.assoc_remove (pref^name^suff) params) in (try Res_ (Eliom_common.To_and_of_shared.of_string tao v,l,files) with e -> Errors_ ([(pref^name^suff),v,e], l, files)) - | TTypeFilter (t, None) -> failwith "Type filter without filter" + | TTypeFilter (_t, None) -> failwith "Type filter without filter" | TTypeFilter (t, Some check) -> (match aux t params files pref suff with | Res_ (v, l, files) as a -> @@ -841,7 +841,7 @@ let reconstruct_params_ typ params files nosuffixversion urlsuffix : 'a = | TJson (name, Some typ) -> let v,l = List.assoc_remove (pref^name^suff) params in Res_ ((of_json ~typ v),l,files) - | TJson (name, None) -> assert false + | TJson (_name, None) -> assert false (* Never unmarshal server side without type! *) | TRaw_post_data -> raise Eliom_common.Eliom_Wrong_parameter in @@ -856,12 +856,12 @@ let reconstruct_params_ typ params files nosuffixversion urlsuffix : 'a = "Eliom_Wrong_parameter: params non-empty (ERROR): %a" (fun () l -> String.concat ", " (List.map (fun (x,k) -> x^"="^k) l)) l; if files <> [] then Lwt_log.ign_debug_f ~section - "Eliom_Wrong_parameter: files non-empty (ERROR): %a" (fun () files -> String.concat ", " (List.map (fun (x,k) -> x) files)) files; + "Eliom_Wrong_parameter: files non-empty (ERROR): %a" (fun () files -> String.concat ", " (List.map (fun (x,_k) -> x) files)) files; raise Eliom_common.Eliom_Wrong_parameter end | Errors_ (errs, l, files) -> if (l, files) = ([], []) - then raise (Eliom_common.Eliom_Typing_Error (List.map (fun (v,l,e) -> (v,e)) errs)) + then raise (Eliom_common.Eliom_Typing_Error (List.map (fun (v,_l,e) -> (v,e)) errs)) else raise Eliom_common.Eliom_Wrong_parameter with | Not_found -> raise Eliom_common.Eliom_Wrong_parameter diff --git a/src/lib/eliom_parameter_sigs.shared.mli b/src/lib/shared/eliom_parameter_sigs.mli similarity index 100% rename from src/lib/eliom_parameter_sigs.shared.mli rename to src/lib/shared/eliom_parameter_sigs.mli diff --git a/src/lib/eliom_registration_sigs.shared.mli b/src/lib/shared/eliom_registration_sigs.mli similarity index 100% rename from src/lib/eliom_registration_sigs.shared.mli rename to src/lib/shared/eliom_registration_sigs.mli diff --git a/src/lib/eliom_route_base.shared.ml b/src/lib/shared/eliom_route_base.ml similarity index 96% rename from src/lib/eliom_route_base.shared.ml rename to src/lib/shared/eliom_route_base.ml index 50624b23d5..a0c1d8553a 100644 --- a/src/lib/eliom_route_base.shared.ml +++ b/src/lib/shared/eliom_route_base.ml @@ -121,7 +121,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. *) @@ -202,11 +202,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 @@ -221,7 +221,7 @@ module Make (P : PARAM) = struct 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 @@ -239,7 +239,7 @@ module Make (P : PARAM) = struct - only one for each key - we add a node in the dlist to limit their number *) (try - let (nodeopt, l), newt = + let (nodeopt, _l), newt = P.Table.find key !tref, P.Table.remove key !tref in (match nodeopt with @@ -250,9 +250,10 @@ module Make (P : PARAM) = struct 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.SAtt_no, Eliom_common.SAtt_no + ; _ } -> (try - let nodeopt, l = P.Table.find key !tref + let _nodeopt, l = P.Table.find key !tref and newt = P.Table.remove key !tref in (* nodeopt should be None *) try @@ -275,7 +276,7 @@ module Make (P : PARAM) = struct tref := P.Table.add key (None, [service]) !tref) | _ -> try - let nodeopt, l = P.Table.find key !tref + let _nodeopt, l = P.Table.find key !tref and newt = P.Table.remove key !tref in let _, oldl = find_and_remove_id l s_id in (* if there was an old version with the same id, we remove it *) @@ -328,7 +329,7 @@ module Make (P : PARAM) = struct let direltref = find_dircontent !dircontentref a in match !direltref with | Eliom_common.Dir dcr -> search_page_table_ref dcr l - | Eliom_common.File ptr -> + | Eliom_common.File _ptr -> raise (Eliom_common.Eliom_page_erasing a) with | Not_found -> @@ -438,7 +439,7 @@ module Make (P : PARAM) = struct | Eliom_common.File page_table_ref -> (match l with | [] -> find false page_table_ref None - | l -> (* We have a file with suffix *) + | _l -> (* We have a file with suffix *) raise Eliom_common.Eliom_Wrong_parameter))) (function | Exn1 | Eliom_common.Eliom_Wrong_parameter as e -> diff --git a/src/lib/eliom_runtime.shared.ml b/src/lib/shared/eliom_runtime.ml similarity index 96% rename from src/lib/eliom_runtime.shared.ml rename to src/lib/shared/eliom_runtime.ml index fce9f00b18..13446299c5 100644 --- a/src/lib/eliom_runtime.shared.ml +++ b/src/lib/shared/eliom_runtime.ml @@ -48,7 +48,9 @@ module RawXML = struct | Space -> " " | Comma -> ", " + [@@@ocaml.warning "-39"] type cookie_info = (bool * string list) [@@deriving json] + [@@@ocaml.warning "+39"] type caml_event_handler = | CE_registered_closure of @@ -112,10 +114,10 @@ module RawXML = struct and attrib = aname * racontent let aname = function - | name, RACamlEventHandler (CE_registered_closure (crypto, _)) -> + | name, RACamlEventHandler (CE_registered_closure (_crypto, _)) -> closure_name_prefix^name - | _, RAClient (s, Some (name,_), c) - | name, RAClient (s, None, c) -> client_name_prefix^name + | _, RAClient (_s, Some (name,_), _c) + | name, RAClient (_s, None, _c) -> client_name_prefix^name | name, _ -> name let acontent = function | _ ,RAReact s -> (match React.S.value s with None -> AStr "" | Some x -> x) @@ -163,7 +165,7 @@ module RawXML = struct let filter_class_value acc = function | AStr v -> v :: acc - | AStrL (space, v) -> + | AStrL (_space, v) -> v @ acc | _ -> failwith "attribute class is not a string" @@ -177,7 +179,7 @@ module RawXML = struct begin match Eliom_lazy.force link_info with | None -> freepos, acc_class, acc_attr - | Some (kind, cookie_info, tmpl, _) -> + | Some (_kind, cookie_info, tmpl, _) -> let acc_class = ce_call_service_class::acc_class in let acc_attr = match cookie_info with diff --git a/src/lib/eliom_runtime.shared.mli b/src/lib/shared/eliom_runtime.mli similarity index 100% rename from src/lib/eliom_runtime.shared.mli rename to src/lib/shared/eliom_runtime.mli diff --git a/src/lib/eliom_service_sigs.shared.mli b/src/lib/shared/eliom_service_sigs.mli similarity index 100% rename from src/lib/eliom_service_sigs.shared.mli rename to src/lib/shared/eliom_service_sigs.mli diff --git a/src/lib/eliom_shared_sigs.shared.mli b/src/lib/shared/eliom_shared_sigs.mli similarity index 100% rename from src/lib/eliom_shared_sigs.shared.mli rename to src/lib/shared/eliom_shared_sigs.mli diff --git a/src/lib/eliom_types_base.shared.ml b/src/lib/shared/eliom_types_base.ml similarity index 100% rename from src/lib/eliom_types_base.shared.ml rename to src/lib/shared/eliom_types_base.ml diff --git a/src/lib/eliom_types_base.shared.mli b/src/lib/shared/eliom_types_base.mli similarity index 100% rename from src/lib/eliom_types_base.shared.mli rename to src/lib/shared/eliom_types_base.mli diff --git a/src/lib/eliom_uri.shared.ml b/src/lib/shared/eliom_uri.ml similarity index 98% rename from src/lib/eliom_uri.shared.ml rename to src/lib/shared/eliom_uri.ml index c209d43ba2..3d4aa7c062 100644 --- a/src/lib/eliom_uri.shared.ml +++ b/src/lib/shared/eliom_uri.ml @@ -44,10 +44,10 @@ let reconstruct_absolute_url_path = string_of_url_path_suff let reconstruct_relative_url_path current_url u = let rec drop cururl desturl = match cururl, desturl with - | a::l, [b] -> l, desturl - | [a], m -> [], m + | _a::l, [_b] -> l, desturl + | [_a], m -> [], m | a::l, b::m when a = b -> drop l m - | a::l, m -> l, m + | _a::l, m -> l, m | [], m -> [], m in let rec makedotdot = function | [] -> [] @@ -101,7 +101,7 @@ let make_proto_prefix 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 || @@ -354,7 +354,7 @@ let make_uri_components 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 @@ -507,7 +507,7 @@ let make_post_uri_components_ (* for getparams and non localized params: *) - let suff, params = + let _suff, params = Eliom_parameter.construct_params_list nlp (Eliom_service.get_params_type service) getparams (* if nl params were already present, they will be replaced @@ -674,7 +674,7 @@ let make_cookies_info (https, service) = None else Some (Eliom_service.full_path attser) - | Eliom_service.Nonattached naser -> + | Eliom_service.Nonattached _naser -> Some (Eliom_request_info.get_csp_original_full_path ()) in match get_path_ ~service with diff --git a/src/lib/eliom_uri.shared.mli b/src/lib/shared/eliom_uri.mli similarity index 100% rename from src/lib/eliom_uri.shared.mli rename to src/lib/shared/eliom_uri.mli diff --git a/src/ocamlbuild/ocamlbuild_eliom.ml b/src/ocamlbuild/ocamlbuild_eliom.ml index ecf99050d4..5efbd02b2a 100644 --- a/src/ocamlbuild/ocamlbuild_eliom.ml +++ b/src/ocamlbuild/ocamlbuild_eliom.ml @@ -69,11 +69,11 @@ module MakeIntern (I : INTERNALS)(Eliom : ELIOM) = struct let get_eliom_syntax_ppx = function | `Client -> - "eliom.ppx.client" + "ppx_eliom.ppx.client" | `Server -> - "eliom.ppx.server" + "ppx_eliom.ppx.server" | `Type -> - "eliom.ppx.type" + "ppx_eliom.ppx.type" let get_syntaxes_p4 with_eliom_syntax eliom_syntax src = let eliom_syntax = get_eliom_syntax_p4 eliom_syntax in diff --git a/src/ppx/.merlin b/src/ppx/.merlin deleted file mode 100644 index 7696577005..0000000000 --- a/src/ppx/.merlin +++ /dev/null @@ -1,4 +0,0 @@ -PKG compiler-libs.common -PKG ppx_tools ppx_tools.metaquot - -REC diff --git a/src/ppx/_tags b/src/ppx/_tags deleted file mode 100644 index 989b3c6d58..0000000000 --- a/src/ppx/_tags +++ /dev/null @@ -1 +0,0 @@ -true:warn(+A-4-6-7-9-40-42-44-48) diff --git a/src/ppx/ppx_eliom.ml b/src/ppx/ppx_eliom.ml deleted file mode 100644 index d743cf2d35..0000000000 --- a/src/ppx/ppx_eliom.ml +++ /dev/null @@ -1 +0,0 @@ -(* This file is not empty. *) diff --git a/src/ppx/ppx_eliom.mli b/src/ppx/ppx_eliom.mli deleted file mode 100644 index a5a497fddb..0000000000 --- a/src/ppx/ppx_eliom.mli +++ /dev/null @@ -1,4 +0,0 @@ -(** -Eliom PPX syntax extension. For documentation, refer to -{% <>%} -*) diff --git a/src/ppx/ppx_eliom_client.ml b/src/ppx/ppx_eliom_client.ml deleted file mode 100644 index d74046c433..0000000000 --- a/src/ppx/ppx_eliom_client.ml +++ /dev/null @@ -1,261 +0,0 @@ -open Parsetree -open Asttypes -open Ast_helper - -module AC = Ast_convenience -module AM = Ast_mapper - -open Ppx_eliom_utils - -module Pass = struct - - (** {2 Auxiliaries} *) - - (* Replace every escaped identifier [v] with - [Eliom_client_core.Syntax_helpers.get_escaped_value v] *) - let map_get_escaped_values = - let mapper = - {Ast_mapper.default_mapper with - expr = (fun mapper e -> - match e.pexp_desc with - | Pexp_ident {txt} when Mli.is_escaped_ident @@ Longident.last txt -> - [%expr Eliom_client_core.Syntax_helpers.get_escaped_value [%e e] ] - [@metaloc e.pexp_loc] - | _ -> AM.default_mapper.expr mapper e - ); - } - in - fun expr -> mapper.expr mapper expr - - let push_escaped_binding, flush_escaped_bindings = - let server_arg_ids = ref [] in - let is_unknown gen_id = - List.for_all - (fun (gen_id', _) -> gen_id.txt <> gen_id'.txt) - !server_arg_ids - in - let push gen_id (expr : expression) = - if is_unknown gen_id then - server_arg_ids := (gen_id, expr) :: !server_arg_ids - in - let flush () = - let res = List.rev !server_arg_ids in - server_arg_ids := []; - res - in - push, flush - - let mark_injection, flush_injection = - let has_injection = ref false in - let mark () = has_injection := true in - let flush () = - let x = !has_injection in - has_injection := false ; - x - in - mark, flush - - let push_client_value_data, flush_client_value_datas = - let client_value_datas = ref [] in - let push gen_num gen_id expr (args : string Location.loc list) = - client_value_datas := - (gen_num, gen_id, expr, args) :: !client_value_datas - in - let flush () = - let res = List.rev !client_value_datas in - client_value_datas := []; - res - in - push, flush - - let find_escaped_ident id = - if Mli.exists () then Mli.find_escaped_ident id else [%type: _] - - let find_injected_ident id = - if Mli.exists () then Mli.find_injected_ident id else [%type: _] - - let find_fragment id = - if Mli.exists () then Mli.find_fragment id else [%type: _] - - let register_client_closures client_value_datas = - let registrations = - List.map - (fun (num, id, expr, args) -> - let typ = find_fragment id in - let args = List.map Pat.var args in - [%expr - Eliom_client_core.Syntax_helpers.register_client_closure - [%e AC.str num] - (fun [%p pat_args args] -> - ([%e map_get_escaped_values expr] : [%t typ])) - ] [@metaloc expr.pexp_loc] - ) - client_value_datas - in - match registrations with - | [] -> [] - | _ -> [Str.eval (AC.sequence registrations)] - - (* We hoist the body of client fragments to enforce the correct scoping: - Identifiers declared earlier in the client section should not be - visible inside the client fragment (unless via escaped value). *) - let define_client_functions ~loc client_value_datas = - match client_value_datas with - | [] -> - [] - | _ -> - let bindings = - List.map - (fun (_num, id, expr, args) -> - let patt = Pat.var id in - let typ = find_fragment id in - let args = List.map Pat.var args in - let expr = - [%expr - fun [%p pat_args args] -> ([%e expr] : [%t typ]) - ] [@metaloc loc] - in - Vb.mk ~loc patt expr) - client_value_datas - in - [Str.value ~loc Nonrecursive bindings] - - (* For injections *) - - let close_server_section loc = - [%stri - let () = - Eliom_client_core.Syntax_helpers.close_server_section - [%e eid @@ id_file_hash loc] - ][@metaloc loc] - - let may_close_server_section ~no_fragment item = - if no_fragment - then [] - else [close_server_section item.pstr_loc] - - - let open_client_section loc = - [%stri - let () = - Eliom_client_core.Syntax_helpers.open_client_section - [%e eid @@ id_file_hash loc] - ][@metaloc loc] - - let may_open_client_section loc = - if flush_injection () - then [ open_client_section loc ] - else [] - - (** Syntax extension *) - - let client_str item = - let loc = item.pstr_loc in - may_open_client_section loc @ - [ item ] - - let server_str no_fragment item = - register_client_closures (flush_client_value_datas ()) @ - may_close_server_section ~no_fragment item - - let shared_str no_fragment item = - let loc = item.pstr_loc in - let client_expr_data = flush_client_value_datas () in - may_open_client_section loc @ - register_client_closures client_expr_data @ - define_client_functions loc client_expr_data @ - [ item ] @ - may_close_server_section ~no_fragment item - - let fragment ?typ:_ ~context ~num ~id expr = - - let loc = expr.pexp_loc in - let frag_eid = eid id in - let escaped_bindings = flush_escaped_bindings () in - - push_client_value_data num id expr - (List.map fst escaped_bindings); - - match context, escaped_bindings with - | `Server, _ -> - (* We are in a server fragment, this code should always be discarded. *) - Exp.extension @@ AM.extension_of_error @@ Location.errorf "Eliom: ICE" - | `Shared, [] -> - [%expr [%e frag_eid] ()][@metaloc loc] - | `Shared, _ -> - let bindings = - List.map - (fun (gen_id, expr) -> - Vb.mk ~loc:expr.pexp_loc (Pat.var gen_id) expr ) - escaped_bindings - in - let args = - format_args @@ List.map - (fun (id, _) -> eid id) - escaped_bindings - in - Exp.let_ ~loc - Nonrecursive - bindings - [%expr [%e frag_eid] [%e args]][@metaloc loc] - - - - let escape_inject ?ident ~(context:Context.escape_inject) ~id expr = - let loc = expr.pexp_loc in - let frag_eid = eid id in - - let assert_no_variables t = - let typ mapper = function - | {ptyp_desc = Ptyp_var _ } as typ -> - let attr = - AM.attribute_of_warning loc - "The type of this injected value contains a type variable \ - that could be wrongly inferred." - in - { typ with ptyp_attributes = attr :: typ.ptyp_attributes } - | typ -> AM.default_mapper.typ mapper typ - in - let m = { AM.default_mapper with typ } in - m.AM.typ m t - in - - match context with - - (* [%%server [%client ~%( ... ) ] ] *) - | `Escaped_value _section -> - let typ = find_escaped_ident id in - let typ = assert_no_variables typ in - push_escaped_binding id expr; - [%expr ([%e frag_eid] : [%t typ]) ][@metaloc loc] - - - (* [%%server ... %x ... ] *) - | `Injection _section -> - mark_injection () ; - let typ = find_injected_ident id in - let typ = assert_no_variables typ in - let ident = match ident with - | None -> [%expr None] - | Some i -> [%expr Some [%e AC.str i]] - in - let (u, d) = Mli.get_injected_ident_info id.txt in - let es = (AC.str @@ Printf.sprintf "%s%d" u d)[@metaloc id.loc] in - [%expr - (Eliom_client_core.Syntax_helpers.get_injection - ?ident:([%e ident]) - ~pos:([%e position loc]) - [%e es] - : [%t typ]) - ][@metaloc loc] - - let shared_sig item = [item] - let server_sig _ = [] - let client_sig item = [item] - - let prelude _ = [] - let postlude _ = [] - -end - -include Make(Pass) diff --git a/src/ppx/ppx_eliom_client.mli b/src/ppx/ppx_eliom_client.mli deleted file mode 100644 index be5a2dd400..0000000000 --- a/src/ppx/ppx_eliom_client.mli +++ /dev/null @@ -1,2 +0,0 @@ - -val mapper : string list -> Ast_mapper.mapper diff --git a/src/ppx/ppx_eliom_client_ex.ml b/src/ppx/ppx_eliom_client_ex.ml deleted file mode 100644 index 49798061b9..0000000000 --- a/src/ppx/ppx_eliom_client_ex.ml +++ /dev/null @@ -1,2 +0,0 @@ - -let () = Ast_mapper.run_main Ppx_eliom_client.mapper diff --git a/src/ppx/ppx_eliom_server.ml b/src/ppx/ppx_eliom_server.ml deleted file mode 100644 index 7b8734c479..0000000000 --- a/src/ppx/ppx_eliom_server.ml +++ /dev/null @@ -1,218 +0,0 @@ -(* Ocsigen - * http://www.ocsigen.org - * Copyright (C) 2010-2011 - * Raphaël Proust, Grégoire Henry, Gabriel Radanne - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, with linking exception; - * either version 2.1 of the License, or (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - *) - -(* This prepocessor generates the module to be loaded by Ocsigen server *) - -open Parsetree -open Asttypes -open Ast_helper - -module AC = Ast_convenience -module AM = Ast_mapper - -open Ppx_eliom_utils - -module Pass = struct - - let push_escaped_binding, flush_escaped_bindings = - let args = ref [] in - let push orig_expr id = - if List.for_all (function id', _ -> id.txt <> id'.txt) !args then - args := (id, orig_expr) :: !args; - in - let flush () = - let res = List.rev !args in - args := []; - let aux (_, arg) = - [%expr Eliom_syntax.escaped_value [%e arg ] ] - [@metaloc arg.pexp_loc] - in - List.map aux res - in - push, flush - - module SSet = Set.Make (String) - - let push_injection, flush_injections = - let buffer : (_ * _ * _) list ref = ref [] in - let gen_ids = ref SSet.empty in - let push ?ident id orig_expr = - if not (SSet.mem id !gen_ids) then - (gen_ids := SSet.add id !gen_ids; - buffer := (id, orig_expr,ident) :: !buffer) - in - let flush_all () = - let res = List.rev !buffer in - gen_ids := SSet.empty; - buffer := []; - res - in - let global_known = ref SSet.empty in - let flush () = - let all = flush_all () in - let novel = - let is_fresh (gen_id, _,_) = - not (SSet.mem gen_id !global_known) - in - List.filter is_fresh all - in - List.iter - (function gen_id, _, _ -> - global_known := SSet.add gen_id !global_known) - novel; - all - in - push, flush - - (* For every injection of $orig_expr$ as $gen_id$: - let $gen_id$ = $orig_expr$ and ... - (Necessary for injections in shared section) *) - let bind_injected_idents injections = - assert (injections <> []); - let bindings = - List.map - (fun (txt, expr,_) -> - let loc = expr.pexp_loc in - Vb.mk ~loc (Pat.var ~loc {txt;loc}) expr) - injections - in - Str.value Nonrecursive bindings - - let close_server_section loc = - [%stri - let () = - Eliom_syntax.close_server_section - [%e eid @@ id_file_hash loc] - ] [@metaloc loc] - - let may_close_server_section ~no_fragment loc = - if no_fragment - then [] - else [close_server_section loc] - - - let close_client_section loc injections = - assert (injections <> []) ; - let injection_list = - List.fold_right - (fun (txt, expr, ident) sofar -> - let loc = expr.pexp_loc in - let loc_expr = position loc in - let frag_eid = eid {txt;loc} in - let ident = match ident with - | None -> [%expr None] - | Some i -> [%expr Some [%e AC.str i ]] in - let (_, num) = Mli.get_injected_ident_info txt in - [%expr - ([%e AC.int num], - Eliom_lib.to_poly [%e frag_eid ], - [%e loc_expr], [%e ident ]) :: [%e sofar ] - ]) - injections - [%expr []] - in - [%stri - let () = - Eliom_syntax.close_client_section - [%e eid @@ id_file_hash loc ] - [%e injection_list ] - ][@metaloc loc] - - - (** Syntax extension *) - - let client_str item = - let all_injections = flush_injections () in - let loc = item.pstr_loc in - match all_injections with - | [] -> [] - | l -> - bind_injected_idents l :: - [ close_client_section loc all_injections ] - - let server_str no_fragment item = - let loc = item.pstr_loc in - item :: - may_close_server_section ~no_fragment loc - - let shared_str no_fragment item = - let all_injections = flush_injections () in - let loc = item.pstr_loc in - let cl = - item :: - may_close_server_section ~no_fragment loc - in - match all_injections with - | [] -> cl - | l -> - bind_injected_idents l :: - cl @ - [ close_client_section loc all_injections ] - - let fragment ?typ ~context:_ ~num ~id expr = - let typ = - match typ with - | Some typ -> typ - | None when not (Mli.exists ()) -> - [%type: _] - | None -> - match Mli.find_fragment id with - | { ptyp_desc = Ptyp_var _ } -> - let loc = expr.pexp_loc in - Typ.extension ~loc @@ AM.extension_of_error @@ Location.errorf ~loc - "The types of client values must be monomorphic from its usage \ - or from its type annotation" - | typ -> typ - in - let loc = expr.pexp_loc in - let e = format_args @@ flush_escaped_bindings () in - [%expr - (Eliom_syntax.client_value - ~pos:([%e position loc ]) - [%e AC.str num ] - [%e e ] - : [%t typ ] Eliom_client_value.t) - ][@metaloc loc] - - let escape_inject ?ident ~(context:Context.escape_inject) ~id expr = - match context with - | `Escaped_value _ -> - push_escaped_binding expr id; - [%expr assert false ] - | `Injection _ -> - push_injection ?ident id.txt expr; - eid id - - let set_global ~loc b = - let b = Exp.construct ~loc - {loc ; txt = Longident.Lident (if b then "true" else "false")} None - in - [%stri let () = Eliom_syntax.set_global [%e b ] ] - - let prelude loc = [ set_global ~loc true ] - let postlude loc = [ set_global ~loc false ] - - let shared_sig item = [item] - let server_sig item = [item] - let client_sig _ = [] - -end - -include Make(Pass) diff --git a/src/ppx/ppx_eliom_server.mli b/src/ppx/ppx_eliom_server.mli deleted file mode 100644 index be5a2dd400..0000000000 --- a/src/ppx/ppx_eliom_server.mli +++ /dev/null @@ -1,2 +0,0 @@ - -val mapper : string list -> Ast_mapper.mapper diff --git a/src/ppx/ppx_eliom_server_ex.ml b/src/ppx/ppx_eliom_server_ex.ml deleted file mode 100644 index e2e89a829b..0000000000 --- a/src/ppx/ppx_eliom_server_ex.ml +++ /dev/null @@ -1,2 +0,0 @@ - -let () = Ast_mapper.run_main Ppx_eliom_server.mapper diff --git a/src/ppx/ppx_eliom_type.ml b/src/ppx/ppx_eliom_type.ml deleted file mode 100644 index a6741c9461..0000000000 --- a/src/ppx/ppx_eliom_type.ml +++ /dev/null @@ -1,142 +0,0 @@ -(* Ocsigen - * http://www.ocsigen.org - * Copyright (C) 2010-2011 - * Raphaël Proust, Grégoire Henry, Gabriel Radanne - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, with linking exception; - * either version 2.1 of the License, or (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - *) - -(* This module generates the file used to infer types (hence wrappers) of server - escaped values. - - Server-specific and escaped expression will be kept only for - type-checking. In order to export type of escaped expressions: it - generates for each escaped expression a toplevel definition that - looks like: - - let $global_id$ = ref None - - And client-side expressions are replaced by lists of initializers - (one per escaped expressions): - - $global_id$ := Some $expr$ - -*) -open Parsetree -open Asttypes -open Ast_helper - -module AC = Ast_convenience -module AM = Ast_mapper - -open Ppx_eliom_utils - -module Pass = struct - - (* accumulator, push and flush for typing expression - $gen_id := Some $orig_expr *) - let push_typing_expr, flush_typing_expr = - let typing_expr = ref [] in - let add orig_expr id = - if List.for_all (function id', _ -> id.txt <> id'.txt) !typing_expr - then - let frag_eid = eid id in - typing_expr := - (id, - [%expr [%e frag_eid] := Some [%e orig_expr]] - [@metaloc orig_expr.pexp_loc] - ) :: !typing_expr - in - let flush () = - let res = List.rev (List.map snd !typing_expr) in - typing_expr := []; - AC.sequence res - in - add, flush - - (* accumulator, push and flush for typing str - let $id = ref None - *) - let push_typing_str_item, flush_typing_str_item = - let typing_strs = ref [] in - let add orig_expr id = - if List.for_all (function id', _ -> id'.txt <> id.txt) !typing_strs - then - typing_strs := - (id, - [%stri let [%p Pat.var id] = Pervasives.ref None] - [@metaloc orig_expr.pexp_loc] - ) :: !typing_strs - in - let flush () = - let res = List.map snd !typing_strs in - typing_strs := []; - res - in - add, flush - - (** Syntax extension *) - - let client_str item = - let loc = item.pstr_loc in - flush_typing_str_item () @ - [%str let () = [%e flush_typing_expr () ] ] [@metaloc loc] - - let server_str _ item = - flush_typing_str_item () @ - [ item ] - - let shared_str _ item = - let loc = item.pstr_loc in - flush_typing_str_item () @ - [%str let () = [%e flush_typing_expr () ] ] [@metaloc loc] @ - [ item ] - - let fragment ?typ ~context:_ ~num:_ ~id expr = - let loc = expr.pexp_loc in - let frag_eid = eid id in - push_typing_str_item expr id; - let typ = match typ with - | Some typ -> typ - | None -> Typ.any ~loc () - in - [%expr - [%e flush_typing_expr () ]; - [%e frag_eid] := - Some ( Eliom_syntax.client_value "" 0 : - [%t typ] Eliom_client_value.t); - match ! [%e frag_eid] with - | Some x -> (x : _ Eliom_client_value.t) - | None -> assert false - ] - - let escape_inject ?ident:_ ~(context:Context.escape_inject) ~id expr = - push_typing_str_item expr id; - push_typing_expr expr id; - match context with - | `Escaped_value _ -> [%expr assert false] - | `Injection `Shared -> expr - | `Injection `Client -> [%expr assert false] - - let prelude _ = [] - let postlude _ = [] - - let shared_sig _ = [] - let server_sig _ = [] - let client_sig _ = [] - -end - -include Make(Pass) diff --git a/src/ppx/ppx_eliom_type.mli b/src/ppx/ppx_eliom_type.mli deleted file mode 100644 index be5a2dd400..0000000000 --- a/src/ppx/ppx_eliom_type.mli +++ /dev/null @@ -1,2 +0,0 @@ - -val mapper : string list -> Ast_mapper.mapper diff --git a/src/ppx/ppx_eliom_types_ex.ml b/src/ppx/ppx_eliom_types_ex.ml deleted file mode 100644 index 895e1c5a57..0000000000 --- a/src/ppx/ppx_eliom_types_ex.ml +++ /dev/null @@ -1,2 +0,0 @@ - -let () = Ast_mapper.run_main Ppx_eliom_type.mapper diff --git a/src/ppx/ppx_eliom_utils.ml b/src/ppx/ppx_eliom_utils.ml deleted file mode 100644 index c7a4495a9d..0000000000 --- a/src/ppx/ppx_eliom_utils.ml +++ /dev/null @@ -1,683 +0,0 @@ -open Parsetree -open Ast_helper - -module AM = Ast_mapper -module AC = Ast_convenience - -(** Various misc functions *) - -let flatmap f l = List.flatten @@ List.map f l - -let get_extension = function - | {pexp_desc= Pexp_extension ({txt},_)} -> txt - | _ -> invalid_arg "Eliom ppx: Should be an extension." - -let in_context cref c f x = - let old = !cref in - cref := c ; - let res = f x in - cref := old ; - res - -let (%) f g x = f (g x) - -let exp_add_attrs attr e = - {e with pexp_attributes = attr} - -let eid {Location. txt ; loc } = - Exp.ident ~loc { loc ; txt = Longident.Lident txt } - -let format_args = function - | [] -> AC.unit () - | [e] -> e - | l -> Exp.tuple l - -let pat_args = function - | [] -> AC.punit () - | [p] -> p - | l -> Pat.tuple l - -(* We use a strong hash (MD5) of the file name. - We only keep the first 36 bit, which should be well enough: with - 256 files, the likelihood of a collision is about one in two - millions. - These bits are encoded using an OCaml-compatible variant of Base - 64, as the hash is used to generate OCaml identifiers. *) -let file_hash loc = - let s = Digest.string loc.Location.loc_start.pos_fname in - let e = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789_'" in - let o = Bytes.create 6 in - let g p = Char.code s.[p] in - for i = 0 to 5 do - let p = i * 6 / 8 in - let d = 10 - (i * 6) mod 8 in - Bytes.set o i e.[(g p lsl 8 + g (p + 1)) lsr d land 63] - done; - for i = 0 to 4 do - (* Prevent problematic '_ pattern. This confuses our sed - invocation in eliomc. Simply replacing the pattern here is - easier than tightening the sed expression. *) - if Bytes.get o i = '\'' && Bytes.get o (i + 1) = '_' then Bytes.set o i 'Z' - done; - Bytes.to_string o - -let id_file_hash loc = - let prefix = "__eliom__compilation_unit_id__" in - {Location. loc ; txt = prefix ^ file_hash loc} - -(** [let __eliom__compilation_unit_id__HASH = "HASH"] - We hoist the file hash at the beginning of each eliom file. - This makes the generated javascript code smaller. -*) -let module_hash_declaration loc = - let id = Pat.var ~loc @@ id_file_hash loc in - Str.value ~loc Nonrecursive [Vb.mk ~loc id @@ AC.str @@ file_hash loc] - -(** The first position in a file, if it exists. - We avoid {!Location.input_name}, as it's unreliable when reading multiple files. -*) -let file_position str = match str with - | { pstr_loc } :: _ -> Location.in_file @@ pstr_loc.loc_start.pos_fname - | [] -> Location.none - -let lexing_position ~loc l = - [%expr - { Lexing.pos_fname = [%e AC.str l.Lexing.pos_fname]; - Lexing.pos_lnum = [%e AC.int @@ l.Lexing.pos_lnum]; - Lexing.pos_bol = [%e AC.int @@ l.Lexing.pos_bol]; - Lexing.pos_cnum = [%e AC.int @@ l.Lexing.pos_cnum]; } - ] [@metaloc loc] - -let position loc = - let start = loc.Location.loc_start in - let stop = loc.Location.loc_start in - Exp.tuple ~loc [ lexing_position ~loc start ; lexing_position ~loc stop ] - -let is_annotation txt l = - List.exists (fun s -> txt = s || txt = "eliom."^s) l - -(** Identifiers generation. *) -module Name = struct - - let escaped_ident_fmt : _ format6 = - "_eliom_escaped_ident_%Ld" - - let fragment_ident_fmt : _ format6 = - "_eliom_fragment_%s" - - let injected_ident_fmt : _ format6 = - "_eliom_injected_ident_%6s%d" - - (* Identifiers for the closure representing a fragment. *) - let fragment_num_count = ref 0 - let fragment_num _loc = - incr fragment_num_count; - Printf.sprintf "%s%d" (file_hash _loc) !fragment_num_count - let fragment_ident id = - Printf.sprintf fragment_ident_fmt id - - (* Globaly unique ident for escaped expression *) - (* It's used for type inference and as argument name for the - closure representing the surrounding fragment. *) - (* Inside a fragment, same ident share the global ident. *) - let escaped_idents = ref [] - let reset_escaped_ident () = escaped_idents := [] - let escaped_expr, escaped_ident = - let r = ref 0L in - let make () = - r := Int64.(add one) !r ; - Printf.sprintf escaped_ident_fmt !r - in - let for_expr loc = Location.mkloc (make ()) loc in - let for_id loc id = - let txt = - try List.assoc id !escaped_idents - with Not_found -> - let gen_id = make () in - escaped_idents := (id, gen_id) :: !escaped_idents; - gen_id - in {Location. txt ; loc } - in for_expr, for_id - - let injected_expr, injected_ident, reset_injected_ident = - let injected_idents = ref [] in - let r = ref 0 in - let gen_ident loc = - let hash = file_hash loc in - incr r; - let s = Printf.sprintf injected_ident_fmt hash !r in - {Location. txt = s ; loc } - in - let gen_injected_ident loc (s:string) = - try List.assoc s !injected_idents - with Not_found -> - let gen_id = gen_ident loc in - injected_idents := (s, gen_id) :: !injected_idents; - gen_id - and reset () = injected_idents := [] in - gen_ident, gen_injected_ident, reset - -end - -(* WARNING: if you change this, also change inferred_type_prefix in - tools/eliomc.ml and ocamlbuild/ocamlbuild_eliom.ml *) -let inferred_type_prefix = "eliom_inferred_type_" - -module Mli = struct - - let type_file = ref None - let get_type_file () = match !type_file with - | None -> Filename.chop_extension !Location.input_name ^ ".type_mli" - | Some f -> f - - let exists () = match !type_file with Some _ -> true | _ -> false - - let suppress_underscore = - let rename = - let c = ref 0 in - fun s -> incr c; Printf.sprintf "an_%s_%d" s !c - and has_pfix = - let len = String.length inferred_type_prefix in - fun s -> - String.length s >= len && - String.sub s 0 len = inferred_type_prefix - in - let typ mapper ty = match ty.ptyp_desc with - (* | Ptyp_constr (_, Ast.TyAny _, ty) *) - (* | Ptyp_constr (_, ty, Ast.TyAny _) -> ty *) - | Ptyp_var var when has_pfix var -> - mapper.AM.typ mapper - {ty with - ptyp_desc = Ptyp_var (rename var) - } - | _ -> AM.default_mapper.typ mapper ty in - let m = { AM.default_mapper with typ } in - m.AM.typ m - - let is_injected_ident id = - try Scanf.sscanf id Name.injected_ident_fmt (fun _ _ -> true) - with Scanf.Scan_failure _ -> false - - let is_escaped_ident id = - try Scanf.sscanf id Name.escaped_ident_fmt (fun _ -> true) - with Scanf.Scan_failure _ -> false - - let is_fragment_ident id = - try Scanf.sscanf id Name.fragment_ident_fmt (fun _ -> true) - with Scanf.Scan_failure _ -> false - - let get_injected_ident_info id = - Scanf.sscanf id Name.injected_ident_fmt (fun u n -> (u, n)) - - let get_fragment_type = function - | [%type: [%t? typ] Eliom_client_value.fragment ] - | [%type: [%t? typ] Eliom_client_value.t ] -> - Some typ - | _ -> None - - let get_binding sig_item = match sig_item.psig_desc with - | 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 then - match get_fragment_type typ with - | Some typ -> Some (txt, suppress_underscore typ) - | None -> None - else - None - | _ -> None - - let load_file file = - try - let items = - Pparse.parse_interface ~tool_name:"eliom" Format.err_formatter file - in - let h = Hashtbl.create 17 in - let f item = match get_binding item with - | Some (s, typ) -> Hashtbl.add h s typ - | None -> () - in - List.iter f items ; - h - with - | Sys_error s -> - Location.raise_errorf - ~loc:(Location.in_file file) - "Eliom: Error while loading types: %s" s - - let inferred_sig = lazy (load_file (get_type_file ())) - - let find err {Location. txt ; loc } = - try Hashtbl.find (Lazy.force inferred_sig) txt with - | Not_found -> - Typ.extension ~loc @@ AM.extension_of_error @@ Location.errorf ~loc - "Error: Inferred type of %s not found. You need to regenerate %s." - err (get_type_file ()) - - let find_escaped_ident = find "escaped ident" - let find_injected_ident = find "injected ident" - let find_fragment = find "client value" - -end - -(** Context convenience module. *) -module Context = struct - - type server = [ `Server | `Shared ] - type client = [ `Client | `Shared ] - - let of_string = function - | "server" | "server.start" - | "eliom.server" | "eliom.server.start" -> `Server - | "shared" | "shared.start" - | "eliom.shared" | "eliom.shared.start" -> `Shared - | "client" | "client.start" - | "eliom.client" | "eliom.client.start" -> `Client - | _ -> invalid_arg "Eliom ppx: Not a context" - - type escape_inject = [ - | `Escaped_value of server - | `Injection of client - ] - - type t = [ - | `Server (* [%%server ... ] *) - | `Client (* [%%client ... ] *) - | `Shared (* [%%shared ... ] *) - | `Fragment of server (* [%client ... ] *) - | `Escaped_value of server (* [%shared ~%( ... ) ] *) - | `Injection of client (* [%%client ~%( ... ) ] *) - ] -end - - -let match_args = function - | [ ] -> () - | [ "-type" ; type_file ] -> Mli.type_file := Some type_file - | [ "-notype" ] -> Mli.type_file := None - | args -> Location.raise_errorf ~loc:Location.(in_file !input_name) - "Wrong arguments:@ %s" (String.concat " " args) - -(** Signature of specific code of a preprocessor. *) -module type Pass = sig - - (** How to handle "client", "shared" and "server" sections for top level structure items. *) - - val shared_str: bool -> structure_item -> structure_item list - val server_str: bool -> structure_item -> structure_item list - val client_str: structure_item -> structure_item list - - (** How to handle "client", "shared" and "server" sections for top level signature items. *) - - val shared_sig: signature_item -> signature_item list - val client_sig: signature_item -> signature_item list - val server_sig: signature_item -> signature_item list - - (** How to handle "[%client ...]" and "[%shared ...]" expr. *) - val fragment: - ?typ:core_type -> context:Context.server -> - num:string -> id:string Location.loc -> - expression -> expression - - (** How to handle escaped "~%ident" inside a fragment. *) - val escape_inject: - ?ident:string -> context:Context.escape_inject -> - id:string Location.loc -> - expression -> expression - - val prelude : loc -> structure - val postlude : loc -> structure - -end - -(** These functions try to guess if a given expression will lead to a fragment evaluation - This is not possible in general, this criteria is only syntactic - - If the expression cannot have fragments, we don't need to use sections. - Consequently, this function should *never* return false positive. -*) -module Cannot_have_fragment = struct - - let opt_forall p = function - | None -> true - | Some x -> p x - - let vb_forall p l = - let p x = p x.pvb_expr in - List.for_all p l - - let rec longident = function - | Longident.Lident _ -> true - | Longident.Ldot (x,_) -> longident x - | Longident.Lapply (_,_) -> false - - let rec expression e = match e.pexp_desc with - | Pexp_ident _ - | Pexp_constant _ - | Pexp_function _ - | Pexp_lazy _ - | Pexp_fun _ - -> true - - | Pexp_newtype (_,e) - | Pexp_assert e - | Pexp_field (e,_) - | Pexp_constraint (e,_) - | Pexp_coerce (e,_,_) - | Pexp_poly (e,_) - | Pexp_try (e,_) -> expression e - - | Pexp_ifthenelse (b,e1,e2) -> - expression b && expression e1 && opt_forall expression e2 - | Pexp_sequence (e1,e2) - | Pexp_setfield (e1,_,e2) -> expression e1 && expression e2 - | Pexp_array l - | Pexp_tuple l -> List.for_all expression l - | Pexp_record (l,e) -> - let p x = expression @@ snd x in - opt_forall expression e && List.for_all p l - - | Pexp_construct (_,e) - | Pexp_variant (_,e) -> opt_forall expression e - | Pexp_let (_,l,e) -> vb_forall expression l && expression e - | Pexp_open (_,x,e) -> longident x.txt && expression e - | Pexp_letmodule (_,me,e) -> module_expr me && expression e - - (* We could be more precise on those constructs *) - | Pexp_object _ - | Pexp_while _ - | Pexp_for _ - | Pexp_match _ - | Pexp_pack _ - -> false - - (* We can't say more using syntactic information. *) - | Pexp_extension _ - | Pexp_send _ - | Pexp_new _ - | Pexp_setinstvar _ - | Pexp_override _ - | Pexp_apply _ - | _ - -> false - - and module_expr x = match x.pmod_desc with - | Pmod_ident l -> longident l.txt - | Pmod_functor _ -> true - | Pmod_unpack e -> expression e - | Pmod_constraint (e,_) -> module_expr e - | Pmod_structure l -> List.for_all structure_item l - - | Pmod_apply _ - | _ - -> false - - and module_binding m = module_expr m.pmb_expr - - and structure_item x = match x.pstr_desc with - | Pstr_type _ - | Pstr_typext _ - | Pstr_exception _ - | Pstr_modtype _ - | Pstr_class _ - | Pstr_class_type _ - -> true - - | Pstr_eval (e,_) -> expression e - | Pstr_value (_,vb) -> vb_forall expression vb - | Pstr_primitive _ -> true - | Pstr_module mb -> module_binding mb - | Pstr_recmodule mbl -> List.for_all module_binding mbl - | Pstr_open x -> longident x.popen_lid.txt - | Pstr_include x -> module_expr x.pincl_mod - - | _ -> false - -end - -(** - Replace shared expression by the equivalent pair. - - [ [%share - let x = ... %s ... in - [%client ... %x ... ] - ] ] - ≡ - [ let x = ... s ... in - [%client ... %x ... ] - , - [%client - let x = ... %s ... in - ... x ... - ] - ] -*) -module Shared = struct - - let server_expr mapper expr = - match expr with - | [%expr [%client [%e? _ ]]] -> expr - | [%expr ~% [%e? injection_expr ]] -> injection_expr - | _ -> AM.default_mapper.expr mapper expr - let server = {AM.default_mapper with expr = server_expr} - - let client_expr context mapper expr = - match expr with - | [%expr [%client [%e? fragment_expr ]]] -> - in_context context `Fragment - (mapper.AM.expr mapper) fragment_expr - | [%expr ~% [%e? injection_expr ]] -> - begin match !context with - | `Top -> expr - | `Fragment -> injection_expr - end - | _ -> AM.default_mapper.expr mapper expr - let client = {AM.default_mapper with expr = client_expr (ref `Top)} - - let expr loc expr = - let server_expr = server.AM.expr server expr in - let client_expr = client.AM.expr client expr in - [%expr - Eliom_shared.Value.create - [%e server_expr] - [%client [%e client_expr]] - ] [@metaloc loc] -end - -module Make (Pass : Pass) = struct - - let eliom_expr (context : Context.t ref) mapper expr = - let loc = expr.pexp_loc in - let attr = expr.pexp_attributes in - match expr, !context with - | {pexp_desc = Pexp_extension ({txt},_)}, - `Client - when is_annotation txt ["client"; "shared"] -> - let side = get_extension expr in - Exp.extension @@ AM.extension_of_error @@ Location.errorf ~loc - "The syntax [%%%s ...] is not allowed inside client code." - side - | {pexp_desc = Pexp_extension ({txt},_)} - , (`Fragment _ | `Escaped_value _ | `Injection _) - when is_annotation txt ["client"; "shared"] -> - let side = get_extension expr in - Exp.extension @@ AM.extension_of_error @@ Location.errorf ~loc - "The syntax [%%%s ...] can not be nested." - side - - (* [%shared ... ] *) - | {pexp_desc = Pexp_extension ({txt},PStr [{pstr_desc = Pstr_eval (side_val,attr')}])}, - (`Server | `Shared) - when is_annotation txt ["shared"] -> - let e = Shared.expr loc side_val in - mapper.AM.expr mapper @@ exp_add_attrs (attr@attr') e - - (* [%client ... ] *) - | {pexp_desc = Pexp_extension ({txt},PStr [{pstr_desc = Pstr_eval (side_val,attr)}])}, - (`Server | `Shared as c) - when is_annotation txt ["client"] -> - Name.reset_escaped_ident () ; - let side_val, typ = match side_val with - | [%expr ([%e? cval]:[%t? typ]) ] -> (cval, Some typ) - | _ -> (side_val, None) - in - let num = Name.fragment_num side_val.pexp_loc in - let id = Location.mkloc (Name.fragment_ident num) side_val.pexp_loc in - in_context context (`Fragment c) - (Pass.fragment ?typ ~context:c ~num ~id % mapper.AM.expr mapper) - (exp_add_attrs attr side_val) - - (* ~%( ... ) ] *) - | [%expr ~% [%e? inj ]], _ -> - let ident = match inj.pexp_desc with - | Pexp_ident i -> Some (String.concat "_" @@ Longident.flatten i.txt) - | _ -> None - in - begin match !context with - | `Client | `Shared as c -> - let id = match ident with - | Some id -> Name.injected_ident loc id - | None -> Name.injected_expr loc - in - let new_context = `Injection c in - in_context context new_context - (Pass.escape_inject ?ident ~context:new_context ~id % - mapper.AM.expr mapper) - inj - | `Fragment c -> - let id = match ident with - | None -> Name.escaped_expr loc - | Some id -> Name.escaped_ident loc id - in - let new_context = `Escaped_value c in - in_context context new_context - (Pass.escape_inject ?ident ~context:new_context ~id % - mapper.AM.expr mapper) - inj - | `Server -> - Location.raise_errorf ~loc - "The syntax ~%% ... is not allowed inside server code." - | `Escaped_value _ | `Injection _ -> - Location.raise_errorf ~loc - "The syntax ~%% ... can not be nested." - end - | _ -> AM.default_mapper.expr mapper expr - - let structure_item mapper str = - let loc = str.pstr_loc in - match str.pstr_desc with - | Pstr_extension (({txt=("server"|"shared"|"client")}, _), _) -> - Location.raise_errorf ~loc - "Sections are only allowed at toplevel." - | _ -> AM.default_mapper.structure_item mapper str - - let signature_item mapper sig_ = - let loc = sig_.psig_loc in - match sig_.psig_desc with - | Psig_extension (({txt=("server"|"shared"|"client")}, _), _) -> - Location.raise_errorf ~loc "Sections are only allowed at toplevel." - | _ -> AM.default_mapper.signature_item mapper sig_ - - let eliom_mapper context = - let context = ref (context :> Context.t) in - { Ast_mapper.default_mapper - with - Ast_mapper. - - expr = eliom_expr context ; - - (* Reject sections not at toplevel. *) - structure_item ; - signature_item ; - } - - - (** Toplevel translation *) - (** Switch the current context when encountering [%%server] (resp. shared, client) - annotations. Call the eliom mapper and [Pass.server_str] (resp ..) on each - structure item. - *) - - let dispatch_str context _mapper stri = - (* We must do this before any transformation on the structure. *) - let no_fragment = Cannot_have_fragment.structure_item stri in - let f = match context with - | `Server -> Pass.server_str no_fragment - | `Shared -> Pass.shared_str no_fragment - | `Client -> Pass.client_str - in - let m = eliom_mapper context in - f @@ m.AM.structure_item m stri - - let dispatch_sig context _mapper sigi = - let f = match context with - | `Server -> Pass.server_sig - | `Shared -> Pass.shared_sig - | `Client -> Pass.client_sig - in - let m = eliom_mapper context in - f @@ m.AM.signature_item m sigi - - let toplevel_structure context mapper structs = - let f pstr = - let loc = pstr.pstr_loc - and maybe_reset_injected_idents = function - | `Client | `Shared -> - Name.reset_injected_ident (); - | _ -> - () - in - match pstr.pstr_desc with - | Pstr_extension (({txt}, PStr strs), _) - when is_annotation txt ["shared.start"; - "client.start"; - "server.start"] -> - if strs <> [] then - [ Str.extension ~loc @@ AM.extension_of_error @@ Location.errorf ~loc - "The %%%%%s extension doesn't accept arguments." txt ] - else ( - maybe_reset_injected_idents !context ; - context := Context.of_string txt ; - [] - ) - | 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 mapper) strs in - maybe_reset_injected_idents c ; l - | _ -> - dispatch_str !context mapper pstr - in - let loc = {(file_position structs) with loc_ghost = true} in - module_hash_declaration loc :: - Pass.prelude loc @ - flatmap f structs @ - Pass.postlude loc - - let toplevel_signature context mapper sigs = - let f psig = - let loc = psig.psig_loc in - match psig.psig_desc with - | Psig_extension (({txt}, PStr strs), _) - when is_annotation txt ["shared.start"; "client.start" ;"server.start"] -> - if strs <> [] then - [ Sig.extension ~loc @@ AM.extension_of_error @@ Location.errorf ~loc - "The %%%%%s extension doesn't accept arguments." txt ] - else ( context := Context.of_string txt ; [] ) - | _ -> - dispatch_sig !context mapper psig - in - flatmap f sigs - - let mapper args = - let () = match_args args in - let c = ref `Server in - {AM.default_mapper - with - structure = toplevel_structure c ; - signature = toplevel_signature c ; - } - -end diff --git a/src/ppx/ppx_eliom_utils.mli b/src/ppx/ppx_eliom_utils.mli deleted file mode 100644 index 4b33cb5669..0000000000 --- a/src/ppx/ppx_eliom_utils.mli +++ /dev/null @@ -1,89 +0,0 @@ -open Parsetree - -(** {2 Various helping functions} *) - -(** Name of the variable which holds the hash of the file. *) -val id_file_hash : Location.t -> string Location.loc - -val eid : string Location.loc -> expression - -val position : Location.t -> expression - -val format_args : expression list -> expression - -val pat_args : pattern list -> pattern - -(** Context convenience module. *) -module Context : sig - - type server = [ `Server | `Shared ] - type client = [ `Client | `Shared ] - - type escape_inject = [ - | `Escaped_value of server - | `Injection of client - ] - - type t = [ - | `Server (* [%%server ... ] *) - | `Client (* [%%client ... ] *) - | `Shared (* [%%shared ... ] *) - | `Fragment of server (* [%client ... ] *) - | `Escaped_value of server (* [%%server [%client ~%( ... ) ] ] *) - | `Injection of client (* [%%client ~%( ... ) ] *) - ] -end - -module Mli : sig - - val is_escaped_ident : string -> bool - - val get_injected_ident_info : string -> (string * int) - - val exists : unit -> bool - - val find_escaped_ident : string Location.loc -> core_type - val find_injected_ident : string Location.loc -> core_type - val find_fragment : string Location.loc -> core_type - -end - -(** Signature of specific code of a preprocessor. *) -module type Pass = sig - - (** How to handle "client", "shared" and "server" sections for top level structure items. - - For shared and server, the boolean argument indicate if this - declaration can lead to evaluation of a fragment. - *) - - val shared_str: bool -> structure_item -> structure_item list - val server_str: bool -> structure_item -> structure_item list - val client_str: structure_item -> structure_item list - - (** How to handle "client", "shared" and "server" sections for top level signature items. *) - - val shared_sig: signature_item -> signature_item list - val client_sig: signature_item -> signature_item list - val server_sig: signature_item -> signature_item list - - (** How to handle "[%client ...]" and "[%shared ...]" expr. *) - val fragment: - ?typ:core_type -> context:Context.server -> - num:string -> id:string Location.loc -> - expression -> expression - - (** How to handle escaped "~%ident" inside a fragment. *) - val escape_inject: - ?ident:string -> context:Context.escape_inject -> - id:string Location.loc -> - expression -> expression - - val prelude : Location.t -> structure - val postlude : Location.t -> structure - -end - -module Make (P : Pass) : sig - val mapper : string list -> Ast_mapper.mapper -end diff --git a/src/syntax/pa_eliom_client_client.ml b/src/syntax/pa_eliom_client_client.ml deleted file mode 100644 index ffe92cfc5e..0000000000 --- a/src/syntax/pa_eliom_client_client.ml +++ /dev/null @@ -1,319 +0,0 @@ -(* Ocsigen - * http://www.ocsigen.org - * Copyright (C) 2010-2011 - * Raphaël Proust, Grégoire Henry, Benedikt Becker - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, with linking exception; - * either version 2.1 of the License, or (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - *) - -(* This prepocessor generates the code to be executed by the navigator. *) - -(* BB {2 map_get_escaped_values / escape_inject generates only $lid:gen_id$} - The expression $expr$ inside a client_value will be used for for registering - the client closure (cf. [Client_pass.register_client_closures]), as well as - for creating a client-only function (cf. [Client_pass.define_client_functions]). - Only for the former it is necessary to call [Eliom_client_core.Syntax_helpers.get_escaped_value] - on the escaped identifier. - This is done post-hoc by [map_get_escaped_values] in [register_client_closures]. *) - -module Id = struct - let name = "client part" -end - -module Client_pass(Helpers : Pa_eliom_seed.Helpers) = struct - - open Helpers.Syntax - - let notyp = ref false - let _ = - Camlp4.Options.add "-notype" (Arg.Set notyp) "(not documented)" - - (* {2 Auxiliaries} *) - - (* Replace every type [t client_value] by [t]. *) - let drop_client_value_ctyp = - let ast_mapper = - Ast.map_ctyp - (fun typ -> - match Helpers.is_client_value_type typ with - | Some typ' -> typ' - | None -> typ) - in - fun typ -> ast_mapper#ctyp typ - - (* Replace every escaped identifier [v] with - [Eliom_client_core.Syntax_helpers.get_escaped_value v] *) - let map_get_escaped_values ?nested:(nested = false) = - let mapper = - Ast.map_expr - (function - | <:expr@_loc< $lid:str$ >> - when Helpers.is_escaped_indent_string str -> - <:expr< - Eliom_client_core.Syntax_helpers.get_escaped_value - $lid:str$ >> - | <:expr@_loc< $lid:str$ >> - when (Helpers.is_nested_escaped_indent_string str && - nested) -> - <:expr< - Eliom_client_core.Syntax_helpers.get_escaped_value - $lid:str$ >> - | expr -> - expr) - in - fun expr -> - mapper#expr expr - - let push_escaped_binding, flush_escaped_bindings = - let server_arg_ids = ref [] in - let is_unknown gen_id = - List.for_all - (fun (gen_id', _) -> gen_id <> gen_id') - !server_arg_ids - in - let push gen_id expr = - if is_unknown gen_id then - server_arg_ids := (gen_id, expr) :: !server_arg_ids - in - let flush () = - let res = List.rev !server_arg_ids in - server_arg_ids := []; - res - in - push, flush - - let push_escaped_binding_nested, flush_escaped_bindings_nested = - let server_arg_ids = ref [] in - let is_unknown gen_id = - List.for_all - (fun (gen_id', _) -> gen_id <> gen_id') - !server_arg_ids - in - let push gen_id expr = - if is_unknown gen_id then - server_arg_ids := (gen_id, expr) :: !server_arg_ids - and flush () = - let res = List.rev !server_arg_ids in - server_arg_ids := []; - res - in - push, flush - - let push_client_value_data, flush_client_value_datas = - let client_value_datas = ref [] in - let push gen_num gen_id expr nested args = - client_value_datas := - (gen_num, gen_id, expr, nested, args) :: !client_value_datas - in - let flush () = - let res = List.rev !client_value_datas in - client_value_datas := []; - res - in - push, flush - - let get_type f x = - if !notyp then - let _loc = Loc.ghost in - <:ctyp< _ >> - else f x - - let register_client_closures client_value_datas = - let registrations = - List.map - (fun (gen_num, _, expr, nested, args) -> - let typ = get_type Helpers.find_client_value_type gen_num in - let _loc = Ast.loc_of_expr expr in - <:expr< - Eliom_client_core.Syntax_helpers.register_client_closure - $str:gen_num$ - (fun $Helpers.patt_tuple args$ -> - ($map_get_escaped_values ~nested expr$ : $typ$)) - >>) - client_value_datas - in - let _loc = Loc.ghost in - <:str_item< let () = $Ast.exSem_of_list registrations$; () >> - - let define_client_functions client_value_datas = - let bindings = - List.map - (fun (gen_num, gen_id, expr, _, args) -> - let patt = - let _loc = Loc.ghost in - <:patt< $lid:gen_id$ >> - in - let typ = get_type Helpers.find_client_value_type gen_num in - let expr = - let _loc = Loc.ghost in - <:expr< - fun $Helpers.patt_tuple args$ -> - ($expr$ : $typ$) - >> - in - patt, expr) - client_value_datas - in - let _loc = Loc.ghost in - <:str_item< let $Ast.binding_of_pel bindings$ >> - - (* For injections *) - - let close_server_section loc = - let _loc = Loc.ghost in - <:str_item< - let () = - Eliom_client_core.Syntax_helpers.close_server_section - $str:Helpers.file_hash loc$ - >> - - let open_client_section loc = - let _loc = Loc.ghost in - <:str_item< - let () = - Eliom_client_core.Syntax_helpers.open_client_section - $str:Helpers.file_hash loc$ - >> - - (** Syntax extension *) - - let client_str_items loc items = - Ast.stSem_of_list - (open_client_section loc :: - items) - - let server_str_items loc _ = - Ast.stSem_of_list - [ register_client_closures (flush_client_value_datas ()); - close_server_section loc; ] - - let shared_str_items loc items = - let client_expr_data = flush_client_value_datas () in - Ast.stSem_of_list - (open_client_section loc :: - register_client_closures client_expr_data :: - define_client_functions client_expr_data :: - items @ - [ close_server_section loc ]) - - let client_value_expr typ context_level orig_expr gen_num gen_id loc = - - match context_level with - | `Server -> - let l = flush_escaped_bindings () in - push_client_value_data gen_num gen_id orig_expr false - (List.map fst l); - <:expr@loc< >> - | `Shared_expr _ -> - let l = flush_escaped_bindings_nested () in - push_client_value_data gen_num gen_id orig_expr true - (List.map fst l); - (* Escaped bindings can only refer to the parent client - context. To allow IDs that refer to the outer context, we - would need to determine whether an ID should be injected - by the server or not. This would require knowledge of - variable scopes. *) - let bindings = - List.map - (fun (gen_id, expr) -> - let _loc = Loc.ghost in - <:patt< $lid:gen_id$ >>, expr) - l - in - <:expr@loc< - let $Ast.binding_of_pel bindings$ in - $orig_expr$ >> - | `Shared -> - let l = flush_escaped_bindings () in - push_client_value_data gen_num gen_id orig_expr false - (List.map fst l); - let bindings = - List.map - (fun (gen_id, expr) -> - let _loc = Loc.ghost in - <:patt< $lid:gen_id$ >>, expr) - l - in - let args = - let _loc = Loc.ghost in - Helpers.expr_tuple - (List.map - (fun (gen_id, _) -> - <:expr< $lid:gen_id$ >>) - l) - in - <:expr@loc< - let $Ast.binding_of_pel bindings$ in - $lid:gen_id$ $args$ - >> ;; - - let shared_value_expr = client_value_expr - - let escape_inject context_level ?ident orig_expr gen_id = - let open Pa_eliom_seed in - let _loc = Ast.loc_of_expr orig_expr in - let assert_no_variables typ = - let f = function - | Ast.TyQuo _ as typ -> - Printf.eprintf - "%s: %s\n" - (Loc.to_string _loc) - ": Warning. The type of an injected value contains a type variable that could be wrongly inferred (to be fixed in Eliom)."; - typ - | typ -> typ - in - ignore ((Ast.map_ctyp f)#ctyp typ) - in - match context_level with - | Escaped_in_client_value_in (`Shared_expr _) -> - (* {section{ ... {shared#{ ... {{ ... }} ... }} ... }} *) - push_escaped_binding_nested gen_id orig_expr; - <:expr< $lid:gen_id$ >> - | Escaped_in_client_value_in _ - | Escaped_in_shared_value_in _ -> - (* {section{ ... {{ ... %x ... }} ... }} or - {section{ ... {shared# ... { ... %x ... }} ... }} *) - let typ = - drop_client_value_ctyp - (get_type Helpers.find_escaped_ident_type gen_id) - in - assert_no_variables typ; - push_escaped_binding gen_id orig_expr; - <:expr< ($lid:gen_id$ : $typ$) >> - | Injected_in _section -> - (* {_section{ ... %x ... }} *) - let typ = - drop_client_value_ctyp - (get_type Helpers.find_injected_ident_type gen_id) - in - assert_no_variables typ; - let ident = match ident with - | None -> <:expr> - | Some i -> <:expr> in - let (u, d) = Helpers.get_injected_ident_info gen_id in - let s = Printf.sprintf "%s%d" u d in - <:expr< - (Eliom_client_core.Syntax_helpers.get_injection ?ident:($ident$) ~pos:($Helpers.position _loc$) $str:s$ : $typ$) - >> - - let implem _ sil = sil - - let shared_sig_items _ items = Ast.sgSem_of_list items - let server_sig_items _ items = Ast.sgSem_of_list [] - let client_sig_items _ items = Ast.sgSem_of_list items - -end - -module M = Pa_eliom_seed.Register(Id)(Client_pass) diff --git a/src/syntax/pa_eliom_client_server.ml b/src/syntax/pa_eliom_client_server.ml deleted file mode 100644 index 3e8c6b581f..0000000000 --- a/src/syntax/pa_eliom_client_server.ml +++ /dev/null @@ -1,264 +0,0 @@ -(* Ocsigen - * http://www.ocsigen.org - * Copyright (C) 2010-2011 - * Raphaël Proust, Grégoire Henry - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, with linking exception; - * either version 2.1 of the License, or (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - *) - -(* This prepocessor generates the module to be loaded by Ocsigen server *) - -module Id = struct - let name = "server part" -end - -module Server_pass(Helpers : Pa_eliom_seed.Helpers) = struct - - open Helpers.Syntax - - let notyp = ref false - let _ = - Camlp4.Options.add "-notype" (Arg.Set notyp) "(not documented)" - - let push_escaped_binding, flush_escaped_bindings = - let arg_ids = ref [] in - let arg_collection = ref [] in - let push orig_expr gen_id = - if not (List.mem gen_id !arg_ids) then begin - let _loc = Ast.loc_of_expr orig_expr in - arg_collection := (gen_id, orig_expr) :: !arg_collection; - arg_ids := gen_id :: !arg_ids - end - in - let flush () = - let res = List.rev !arg_collection in - arg_ids := []; - arg_collection := []; - let aux (_, arg) = - let _loc = Ast.loc_of_expr arg in - <:expr< Eliom_syntax.escaped_value $arg$ >> - in - List.map aux res - in - push, flush - - let push_escaped_binding_nested, - flush_escaped_bindings_nested = - let arg_ids = ref [] in - let arg_collection = ref [] in - let push orig_expr gen_id = - if not (List.mem gen_id !arg_ids) then begin - arg_collection := (gen_id, orig_expr) :: !arg_collection; - arg_ids := gen_id :: !arg_ids - end - and flush () = - let res = List.rev !arg_collection - and aux (_, arg) = - let _loc = Ast.loc_of_expr arg in - <:expr< Eliom_syntax.escaped_value $arg$ >> - in - arg_ids := []; - arg_collection := []; - List.map aux res - in - push, flush - - let push_injection, flush_injections = - let module String_set = Set.Make (String) in - let buffer : (_ * _ * _) list ref = ref [] in - let gen_ids = ref String_set.empty in - let push ?ident gen_id orig_expr = - if not (String_set.mem gen_id !gen_ids) then - (gen_ids := String_set.add gen_id !gen_ids; - buffer := (gen_id, orig_expr,ident) :: !buffer) - in - let flush_all () = - let res = List.rev !buffer in - gen_ids := String_set.empty; - buffer := []; - res - in - let global_known = ref String_set.empty in - let flush () = - let all = flush_all () in - let novel = - let is_fresh (gen_id, _,_) = - not (String_set.mem gen_id !global_known) - in - List.filter is_fresh all - in - List.iter - (function gen_id, _, _ -> - global_known := String_set.add gen_id !global_known) - novel; - all - in - push, flush - - (* For every injection of $orig_expr$ as $gen_id$: - let $gen_id$ = $orig_expr$ and ... - (Necessary for injections in shared section) *) - let bind_injected_idents injections = - let _loc = Loc.ghost in - let bindings = - List.map - (fun (gen_id, orig_expr,_) -> - <:patt< $lid:gen_id$ >>, - orig_expr) - injections - in - <:str_item< let $Ast.binding_of_pel bindings$ >> - - let close_server_section loc = - let _loc = Loc.ghost in - <:str_item< - let () = - Eliom_syntax.close_server_section - $str:Helpers.file_hash loc$ - >> - - let close_client_section loc injections = - let _loc = Loc.ghost in - let injection_list = - List.fold_right - (fun (gen_id, expr, ident) sofar -> - let loc1 = Ast.loc_of_expr expr in - let loc1_expr = Helpers.position loc1 in - let ident = match ident with - | None -> <:expr> - | Some i -> <:expr< Some $str:i$>> in - let num = - string_of_int (snd (Helpers.get_injected_ident_info gen_id)) in - <:expr< ($int:num$, Eliom_lib.to_poly $lid:gen_id$, - $loc1_expr$, $ident$) :: $sofar$ >>) - injections <:expr< [] >> - in - <:str_item< - let () = - Eliom_syntax.close_client_section - $str:Helpers.file_hash loc$ - $injection_list$ - >> - - - (** Syntax extension *) - - let client_str_items loc _ = - let all_injections = flush_injections () in - Ast.stSem_of_list - [bind_injected_idents all_injections; - close_client_section loc all_injections] - - let server_str_items loc items = - Ast.stSem_of_list - (items @ - [ close_server_section loc ]) - - let shared_str_items loc items = - let all_injections = flush_injections () in - Ast.stSem_of_list - (bind_injected_idents all_injections :: - items @ - [ close_server_section loc; - close_client_section loc all_injections ]) - - let client_value_expr typ context_level orig_expr gen_id _ loc = - let typ = - match typ with - | Some typ -> typ - | None -> - if !notyp then - let _loc = Loc.ghost in <:ctyp< _ >> - else - match Helpers.find_client_value_type gen_id with - | Ast.TyQuo _ -> - Helpers.raise_syntax_error loc - "The types of client values must be monomorphic from its usage \ - or from its type annotation" - | typ -> typ - in - let _loc = Ast.loc_of_expr orig_expr - and l = - match context_level with - | `Shared_expr _ -> - flush_escaped_bindings_nested () - | _ -> - flush_escaped_bindings () - in - <:expr@loc< - (Eliom_syntax.client_value - ~pos:($Helpers.position _loc$) - $str:gen_id$ $Helpers.expr_tuple l$ - : $typ$ Eliom_client_value.t) >> ;; - - let shared_value_expr typ _ orig_expr gen_id _ loc = - let typ = - match typ with - | Some typ -> typ - | None -> - if !notyp then - let _loc = Loc.ghost in <:ctyp< _ >> - else - match Helpers.find_client_value_type gen_id with - | Ast.TyQuo _ -> - Helpers.raise_syntax_error loc - "The types of shared values must be monomorphic from its usage \ - or from its type annotation" - | typ -> typ - in - let _loc = Ast.loc_of_expr orig_expr in - <:expr@loc< - Eliom_shared.Value.create - $orig_expr$ - (Eliom_syntax.client_value - ~pos:($Helpers.position _loc$) - $str:gen_id$ - $Helpers.expr_tuple (flush_escaped_bindings ())$ - : $typ$ Eliom_client_value.t) - >> - - let escape_inject context_level ?ident orig_expr gen_id = - let open Pa_eliom_seed in - match context_level with - | Escaped_in_client_value_in (`Shared_expr _) -> - push_escaped_binding_nested orig_expr gen_id; - let _loc = Loc.ghost in - <:expr< >> - | Escaped_in_shared_value_in _ -> - push_escaped_binding orig_expr gen_id; - orig_expr - | Escaped_in_client_value_in _ -> - push_escaped_binding orig_expr gen_id; - let _loc = Loc.ghost in - <:expr< >> - | Injected_in _ -> - push_injection ?ident gen_id orig_expr; - let _loc = Ast.loc_of_expr orig_expr in - <:expr< $lid:gen_id$ >> - - let implem loc sil = - let _loc = Loc.ghost in - let set_global b = - <:str_item< let () = Eliom_syntax.set_global $`bool:b$ >> - in - set_global true :: sil @ [ set_global false ] - - let shared_sig_items _ items = Ast.sgSem_of_list items - let server_sig_items _ items = Ast.sgSem_of_list items - let client_sig_items _ items = Ast.sgSem_of_list [] - -end - -module M = Pa_eliom_seed.Register(Id)(Server_pass) diff --git a/src/syntax/pa_eliom_seed.ml b/src/syntax/pa_eliom_seed.ml deleted file mode 100644 index 6c8a222a63..0000000000 --- a/src/syntax/pa_eliom_seed.ml +++ /dev/null @@ -1,963 +0,0 @@ -(* Ocsigen - * http://www.ocsigen.org - * Copyright (C) 2010-2011 - * Raphaël Proust, Grégoire Henry - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, with linking exception; - * either version 2.1 of the License, or (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - *) - -(* Eliom's syntax extension implements five kinds of quotations: - - - a toplevel structure item "{client{ ... }}" for client side code ; - - a toplevel structure item "{server{ ... }}" (optional) for server side code ; - - a toplevel structure item "{shared{ ... }}" for code that will be used - both for the server and the client ; - - an expression "{{ ... }}" for client side code inside server side expressions ; - - an expression "{shared# ... { ... }}" for shared code inside - server side expressions ; - - an escaped expression "%ident" for referencing server value from - client side code expressions. - - - == Compilation of Eliom source generates: - - - a .cmo (or a .cmx) to be loaded by the ocsigen server ; - - a .js to be executed by the client. - - The {client{... }} sections are ignored on the server side. - The {server{... }} sections are ignored on the client side. - - '{{ ... }}' are compiled on the client as a function - parameterized by the values of escaped expressions. On the - server-side, '{{ ... }}' are compiled as a distant call. To keep - the link, each '{{ ... }}' is associated unique string (see - gen_closure_id). - - In order to type-check escaped-value with the same type on both - sides, compilation of Eliom sources infers the static type of - escaped values on the server-side and adds static type constraint - on the client-side. Inferred types also permits to specialize - marshaling (on the server-side) and unmarshalling (on the - client-side) of escaped values. - - == Compilation of Eliom is implemented in three steps: - - a) infers types of escaped values on the server-side code - b) generate the source file for the server-side - c) generate the source file for the client-side - - Each compilation step is based an a specific preprocessor: - - a) pa_eliom_type_inference - b) pa_eliom_client_server - c) pa_eliom_client_client - - This module define code shared by the three preprocessors. - -*) - -(** Helpers for pa_eliom_client_server and pa_eliom_client_client. *) - -module type Helpers = sig - - module Syntax : Camlp4.Sig.Camlp4Syntax - open Syntax - - (** find inferred type for escaped expr *) - val find_client_value_type: string -> Ast.ctyp - - (** find inferred type for escaped expr *) - val find_escaped_ident_type: string -> Ast.ctyp - - (** find inferred type for injected ident *) - val find_injected_ident_type: string -> Ast.ctyp - - val get_injected_ident_info: string -> string * int - - val is_client_value_type : Ast.ctyp -> Ast.ctyp option - - val raise_syntax_error : Ast.Loc.t -> string -> _ - - val is_escaped_indent_string: string -> bool - - val is_nested_escaped_indent_string: string -> bool - - val patt_tuple : string list -> Ast.patt - val expr_tuple : Ast.expr list -> Ast.expr - - val string_of_ident : Ast.ident -> string option - val position : Ast.Loc.t -> Ast.expr - - val file_hash : Ast.Loc.t -> string -end - -type shared_value_context = [ `Server | `Shared ] -let shared_value_context_to_string = function - | `Server -> "server" - | `Shared -> "shared" - -type client_value_context = - [ `Server - | `Shared - | `Shared_expr of shared_value_context ] -let client_value_context_to_string = function - | `Server -> "server" - | `Shared -> "shared" - | `Shared_expr c -> - "shared expr on " ^ (shared_value_context_to_string c) - -type injection_context = [ `Client | `Shared ] -let injection_context_to_string = function - | `Client -> "client" - | `Shared -> "shared" - -type escape_inject = - | Escaped_in_client_value_in of client_value_context - | Escaped_in_shared_value_in of shared_value_context - | Injected_in of injection_context - -(** Signature of specific code of a preprocessor. *) - -module type Pass = functor (Helpers: Helpers) -> sig - - open Helpers.Syntax - - (** How to handle "{shared{ ... }}" str_item. *) - val shared_str_items: Ast.Loc.t -> Ast.str_item list -> Ast.str_item - - (** How to handle "{server{ ... }}" str_item and toplevel str_item. *) - val server_str_items: Ast.Loc.t -> Ast.str_item list -> Ast.str_item - - (** How to handle "{client{ ... }}" str_item. *) - val client_str_items: Ast.Loc.t -> Ast.str_item list -> Ast.str_item - - val shared_sig_items: Ast.Loc.t -> Ast.sig_item list -> Ast.sig_item - val client_sig_items: Ast.Loc.t -> Ast.sig_item list -> Ast.sig_item - val server_sig_items: Ast.Loc.t -> Ast.sig_item list -> Ast.sig_item - - (** How to handle "{{ ... }}" expr. *) - val client_value_expr: Ast.ctyp option -> client_value_context -> Ast.expr -> string -> string -> Ast.Loc.t -> Ast.expr - - (** How to handle "{shared# ... { ... }}" expr. *) - val shared_value_expr: - Ast.ctyp option -> shared_value_context -> Ast.expr -> - string -> string -> Ast.Loc.t -> Ast.expr - - (** How to handle escaped "%ident" inside "{{ ... }}". *) - val escape_inject: escape_inject -> ?ident: string -> Ast.expr -> string -> Ast.expr - - val implem : Ast.Loc.t -> Ast.str_item list -> Ast.str_item list - -end - -let fst_3 (x, _, _) = x -let snd_3 (_, x, _) = x -let trd_3 (_, _, x) = x - -module Register(Id : sig val name: string end)(Pass : Pass) = struct - - module Make(Syntax : Camlp4.Sig.Camlp4Syntax) = struct - - include Syntax - - (* Syntax error exception *) - module Syntax_error = struct - type t = string - exception E of t - let print fmt msg = - Format.fprintf fmt "Error: %s" msg - let to_string msg = - ignore(Format.flush_str_formatter ()); - print Format.str_formatter msg; - Format.flush_str_formatter () - let raise _loc msg = - Loc.raise _loc (E msg) - end - - module Helpers = struct - - (* Anything easier than Camlp4? Create a parser for OCaml which - shares the Token, AST, etc with those of the [Syntax] - argument in the above functor [Make], but with an independent - Grammar, because we want the to parse the .type_mli without - the grammar modifications in made for the .eliomi files. *) - module Syntax = - Camlp4OCamlParser.Make - (Camlp4OCamlRevisedParser.Make - (Camlp4.OCamlInitSyntax.Make - (Syntax.Ast) - (Camlp4.Struct.Grammar.Static.Make - (Camlp4.Struct.Lexer.Make (Syntax.Token))) - (Syntax.Quotation))) - - let raise_syntax_error _loc msg = - Syntax_error.raise _loc msg - - (** MLI READER ***) - - (* Here we define a set of functions for mli reading. This is used - to peek at the type inferred by the first pass.*) - - let type_file = ref "" - let _ = - Camlp4.Options.add "-type" (Arg.Set_string type_file) "type inference file" - - let get_type_file () = match !type_file with - | "" -> Filename.chop_extension !Camlp4_config.current_input_file - ^ ".type_mli" - | f -> f - - let suppress_underscore = - let c = ref 0 in - let uid () = incr c ; !c in - fun ty -> - let pfix = Printf.sprintf "__eliom_inferred_type_%d" (uid ()) in - let map ty = match ty with - | Ast.TyApp (_, Ast.TyAny _, ty) - | Ast.TyApp (_, ty, Ast.TyAny _) -> ty - | Ast.TyQuo (x, var) when var.[0] = '_' -> - Ast.TyQuo (x, (String.sub var 1 (String.length var - 1)) ^ pfix) - | ty -> ty in - (Ast.map_ctyp map)#ctyp ty - - let rec string_of_ident = - function - | <:ident< $lid:s$ >> -> Some s - | <:ident< $uid:s$ >> -> Some s - | <:ident< $i1$.$i2$ >> -> - begin match (string_of_ident i1), (string_of_ident i2) with - | Some s1,Some s2 -> Some (s1 ^ "." ^ s2) - | _ -> None end - | _ -> None - - let lexing_position l = - let _loc = Loc.ghost in - <:expr< - { Lexing.pos_fname = $str:l.Lexing.pos_fname$; - Lexing.pos_lnum = $int:string_of_int l.Lexing.pos_lnum$; - Lexing.pos_bol = $int:string_of_int l.Lexing.pos_bol$; - Lexing.pos_cnum = $int:string_of_int l.Lexing.pos_cnum$; }>> - - let position _loc = - let start = Loc.start_pos _loc in - let stop = Loc.stop_pos _loc in - <:expr< ($lexing_position start$ , $lexing_position stop$) >> - - let escaped_ident_prefix = "__eliom__escaped_ident__reserved_name__" - let escaped_ident_prefix_len = String.length escaped_ident_prefix - let is_escaped_indent_string id = - String.length id > escaped_ident_prefix_len && - String.sub id 0 escaped_ident_prefix_len = escaped_ident_prefix - let is_escaped_ident = function - (* | <:sig_item< val $id$ : $t$ >> -> *) - | Ast.SgVal (_loc, id, t) -> - is_escaped_indent_string id - | si -> false - - (* separate set of IDs for client values inside shared values *) - let nested_escaped_ident_prefix = "__eliom__cv_in_sv__reserved_name__" - let nested_escaped_ident_prefix_len = - String.length nested_escaped_ident_prefix - let is_nested_escaped_indent_string id = - String.length id > nested_escaped_ident_prefix_len && - String.sub id 0 nested_escaped_ident_prefix_len = - nested_escaped_ident_prefix - - let injected_ident_fmt () = - format_of_string "__eliom__injected_ident__reserved_name__%6s__%d" - let is_injected_ident = function - (* | <:sig_item< val $id$ : $t$ >> -> *) - | Ast.SgVal (_loc, id, t) -> - (try - Scanf.sscanf id (injected_ident_fmt ()) (fun _ _ -> true) - with Scanf.Scan_failure _ -> - false) - | si -> false - - let client_value_ident_prefix = "__eliom__client_value__reserved_name__" - let client_value_ident_prefix_len = String.length client_value_ident_prefix - let is_client_value_ident = function - (* | <:sig_item< val $id$ : $t$ >> -> *) - | Ast.SgVal (_loc, id, t) -> - String.length id > client_value_ident_prefix_len && - String.sub id 0 client_value_ident_prefix_len = client_value_ident_prefix - | si -> false - - let is_client_value_type = function - | <:ctyp< $typ$ Eliom_client_value.t >> -> Some typ - | _ -> None - - let extract_escaped_ident_type = function - (* | <:sig_item< val $id$ : ($t$ option ref) >> -> *) - | Ast.SgVal (_loc, id, <:ctyp< ($t$ option ref) >>) -> - let len = String.length id - escaped_ident_prefix_len in - int_of_string (String.sub id escaped_ident_prefix_len len), - suppress_underscore t - | _ -> failwith "extract_escaped_ident_type" - let extract_injected_ident_type = function - (* | <:sig_item< val $id$ : ($t$ option ref) >> -> *) - | Ast.SgVal (_loc, id, <:ctyp< ($t$ option ref) >>) -> - Scanf.sscanf id (injected_ident_fmt ()) (fun _filehash n -> n), - suppress_underscore t - | _ -> failwith "extract_injected_ident_type" - let extract_client_value_type = function - (* | <:sig_item< val $id$ : ($t$ option ref) >> -> *) - | Ast.SgVal (_, id, <:ctyp< $typ$ option ref>>) -> - (match is_client_value_type typ with - | Some t -> - let len = String.length id - client_value_ident_prefix_len in - String.sub id client_value_ident_prefix_len len, - suppress_underscore t - | None -> - Printf.ksprintf failwith - "extract_client_value_type: Not a client value %S" id) - | _ -> failwith "extract_client_value_type" - - let load_file f = - try - let ic = open_in f in - let s = Stream.of_channel ic in - let item = Syntax.parse_interf (Loc.mk f) s in - let items = Ast.list_of_sig_item item [] in - close_in ic; - List.map extract_escaped_ident_type (List.filter is_escaped_ident items), - List.map extract_injected_ident_type (List.filter is_injected_ident items), - List.map extract_client_value_type (List.filter is_client_value_ident items) - with - | Sys_error _ -> - Printf.eprintf "Error: File type not found (%s)\n" (get_type_file ()); - exit 1 - | Loc.Exc_located(loc,exn) -> - Printf.eprintf "%s:\n Exception (%s)\n" - (Loc.to_string loc) (Printexc.to_string exn); - exit 1 - - let inferred_sig = lazy (load_file (get_type_file ())) - - let find_escaped_ident_type id = - try - let len = String.length id - escaped_ident_prefix_len in - let id = int_of_string (String.sub id escaped_ident_prefix_len len) in - List.assoc id (fst_3 (Lazy.force inferred_sig)) - with Not_found -> - Printf.eprintf "Error: Infered type of escaped ident not found (%s). \ - You need to regenerate %s.\n" - id (get_type_file ()); - exit 1 - - let get_injected_ident_info id = - Scanf.sscanf id (injected_ident_fmt ()) (fun u n -> (u, n)) - - let find_injected_ident_type id = - try - let (_, id) = get_injected_ident_info id in - List.assoc id (snd_3 (Lazy.force inferred_sig)) - with Not_found -> - Printf.eprintf "Error: Infered type of injected ident not found (%s). \ - You need to regenerate %s.\n" - id (get_type_file ()); - exit 1 - - let find_client_value_type id = - try - List.assoc id (trd_3 (Lazy.force inferred_sig)) - with Not_found -> - Printf.eprintf "Error: Infered type client value not found (%s). \ - You need to regenerate %s.\n" - id (get_type_file ()); - exit 1 - - (* Convert a list of patterns to a tuple of pattern, one single pattern, or (). *) - let patt_tuple = - let _loc = Loc.ghost in - let patt_of_id id = - <:patt< $lid:id$ >> - in function - | [] -> <:patt< () >> - | [id] -> patt_of_id id - | ps -> <:patt< $tup:Ast.paCom_of_list (List.map patt_of_id ps)$ >> - - (* Convert a list of expressions to a tuple, one expression, or (). *) - let expr_tuple = - let _loc = Loc.ghost in function - | [] -> <:expr< () >> - | [e] -> e - | es -> <:expr< $tup:Ast.exCom_of_list es$ >> - - let file_hash loc = - let s = Digest.string (Ast.Loc.file_name loc) in - let e = - "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789_'" in - let o = Bytes.create 6 in - let g p = Char.code s.[p] in - for i = 0 to 5 do - let p = i * 6 / 8 in - let d = 10 - (i * 6) mod 8 in - Bytes.set o i e.[(g p lsl 8 + g (p + 1)) lsr d land 63] - done; - Bytes.to_string o - - end (* End of Helpers *) - - - - (** Extend LEXER ***) - - (* Add keywords: "{{", "{shared{", "{server{", "{client{" et "}}" *) - - let merge_locs l ls = List.fold_left Token.Loc.merge ls l - - open Camlp4.Sig (* for KEYWORD, LIDENT and SYMBOL *) - - let rec filter = parser - | [< '(KEYWORD "{", loc0); next >] -> - (match next with parser - | [< '(KEYWORD "{", loc1); nnext >] -> (* {{ *) - [< '(KEYWORD "{{", merge_locs [loc0] loc1); filter nnext >] - - | [< '(LIDENT "shared", loc1); nnnext >] -> - (match nnnext with parser - | [< '(KEYWORD "#", loc2); nnnnext >] -> (* {shared# *) - [< '(KEYWORD ("{shared#"), merge_locs [loc0; loc1] loc2); - filter nnnnext - >] - - | [< '(KEYWORD "{", loc2); nnnnext >] -> (* {shared{ *) - [< '(KEYWORD ("{shared{"), merge_locs [loc0; loc1] loc2); - filter nnnnext - >] - - | [< 'other; nnnnext >] -> (* back *) - [< '(KEYWORD "{", loc0); '(LIDENT "shared", loc1); 'other; - filter nnnnext - >] - ) - - | [< '(LIDENT ("client"|"server" as s), loc1); nnnext >] -> - (match nnnext with parser - | [< '(KEYWORD "{", loc2); nnnnext >] -> (* {smthg{ *) - [< '(KEYWORD ("{"^s^"{"), merge_locs [loc0; loc1] loc2); - filter nnnnext - >] - - | [< 'other; nnnnext >] -> (* back *) - [< '(KEYWORD "{", loc0); '(LIDENT s, loc1); 'other; - filter nnnnext - >] - ) - - | [< 'other; nnext >] -> (* back *) - [< '(KEYWORD "{", loc0); 'other; filter nnext >] - ) - - | [< '(KEYWORD "}", loc0); next >] -> - (match next with parser - | [< '(KEYWORD "}", loc1); nnext >] -> - [< '(KEYWORD "}}", merge_locs [loc0] loc1); filter nnext >] - - | [< 'other; nnext >] -> (* back *) - [< '(KEYWORD "}", loc0); 'other; filter nnext >] - ) - - | [< 'other; next >] -> - let is_left_delimitor str = List.mem str.[0] ['('; '['; '{'] in - let ends_with_percent_sign str = str.[String.length str-1] = '%' in - match other with - | (* Allow %-sign to for injection directly after left delimitors *) - SYMBOL str, loc0 - when String.length str > 0 && - is_left_delimitor str && - ends_with_percent_sign str -> - let left = String.sub str 0 (String.length str - 1) in - let loc_left = Loc.move `stop (-1) loc0 in - let loc_right = Loc.move `start (String.length str - 1) loc0 in - [< '(KEYWORD left, loc_left); '(SYMBOL "%", loc_right); filter next >] - | _ -> [< 'other; filter next >] - - let () = - Token.Filter.define_filter - (Gram.get_filter ()) - (fun old_filter stream -> old_filter (filter stream)) - - - - (** Extend Parser **) - - module Pass = Pass(Helpers) - - (* State of the parser: for checking syntax imbrication. *) - type parsing_level = - | Toplevel - | Toplevel_module_expr - | Server_item - | Client_item - | Shared_item - | Module_expr - | Hole_expr of client_value_context - | Shared_expr of shared_value_context - | Escaped_expr of client_value_context - | Escaped_expr_in_shared of shared_value_context - | Injected_expr of injection_context - let level_to_string = function - | Toplevel -> "toplevel" - | Toplevel_module_expr -> "toplevel module expr" - | Server_item -> "server section" - | Client_item -> "client section" - | Shared_item -> "shared section" - | Module_expr -> "module expr" - | Shared_expr c -> - "shared expr in" ^ (shared_value_context_to_string c) - | Hole_expr client_value_context -> - "client value expr in " ^ client_value_context_to_string client_value_context - | Escaped_expr client_value_context -> - "escaped expression in " ^ client_value_context_to_string client_value_context - | Escaped_expr_in_shared shared_value_context -> - "escaped expression inside shared expression in " ^ - shared_value_context_to_string shared_value_context - | Injected_expr injection_context -> - "injected expression in " ^ injection_context_to_string injection_context - (* [client_value_context] captures where [client_value_expr]s are allowed. *) - let client_value_context = function - | Server_item | Toplevel | Toplevel_module_expr -> `Server - | Shared_item -> `Shared - | Shared_expr c -> `Shared_expr c - | Client_item | Hole_expr _ | Escaped_expr _ - | Escaped_expr_in_shared _ | Injected_expr _ - | Module_expr as context -> - failwith ("client_value_context: " ^ level_to_string context) - let injection_context_to_parsing_level : injection_context -> parsing_level = function - | `Client -> Client_item - | `Shared -> Shared_item - let current_level = ref Toplevel - let set_current_level level = - current_level := level - - (* [shared_value_context] captures where [shared_value_expr]s are allowed. *) - let shared_value_context = function - | Server_item | Toplevel | Toplevel_module_expr -> `Server - | Shared_item -> `Shared - | Client_item | Hole_expr _ | Shared_expr _ | Escaped_expr _ - | Escaped_expr_in_shared _ | Injected_expr _ - | Module_expr as context -> - failwith ("shared_value_context: " ^ level_to_string context) - - (* Identifiers for the closure representing "Hole_expr". *) - let gen_closure_num_count = ref 0 - let gen_closure_id _loc = - incr gen_closure_num_count; - Format.sprintf "%s%d" (Helpers.file_hash _loc) !gen_closure_num_count - let gen_closure_escaped_ident id = - Helpers.client_value_ident_prefix ^ id - - (* Globaly unique ident for escaped expression *) - (* It's used for type inference and as argument name for the - closure representing the surrounding "Hole_expr". *) - (* Inside a "Hole_expr", same ident share the global ident. *) - let escaped_idents = ref [] - let reset_escaped_ident () = escaped_idents := [] - let gen_escaped_expr_ident, gen_escaped_ident = - let r = ref 0 in - (fun () -> - incr r; - Helpers.escaped_ident_prefix ^ string_of_int !r), - (fun id -> - let id = (Ast.map_loc (fun _ -> Loc.ghost))#ident id in - try List.assoc id !escaped_idents - with Not_found -> - incr r; let gen_id = Helpers.escaped_ident_prefix ^ string_of_int !r in - escaped_idents := (id, gen_id) :: !escaped_idents; - gen_id) - - let nested_escaped_idents = ref [] - let reset_nested_escaped_ident () = nested_escaped_idents := [] - let gen_nested_escaped_expr_ident, - gen_nested_escaped_ident = - let r = ref 0 in - (fun () -> - incr r; - Helpers.nested_escaped_ident_prefix ^ string_of_int !r), - (fun id -> - let id = (Ast.map_loc (fun _ -> Loc.ghost))#ident id in - try List.assoc id !nested_escaped_idents - with Not_found -> - incr r; - let gen_id = - Helpers.nested_escaped_ident_prefix ^ string_of_int !r in - nested_escaped_idents := (id, gen_id) :: !nested_escaped_idents; - gen_id) - - let - gen_injected_expr_ident , - gen_injected_ident , - reset_injected_ident = - let injected_idents = ref [] in - let r = ref 0 in - let gen_ident loc = - let hash = Helpers.file_hash loc in - incr r; - Printf.sprintf (Helpers.injected_ident_fmt ()) hash !r - in - let gen_injected_ident loc id = - let id = (Ast.map_loc (fun _ -> Loc.ghost))#ident id in - try List.assoc id !injected_idents - with Not_found -> - let gen_id = gen_ident loc in - injected_idents := (id, gen_id) :: !injected_idents; - gen_id - and reset () = injected_idents := [] in - gen_ident, gen_injected_ident, reset - - - (* BBB Before the syntax error was thrown in the productions dummy_set_*. This - resulted in wrong error locations. The solution is to let the dummy productions - return an option and raise the syntax error in the enclosing production. *) - let from_some_or_raise opt loc f fmt = - match opt with - | Some x -> - Printf.ksprintf (fun _ -> f x) fmt - | None -> - Printf.ksprintf (Syntax_error.raise loc) fmt - - module E2 = Camlp4.ErrorHandler.Register(Syntax_error) ;; - - try - DELETE_RULE Gram expr: "{"; TRY [label_expr_list; "}"] END - with Camlp4.Struct.Grammar.Delete.Rule_not_found _ -> - (let test_record_field = - Gram.Entry.of_parser "record_field" (fun strm -> - let rec loop = function - | [] -> () - | (UIDENT _, _) :: (KEYWORD ".", _) :: rest -> loop rest - | (LIDENT _, _) :: (KEYWORD "=", _) :: _ -> () - | (LIDENT _, _) :: (KEYWORD ";", _) :: _ -> () - | [LIDENT _, _] -> () - | _ -> raise Stream.Failure - in - loop (Stream.npeek 100 strm)) - in - DELETE_RULE Gram expr: - "{"; test_record_field; label_expr_list; "}" END) ;; - - DELETE_RULE Gram expr: "{"; TRY [expr LEVEL "."; "with"]; label_expr_list; "}" END; - - (* Extending syntax *) - EXTEND Gram - GLOBAL: str_item sig_item expr module_expr module_binding0 str_items sig_items implem interf; - - (* Dummy rules: for level management and checking. *) - dummy_set_level_shared: - [[ -> - begin match !current_level with - | Toplevel -> set_current_level Shared_item; Some () - | _ -> None - end - ]]; - dummy_set_level_server: - [[ -> match !current_level with - | Toplevel -> set_current_level Server_item; Some () - | _ -> None - ]]; - dummy_set_level_client: - [[ -> - match !current_level with - | Toplevel -> set_current_level Client_item; Some () - | _ -> None - ]]; - dummy_set_level_client_value_expr: - [[ -> reset_escaped_ident (); reset_nested_escaped_ident (); - match !current_level with - | Toplevel | Toplevel_module_expr | Server_item - | Shared_item | (Shared_expr _) as old -> - set_current_level (Hole_expr (client_value_context old)); - Some old - | Client_item | Hole_expr _ | Escaped_expr _ - | Escaped_expr_in_shared _ | Injected_expr _ - | Module_expr -> - None - ]]; - dummy_set_level_shared_value_expr: - [[ -> reset_escaped_ident (); - match !current_level with - | Toplevel | Toplevel_module_expr | Server_item as old -> - set_current_level (Shared_expr `Server); - Some old - | Shared_item -> - set_current_level (Shared_expr `Shared); - Some Shared_item - | Client_item | Shared_expr _ | Hole_expr _ - | Escaped_expr _ | Escaped_expr_in_shared _ - | Injected_expr _ | Module_expr -> - None - ]]; - dummy_check_level_escaped_ident: - [[ -> match !current_level with - | Hole_expr context -> - Some (Escaped_in_client_value_in context) - | Shared_expr context -> - Some (Escaped_in_shared_value_in context) - | Client_item -> - Some (Injected_in `Client) - | Shared_item -> - Some (Injected_in `Shared) - | _ -> None - ]]; - dummy_set_level_escaped_expr: - [[ -> match !current_level with - | Hole_expr context -> - set_current_level (Escaped_expr context); - Some (Escaped_in_client_value_in context) - | Shared_expr context -> - set_current_level (Escaped_expr_in_shared context); - Some (Escaped_in_shared_value_in context) - | Client_item -> - set_current_level (Injected_expr `Client); - Some (Injected_in `Client) - | Shared_item -> - set_current_level (Injected_expr `Shared); - Some (Injected_in `Shared) - | _ -> None - ]]; - dummy_set_level_module_expr: - [[ -> match !current_level with - | Toplevel -> - set_current_level Toplevel_module_expr; - Toplevel - | lvl -> lvl ]]; - - str_items: FIRST - [[ lvl = dummy_set_level_module_expr; - me = SELF -> set_current_level lvl; me ]]; - - sig_items: FIRST - [[ lvl = dummy_set_level_module_expr; me = SELF -> - set_current_level lvl; me ]]; - - (* Duplicated from camlp4/Camlp4Parsers/Camlp4OCamlRevisedParser.ml *) - module_expr: BEFORE "top" - [[ "functor"; "("; i = a_UIDENT; ":"; t = module_type; ")"; "->"; - lvl = dummy_set_level_module_expr; - me = SELF -> - set_current_level lvl; <:module_expr< functor ( $i$ : $t$ ) -> $me$ >> ]]; - - (* Duplicated from camlp4/Camlp4Parsers/Camlp4OCamlRevisedParser.ml *) - module_binding0: FIRST - [ RIGHTA - [ "("; m = a_UIDENT; ":"; mt = module_type; ")"; - lvl = dummy_set_level_module_expr; mb = SELF -> - set_current_level lvl; <:module_expr< functor ( $m$ : $mt$ ) -> $mb$ >> ]]; - - sig_item: BEFORE "top" - [ "eliom" - [ KEYWORD "{shared{" ; opt = dummy_set_level_shared ; es = LIST0 sig_item ; KEYWORD "}}" -> - from_some_or_raise opt _loc - (fun () -> - set_current_level Toplevel; - Pass.shared_sig_items _loc es) - "The syntax {shared{ ... }} is only allowed at toplevel" - | KEYWORD "{server{" ; opt = dummy_set_level_server ; es = LIST0 sig_item ; KEYWORD "}}" -> - from_some_or_raise opt _loc - (fun () -> - set_current_level Toplevel; - Pass.server_sig_items _loc es) - "The syntax {server{ ... }} is only allowed at toplevel" - | KEYWORD "{client{" ; opt = dummy_set_level_client ; es = LIST0 sig_item ; KEYWORD "}}" -> - from_some_or_raise opt _loc - (fun () -> - set_current_level Toplevel; - Pass.client_sig_items _loc es) - "The syntax {client{ ... }} is only allowed at toplevel" - | si = sig_item LEVEL "top" -> - if !current_level = Toplevel then - Pass.server_sig_items _loc [si] - else - si - ]]; - - - (* To str_item we add {client{ ... }}, {server{ ... }} and {shared{ ... }} *) - str_item: BEFORE "top" - - [ "eliom" - - [ KEYWORD "{shared{" ; opt = dummy_set_level_shared ; es = LIST0 str_item ; KEYWORD "}}" -> - from_some_or_raise opt _loc - (fun () -> - set_current_level Toplevel; - let v = Pass.shared_str_items _loc es in - reset_injected_ident () ; v) - "The syntax {shared{ ... }} is only allowed at toplevel" - - | KEYWORD "{server{" ; opt = dummy_set_level_server ; es = LIST0 str_item ; KEYWORD "}}" -> - from_some_or_raise opt _loc - (fun () -> - set_current_level Toplevel; - Pass.server_str_items _loc es) - "The syntax {server{ ... }} is only allowed at toplevel" - - | KEYWORD "{client{" ; opt = dummy_set_level_client ; es = LIST0 str_item ; KEYWORD "}}" -> - from_some_or_raise opt _loc - (fun () -> - set_current_level Toplevel; - let v = Pass.client_str_items _loc es in - reset_injected_ident () ; v) - "The syntax {client{ ... }} is only allowed at toplevel" - - | si = str_item LEVEL "top" -> - - if !current_level = Toplevel then - Pass.server_str_items _loc [si] - else - si - - ]]; - - (* To expr we add {{ ... }} and %IDENT *) - - expr: LEVEL "simple" - - [ [ KEYWORD "{"; lel = TRY [lel = label_expr_list; "}" -> lel] -> - Ast.ExRec (_loc, lel, Ast.ExNil _loc) - | KEYWORD "{shared#"; - typ = TRY [ typ = OPT ctyp; KEYWORD "{" -> typ]; - opt_lvl = dummy_set_level_shared_value_expr ; - e = expr; KEYWORD "}}" -> - from_some_or_raise opt_lvl _loc - (fun lvl -> - set_current_level lvl; - let id = gen_closure_id _loc in - Pass.shared_value_expr typ (shared_value_context lvl) e - id (gen_closure_escaped_ident id) _loc) - "The syntax {shared# type{ ... } is not allowed in %s." - (level_to_string !current_level) - | KEYWORD "{"; typ = TRY [ typ = OPT ctyp; KEYWORD "{" -> typ]; opt_lvl = dummy_set_level_client_value_expr ; e = expr; KEYWORD "}}" -> - from_some_or_raise opt_lvl _loc - (fun lvl -> - set_current_level lvl; - let id = gen_closure_id _loc in - Pass.client_value_expr typ (client_value_context lvl) e - id (gen_closure_escaped_ident id) _loc) - "The syntax {type{ ... } is not allowed in %s." - (level_to_string !current_level) - | KEYWORD "{"; e = TRY [e = expr LEVEL "."; "with" -> e]; lel = label_expr_list; "}" -> - <:expr< { ($e$) with $lel$ } >> - | KEYWORD "{{"; opt_lvl = dummy_set_level_client_value_expr ; e = expr; KEYWORD "}}" -> - from_some_or_raise opt_lvl _loc - (fun lvl -> - set_current_level lvl; - let id = gen_closure_id _loc in - Pass.client_value_expr None (client_value_context lvl) e - id (gen_closure_escaped_ident id) _loc) - "The syntax {{ ... }} is not allowed in %s." - (level_to_string !current_level) - ] ]; - - expr: BEFORE "simple" - - [ [ SYMBOL "%" ; id = ident ; opt_context = dummy_check_level_escaped_ident -> - from_some_or_raise opt_context _loc - (fun context -> - let gen_id = - match context with - | Escaped_in_client_value_in (`Shared_expr _) -> - gen_nested_escaped_ident id - | Escaped_in_client_value_in _ - | Escaped_in_shared_value_in _ -> - gen_escaped_ident id - | Injected_in _ -> - gen_injected_ident _loc id - in - Pass.escape_inject context ?ident:(Helpers.string_of_ident id) <:expr< $id:id$ >> gen_id) - "The syntax \"%%ident\" is not allowed in %s." - (level_to_string !current_level) - - | SYMBOL "%" ; KEYWORD "(" ; opt_context = dummy_set_level_escaped_expr ; e = SELF ; KEYWORD ")" -> - from_some_or_raise opt_context _loc - (fun context -> - set_current_level - (match context with - | Escaped_in_client_value_in context -> Hole_expr context - | Escaped_in_shared_value_in context -> Shared_expr context - | Injected_in context -> injection_context_to_parsing_level context); - let gen_id = - match context with - | Escaped_in_client_value_in (`Shared_expr _) -> - gen_nested_escaped_expr_ident () - | Escaped_in_client_value_in _ - | Escaped_in_shared_value_in _ -> - gen_escaped_expr_ident () - | Injected_in _ -> - gen_injected_expr_ident _loc - in - Pass.escape_inject context e gen_id) - "The syntax \"%%(...)\" is not allowed in %s." - (level_to_string !current_level) - ]]; - - (* Cf. Camlp4OCamlRevisedParser *) - implem: - [[ si = str_item; semi; (sil, stopped) = SELF -> - (Pass.implem _loc (si :: sil), stopped) - | `EOI -> ([], None) - ]]; - - interf: - [[ si = sig_item; semi; (sil, stopped) = SELF -> - (si :: sil, stopped) - | `EOI -> ([], None) ]]; - - - END - - end - - (** Register syntax extension *) - - module Id : Camlp4.Sig.Id = struct - let name = "Eliom source file syntax ("^ Id.name ^")" - let version = "3.0+alpha" - end - - module M = Camlp4.Register.OCamlSyntaxExtension(Id)(Make) - -end - - -module Make(Syntax : Camlp4.Sig.Camlp4Syntax) = struct - - include Syntax - - (* Extending syntax *) - EXTEND Gram - GLOBAL: implem interf; - - implem: FIRST - [[ (sil, stopped) = implem LEVEL "top" -> - ( sil , stopped) ] - | "top" [] ]; - - interf: FIRST - [[ (sil, stopped) = interf LEVEL "top" -> - ( sil , stopped) ] - | "top" [] ]; - - END -end - -module Id : Camlp4.Sig.Id = struct - let name = "Eliom source file syntax (common)" - let version = "3.0" -end - -module M = Camlp4.Register.OCamlSyntaxExtension(Id)(Make) diff --git a/src/syntax/pa_eliom_type_filter.ml b/src/syntax/pa_eliom_type_filter.ml deleted file mode 100644 index 73a884a870..0000000000 --- a/src/syntax/pa_eliom_type_filter.ml +++ /dev/null @@ -1,157 +0,0 @@ -(* Ocsigen - * http://www.ocsigen.org - * Copyright (C) 2010-2011 - * Raphaël Proust, Grégoire Henry - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, with linking exception; - * either version 2.1 of the License, or (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - *) - -(* This module generates the file used to infer types (hence wrappers) of server - escaped values. - - Server-specific and escaped expression will be kept only for - type-checking. In order to export type of escaped expressions: it - generates for each escaped expression a toplevel definition that - looks like: - - let $global_id$ = ref None - - And client-side expressions are replaced by lists of initializers - (one per escaped expressions): - - $global_id$ := Some $expr$ - -*) - -module Id = struct - let name = "type-inference" -end - -module Type_pass(Helpers : Pa_eliom_seed.Helpers) = struct - - open Helpers.Syntax - - (* accumulator, push and flush for typing expression - <:expr< $gen_id$ := Some $orig_expr$ >> *) - let push_typing_expr, flush_typing_expr = - let typing_expr = ref [] in - let add orig_expr gen_id = - let _loc = Ast.loc_of_expr orig_expr in - if List.for_all (function gen_id', _ -> gen_id <> gen_id') !typing_expr then - typing_expr := (gen_id, <:expr< $lid:gen_id$ := Some $orig_expr$ >>) :: !typing_expr - in - let flush () = - let res = List.rev (List.map snd !typing_expr) in - typing_expr := []; - Ast.exSem_of_list res - in - add, flush - - (* accumulator, push and flush for typing str_items - <:str_item< let $gen_id$ = ref None >> *) - let push_typing_str_item, flush_typing_str_item = - let typing_strs = ref [] in - let add orig_expr gen_id = - let _loc = Ast.loc_of_expr orig_expr in - if List.for_all (function gen_id', _ -> gen_id' <> gen_id) !typing_strs then - typing_strs := (gen_id, <:str_item< let $lid:gen_id$ = Pervasives.ref None >>) :: !typing_strs - in - let flush () = - let res = List.map snd !typing_strs in - typing_strs := []; - Ast.stSem_of_list res - in - add, flush - - (** Syntax extension *) - - let client_str_items _loc items = - Ast.stSem_of_list [ - flush_typing_str_item (); - (let _loc = Loc.ghost in - <:str_item< let () = begin $flush_typing_expr ()$ end >>); - ] - - let server_str_items _loc items = - Ast.stSem_of_list (flush_typing_str_item () :: items) - - let shared_str_items = server_str_items - - let client_value_expr typ context_level orig_expr gen_id gen_tid loc = - push_typing_str_item orig_expr gen_tid; - let typ = match typ with - | Some typ -> typ - | None -> let _loc = Loc.ghost in <:ctyp< _ >> - in - let _loc = loc in - <:expr< begin - $flush_typing_expr ()$; - $lid:gen_tid$ := Some (Eliom_syntax.client_value "" 0 : $typ$ Eliom_client_value.t); - match ! $lid:gen_tid $ with - | Some x -> (x : _ Eliom_client_value.t) - | None -> assert false - end >> - - let shared_value_expr typ _ orig_expr gen_id gen_tid loc = - push_typing_str_item orig_expr gen_tid; - let typ = match typ with - | Some typ -> typ - | None -> let _loc = Loc.ghost in <:ctyp< _ >> - in - let _loc = loc in - <:expr< - Eliom_shared.Value.create $orig_expr$ - begin - $flush_typing_expr ()$; - $lid:gen_tid$ := - Some (Eliom_syntax.client_value "" 0 : - $typ$ Eliom_client_value.t); - match ! $lid:gen_tid $ with - | Some x -> x - | None -> assert false - end >> - - let escape_inject context_level ?ident orig_expr gen_id = - let open Pa_eliom_seed in - push_typing_str_item orig_expr gen_id; - push_typing_expr orig_expr gen_id; - match context_level with - | Escaped_in_shared_value_in _ -> - orig_expr - | Escaped_in_client_value_in _ -> - let _loc = Ast.loc_of_expr orig_expr in - <:expr< >> - | Injected_in `Shared -> - orig_expr - | Injected_in `Client -> - let _loc = Ast.loc_of_expr orig_expr in - <:expr< >> - - let implem loc sil = - let _loc = Loc.ghost in - let debug_compilation_unit_name = - let name = Printf.sprintf "__eliom__compilation_unit_id__%s" - (Helpers.file_hash loc) in - <:str_item< let $lid:name$ = () >> - in - debug_compilation_unit_name :: sil - - let shared_sig_items _ _ = let _loc = Loc.ghost in <:sig_item< >> - let server_sig_items _ _ = let _loc = Loc.ghost in <:sig_item< >> - let client_sig_items _ _ = let _loc = Loc.ghost in <:sig_item< >> - -end - -module M = Pa_eliom_seed.Register(Id)(Type_pass) diff --git a/src/tools/dune b/src/tools/dune new file mode 100644 index 0000000000..ab0dddd992 --- /dev/null +++ b/src/tools/dune @@ -0,0 +1,33 @@ +(library + (name tools_utils) + (wrapped false) + (modules utils) + (libraries findlib unix)) + +(executable + (name eliomdep) + (public_name eliomdep) + (libraries + findlib + tools_utils + unix) + (modules + eliomdep)) + +(executable + (name eliomc) + (public_name eliomc) + (libraries + findlib + tools_utils + unix) + (modules + eliomc)) + +(install + (section bin) + (files (eliomc.exe as js_of_eliom))) + +(install + (section bin) + (files (eliomc.exe as eliomopt))) diff --git a/src/tools/eliomc.ml b/src/tools/eliomc.ml index 23b5c9a36f..b4c067e6fe 100644 --- a/src/tools/eliomc.ml +++ b/src/tools/eliomc.ml @@ -330,7 +330,7 @@ let process_eliom ~impl_intf file = | _ -> compile_eliom ~impl_intf file -let build_server ?(name = "a.out") () = +let build_server ?name:_ () = fail "Linking eliom server is not yet supported" (* TODO ? Build a staticaly linked ocsigenserver. *) diff --git a/src/tools/utils.ml b/src/tools/utils.ml index 2dafcc42ee..c6e6f969aa 100644 --- a/src/tools/utils.ml +++ b/src/tools/utils.ml @@ -375,9 +375,9 @@ let preprocess_opt ?(ocaml = false) ?kind opts = [] | `Ppx -> let pkg = match simplify_kind ?kind () with - | `Client -> "eliom.ppx.client" - | `Server -> "eliom.ppx.server" - | `Types -> "eliom.ppx.type" + | `Client -> "ppx_eliom.ppx.client" + | `Server -> "ppx_eliom.ppx.server" + | `Types -> "ppx_eliom.ppx.type" in [ "-ppx"; get_ppx pkg ^ " " ^ String.concat " " opts ] From 7fb0bb3298d3bbe8589621700aa5fe2e22211224 Mon Sep 17 00:00:00 2001 From: John Christopher McAlpine Date: Mon, 15 Apr 2019 15:19:22 +0200 Subject: [PATCH 02/10] change camlp4 references to the new eliom_camlp4 --- src/tools/utils.ml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/tools/utils.ml b/src/tools/utils.ml index c6e6f969aa..5ca08cfc50 100644 --- a/src/tools/utils.ml +++ b/src/tools/utils.ml @@ -111,7 +111,7 @@ let with_autoload all_pkgs = if !autoload_predef then begin (* Format.eprintf "\nAUTOLOADING PREDEF PKGS\n%s\n@." (String.concat ", " all_pkgs); *) - let l = "eliom.syntax.predef"::all_pkgs in + let l = "eliom_camlp4.predef"::all_pkgs in if !type_conv then "deriving.syntax.tc"::"type_conv"::l else "deriving.syntax.std"::l @@ -366,9 +366,9 @@ let preprocess_opt ?(ocaml = false) ?kind opts = | `Camlp4 -> let pkg = match ocaml, simplify_kind ?kind () with | true, _ -> [] - | false, `Client -> ["eliom.syntax.client"] - | false, `Server -> ["eliom.syntax.server"] - | false, `Types -> ["eliom.syntax.type"] + | false, `Client -> ["eliom_camlp4.client"] + | false, `Server -> ["eliom_camlp4.server"] + | false, `Types -> ["eliom_camlp4.type"] in [ "-pp"; get_pp pkg ^ " " ^ String.concat " " opts ] | `Ppx when ocaml -> From 882921d29c4192e053711d0fb7e882dd221db9fa Mon Sep 17 00:00:00 2001 From: John Christopher McAlpine Date: Mon, 15 Apr 2019 15:22:39 +0200 Subject: [PATCH 03/10] fix ppx_eliom issue --- eliom.opam | 3 ++- src/lib/client/dune | 1 + src/lib/common/dune | 2 +- src/lib/server/dune | 1 + src/tools/utils.ml | 8 ++++---- 5 files changed, 9 insertions(+), 6 deletions(-) diff --git a/eliom.opam b/eliom.opam index 4e3d7e74e3..9a3d5d6c3f 100644 --- a/eliom.opam +++ b/eliom.opam @@ -22,7 +22,8 @@ depends: [ "deriving" {>= "0.6"} "ppx_deriving" "ppx_tools" {>= "0.99.3"} - "ppx_eliom" {>= "6.7.0"} + "ppx_eliom" {>= "1.0.0"} + "eliom_camlp4" "js_of_ocaml" {>= "3.3"} "js_of_ocaml-lwt" {>= "3.3"} "js_of_ocaml-ocamlbuild" {build} diff --git a/src/lib/client/dune b/src/lib/client/dune index def0d78631..9ec8c827df 100644 --- a/src/lib/client/dune +++ b/src/lib/client/dune @@ -12,6 +12,7 @@ js_of_ocaml-lwt.logger js_of_ocaml.tyxml lwt_log + lwt_log.core lwt_react netstring-pcre ocsigenserver diff --git a/src/lib/common/dune b/src/lib/common/dune index f2106e263f..b88dcf42d3 100644 --- a/src/lib/common/dune +++ b/src/lib/common/dune @@ -1,5 +1,5 @@ (library (name common) (public_name eliom.common) - (libraries lwt_log ocsigenserver) + (libraries lwt_log lwt_log.core ocsigenserver) (wrapped false)) \ No newline at end of file diff --git a/src/lib/server/dune b/src/lib/server/dune index 8e2c97c85d..701101851c 100644 --- a/src/lib/server/dune +++ b/src/lib/server/dune @@ -8,6 +8,7 @@ ipaddr lwt lwt_log + lwt_log.core lwt_react netstring-pcre ocsigenserver diff --git a/src/tools/utils.ml b/src/tools/utils.ml index 5ca08cfc50..01a439b919 100644 --- a/src/tools/utils.ml +++ b/src/tools/utils.ml @@ -111,7 +111,7 @@ let with_autoload all_pkgs = if !autoload_predef then begin (* Format.eprintf "\nAUTOLOADING PREDEF PKGS\n%s\n@." (String.concat ", " all_pkgs); *) - let l = "eliom_camlp4.predef"::all_pkgs in + let l = "eliom_camlp4.syntax.predef"::all_pkgs in if !type_conv then "deriving.syntax.tc"::"type_conv"::l else "deriving.syntax.std"::l @@ -366,9 +366,9 @@ let preprocess_opt ?(ocaml = false) ?kind opts = | `Camlp4 -> let pkg = match ocaml, simplify_kind ?kind () with | true, _ -> [] - | false, `Client -> ["eliom_camlp4.client"] - | false, `Server -> ["eliom_camlp4.server"] - | false, `Types -> ["eliom_camlp4.type"] + | false, `Client -> ["eliom_camlp4.syntax.client"] + | false, `Server -> ["eliom_camlp4.syntax.server"] + | false, `Types -> ["eliom_camlp4.syntax.type"] in [ "-pp"; get_pp pkg ^ " " ^ String.concat " " opts ] | `Ppx when ocaml -> From 1be1b3b4a5296cb5853ff056dcca5424c8588685 Mon Sep 17 00:00:00 2001 From: John Christopher McAlpine Date: Mon, 15 Apr 2019 16:36:24 +0200 Subject: [PATCH 04/10] update opam file --- src/lib/client/dune | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/lib/client/dune b/src/lib/client/dune index 9ec8c827df..399901ec7f 100644 --- a/src/lib/client/dune +++ b/src/lib/client/dune @@ -105,3 +105,7 @@ (with-stdout-to %{targets} (run %{bin:ppxfind} -legacy ppx_eliom.ppx.client --impl %{deps})))) + +(install + (section lib) + (files (eliom_client.js as client/eliom_client.js))) From 8a32e5eb6bbe8a32dd6e23cdfc22e76f8f9496b9 Mon Sep 17 00:00:00 2001 From: John Christopher McAlpine Date: Tue, 16 Apr 2019 11:00:12 +0200 Subject: [PATCH 05/10] add eliomcp installation stanza --- src/tools/dune | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/tools/dune b/src/tools/dune index ab0dddd992..bd9a59e0f7 100644 --- a/src/tools/dune +++ b/src/tools/dune @@ -31,3 +31,7 @@ (install (section bin) (files (eliomc.exe as eliomopt))) + +(install + (section bin) + (files (eliomc.exe as eliomcp))) From 4376b77248f4276e152bfca99a1aefc2bc79c733 Mon Sep 17 00:00:00 2001 From: John Christopher McAlpine Date: Tue, 16 Apr 2019 11:52:16 +0200 Subject: [PATCH 06/10] add eliom-distillery executable installation --- src/tools/dune | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/src/tools/dune b/src/tools/dune index bd9a59e0f7..80b99ecbd7 100644 --- a/src/tools/dune +++ b/src/tools/dune @@ -14,6 +14,16 @@ (modules eliomdep)) +(executable + (name distillery) + (public_name eliom-distillery) + (libraries + findlib + str + tools_utils) + (modules + distillery)) + (executable (name eliomc) (public_name eliomc) From 2601a53513c0eb670fd084547b0f4375781b0a57 Mon Sep 17 00:00:00 2001 From: John Christopher McAlpine Date: Tue, 16 Apr 2019 14:12:22 +0200 Subject: [PATCH 07/10] purge unnecessary dune libs and unnecessary warning corrections --- src/lib/client/common/dune | 2 - src/lib/client/common/eliom_content_core.ml | 2 +- src/lib/client/common/eliom_lib.ml | 12 ++--- src/lib/client/common/eliom_unwrap.ml | 2 +- src/lib/client/dune | 15 +----- src/lib/client/eliom_bus.ml | 10 ++-- src/lib/client/eliom_client.ml | 23 ++++----- src/lib/client/eliom_client_core.ml | 16 +++--- src/lib/client/eliom_comet.ml | 26 +++++----- src/lib/client/eliom_common.ml | 6 +-- src/lib/client/eliom_content_.ml | 18 +++---- src/lib/client/eliom_parameter.ml | 8 +-- src/lib/client/eliom_react.ml | 12 ++--- src/lib/client/eliom_registration.ml | 10 ++-- src/lib/client/eliom_request.ml | 10 ++-- src/lib/client/eliom_request_info.ml | 2 +- src/lib/client/eliom_route.ml | 30 ++++++------ src/lib/client/eliom_service.ml | 10 ++-- src/lib/client/eliommod_dom.ml | 6 +-- src/lib/common/dune | 2 +- src/lib/common/eliom_wrap.ml | 29 ++++++++++- src/lib/eliom/eliom_form.eliom | 10 ++-- src/lib/eliom/eliom_service_base.eliom | 22 ++++----- src/lib/eliom/eliom_shared.eliom | 38 +++++++-------- src/lib/eliom/eliom_shared_content.eliom | 2 +- src/lib/server/common/dune | 6 ++- src/lib/server/common/eliom_common.ml | 20 +++----- src/lib/server/dune | 12 +---- src/lib/server/eliom_bus.ml | 2 +- src/lib/server/eliom_comet.ml | 26 +++++----- src/lib/server/eliom_config.ml | 2 +- src/lib/server/eliom_content_core.ml | 12 ++--- src/lib/server/eliom_error_pages.ml | 48 +++++++++--------- src/lib/server/eliom_extension.ml | 2 +- src/lib/server/eliom_extension_template.ml | 2 +- src/lib/server/eliom_mkreg.ml | 9 ++-- src/lib/server/eliom_notif.ml | 2 +- src/lib/server/eliom_parameter.ml | 11 ++--- src/lib/server/eliom_react.ml | 18 +++---- src/lib/server/eliom_reference.ml | 4 +- src/lib/server/eliom_registration.ml | 53 +++++++++----------- src/lib/server/eliom_route.ml | 36 +++++++------- src/lib/server/eliom_service.ml | 16 +++--- src/lib/server/eliom_state.ml | 30 ++++++------ src/lib/shared/eliom_comet_base.ml | 2 - src/lib/shared/eliom_common_base.ml | 16 +++--- src/lib/shared/eliom_cookies_base.ml | 4 -- src/lib/shared/eliom_parameter_base.ml | 54 ++++++++++----------- src/lib/shared/eliom_route_base.ml | 21 ++++---- src/lib/shared/eliom_runtime.ml | 12 ++--- src/lib/shared/eliom_uri.ml | 14 +++--- 51 files changed, 363 insertions(+), 394 deletions(-) diff --git a/src/lib/client/common/dune b/src/lib/client/common/dune index 30c8ec4159..5b319ff68b 100644 --- a/src/lib/client/common/dune +++ b/src/lib/client/common/dune @@ -4,10 +4,8 @@ (public_name eliom.client.common) (libraries eliom.common - js_of_ocaml js_of_ocaml.tyxml js_of_ocaml-lwt.logger - ocsigenserver react reactiveData) (preprocess diff --git a/src/lib/client/common/eliom_content_core.ml b/src/lib/client/common/eliom_content_core.ml index a0fbb729b5..592d0f1356 100644 --- a/src/lib/client/common/eliom_content_core.ml +++ b/src/lib/client/common/eliom_content_core.ml @@ -72,7 +72,7 @@ module Xml = struct Lazy.force elt.elt 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/client/common/eliom_lib.ml b/src/lib/client/common/eliom_lib.ml index 12b15ce4eb..382fff5c7c 100644 --- a/src/lib/client/common/eliom_lib.ml +++ b/src/lib/client/common/eliom_lib.ml @@ -67,9 +67,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 = @@ -148,8 +148,8 @@ end (* We do not use the deriving (un)marshaling even if typ is available because direct jsn (un)marshaling is very fast client side *) -let to_json ?typ:_ s = Js.to_string (Json.output s) -let of_json ?typ:_ v = Json.unsafe_input (Js.string v) +let to_json ?typ s = Js.to_string (Json.output s) +let of_json ?typ v = Json.unsafe_input (Js.string v) (* to marshal data and put it in a form *) let encode_form_value x = to_json x @@ -166,5 +166,5 @@ let unmarshal_js var = type file_info = File.file Js.t -let make_cryptographic_safe_string ?len:_ () = +let make_cryptographic_safe_string ?len () = failwith "make_cryptographic_safe_string not implemented client-side" diff --git a/src/lib/client/common/eliom_unwrap.ml b/src/lib/client/common/eliom_unwrap.ml index 1363a52103..ee8821a7ea 100644 --- a/src/lib/client/common/eliom_unwrap.ml +++ b/src/lib/client/common/eliom_unwrap.ml @@ -34,7 +34,7 @@ let map : (Obj.t,Obj.t) weakMap Js.t = jsnew weakMap () open Js_of_ocaml open Eliom_lib -let _section = Lwt_log.Section.make "eliom:unwrap" +let section = Lwt_log.Section.make "eliom:unwrap" module Mark : sig type t diff --git a/src/lib/client/dune b/src/lib/client/dune index 399901ec7f..d7dadd3e3a 100644 --- a/src/lib/client/dune +++ b/src/lib/client/dune @@ -5,22 +5,9 @@ (libraries eliom.common eliom.client.common - ipaddr lwt - js_of_ocaml js_of_ocaml-lwt - js_of_ocaml-lwt.logger - js_of_ocaml.tyxml - lwt_log - lwt_log.core - lwt_react - netstring-pcre - ocsigenserver - ocsigenserver.cookies - ocsigenserver.ext - react - reactiveData - tyxml) + lwt_react) (preprocess (pps js_of_ocaml-ppx diff --git a/src/lib/client/eliom_bus.ml b/src/lib/client/eliom_bus.ml index 099c6ee7d4..6465e3a61a 100644 --- a/src/lib/client/eliom_bus.ml +++ b/src/lib/client/eliom_bus.ml @@ -46,7 +46,6 @@ let consume (t,u) s = | Lwt.Sleep -> Lwt.wakeup_exn u e; | _ -> ()); [%lwt raise ( e)] - [@ocaml.warning "-22"] in Lwt.choose [Lwt.bind t (fun _ -> Lwt.return_unit);t'] @@ -58,8 +57,7 @@ let clone_exn (t,u) s = (match Lwt.state t with | Lwt.Sleep -> Lwt.wakeup_exn u e; | _ -> ()); - [%lwt raise ( e)] - [@ocaml.warning "-22"]) + [%lwt raise ( e)]) type ('a, 'att, 'co, 'ext, 'reg) callable_bus_service = (unit, 'a list, Eliom_service.post, @@ -80,7 +78,7 @@ let create service channel waiter = in let error_h = let t,u = Lwt.wait () in - (try%lwt let%lwt _ = t in assert false with e -> [%lwt raise ( e)][@ocaml.warning "-22"]), u in + (try%lwt let%lwt _ = t in assert false with e -> [%lwt raise ( e)]), u in let stream = lazy ( let stream = Eliom_comet.register channel in @@ -110,7 +108,7 @@ let create service channel waiter = in t -let internal_unwrap ((wrapped_bus:('a, 'b) Ecb.wrapped_bus),_unwrapper) = +let internal_unwrap ((wrapped_bus:('a, 'b) Ecb.wrapped_bus),unwrapper) = let waiter () = Lwt_js.sleep 0.05 in let channel, Eliom_comet_base.Bus_send_service service = wrapped_bus in create service channel waiter @@ -143,7 +141,7 @@ 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 diff --git a/src/lib/client/eliom_client.ml b/src/lib/client/eliom_client.ml index b2533cd652..8253250f45 100644 --- a/src/lib/client/eliom_client.ml +++ b/src/lib/client/eliom_client.ml @@ -59,7 +59,7 @@ let get_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 | _ -> @@ -153,12 +153,12 @@ let init () = match Url.url_of_string (Js.to_string (Js.Unsafe.global##.___eliom_server_)) with - | Some (Http { hu_host; hu_port; hu_path = _; _ }) -> + | Some (Http { hu_host; hu_port; hu_path; _ }) -> init_client_app ~app_name ~ssl:false ~hostname:hu_host ~port:hu_port ~site_dir () - | Some (Https { hu_host; hu_port; hu_path = _; _ }) -> + | Some (Https { hu_host; hu_port; hu_path; _ }) -> init_client_app ~app_name ~ssl:true ~hostname:hu_host ~port:hu_port ~site_dir () @@ -196,7 +196,7 @@ let init () = let onload_handler = ref None in - let onload _ev = + let onload ev = let js_data = Lazy.force js_data in Lwt_log.ign_debug ~section "onload (client main)"; begin match !onload_handler with @@ -361,7 +361,7 @@ let raw_call_service ?progress ?upload_progress ?override_mime_type uri post_params Eliom_request.string_result in match content with - | None -> [%lwt raise ( (Eliom_request.Failed_request 204))][@ocaml.warning "-22"] + | None -> [%lwt raise ( (Eliom_request.Failed_request 204))] | Some content -> Lwt.return (uri, content) let call_service @@ -507,13 +507,11 @@ let garbage_collect_cached_doms () = in let rec accum_past = function | Some idx when !size < n -> - begin try let dom = HistCache.find idx !history_doms in add idx dom; accum_past dom.page.previous_page with Not_found -> () - end | _ -> () in let _, _, future = HistCache.split cur_index !history_doms in @@ -699,7 +697,8 @@ let set_template_content ~replace ~uri ?fragment = (match fragment with | None -> change_url_string ~replace uri | Some fragment -> - change_url_string ~replace (uri ^ "#" ^ fragment)); + change_url_string ~replace (uri ^ "#" ^ fragment) + | _ -> ()); let%lwt () = Lwt_mutex.lock load_mutex in let%lwt (), request_data = unwrap_caml_content content in do_request_data request_data; @@ -783,7 +782,6 @@ let set_content_local ?offset ?fragment new_page = recover (); Lwt_log.ign_debug ~section ~exn "set_content_local"; [%lwt raise ( exn)] - [@@ocaml.warning "-22"] (* Function to be called for server side services: *) let set_content ~replace ~uri ?offset ?fragment content = @@ -887,7 +885,6 @@ let set_content ~replace ~uri ?offset ?fragment content = recover (); Lwt_log.ign_debug ~section ~exn "set_content"; [%lwt raise ( exn)] - [@@ocaml.warning "-22"] let ocamlify_params = List.map @@ -942,7 +939,7 @@ let make_uri subpath params = Eliom_uri.make_string_uri_from_components (base, params, None) let route ~replace ?(keep_url = false) - ({ Eliom_route.i_subpath ; i_get_params ; i_post_params; _ } as info) = + ({ Eliom_route.i_subpath ; i_get_params ; i_post_params } as info) = Lwt_log.ign_debug ~section:section_page "Route"; let r = !Eliom_request_info.get_sess_info and info, i_subpath = @@ -969,7 +966,7 @@ let perform_reload () = Lwt_log.ign_debug ~section:section_page "Perform reload"; let uri = !current_uri in let - ({ Eliom_common.si_all_get_params ; si_all_post_params = _; _ } + ({ Eliom_common.si_all_get_params ; si_all_post_params } as i_sess_info) = !Eliom_request_info.get_sess_info () and i_subpath = Url.path_of_url_string uri in @@ -1114,7 +1111,7 @@ type _ redirection = 'a redirection let change_page_unknown - ?meth ?hostname:_ ?(replace = false) i_subpath i_get_params i_post_params = + ?meth ?hostname ?(replace = false) i_subpath i_get_params i_post_params = Lwt_log.ign_debug ~section:section_page "Change page unknown"; let i_sess_info = !Eliom_request_info.get_sess_info () and i_meth = diff --git a/src/lib/client/eliom_client_core.ml b/src/lib/client/eliom_client_core.ml index ebe2812cab..0b15f11da2 100644 --- a/src/lib/client/eliom_client_core.ml +++ b/src/lib/client/eliom_client_core.ml @@ -193,7 +193,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 value marked for late unwrapping. How to do this efficiently? *) @@ -269,7 +269,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 {Eliom_runtime.closure_id; value; _} -> + (fun {Eliom_runtime.closure_id; value} -> let instance_id = Eliom_runtime.Client_value_server_repr.instance_id value in @@ -404,14 +404,14 @@ let in_onload, broadcast_load_end, wait_load_end, set_loading_phase = (* forward declaration... *) let change_page_uri_ : (?cookies_info:bool * string list -> ?tmpl:string -> string -> unit) ref - = ref (fun ?cookies_info:_ ?tmpl:_ _href -> assert false) + = ref (fun ?cookies_info ?tmpl href -> assert false) let change_page_get_form_ : (?cookies_info:bool * string list -> ?tmpl:string -> Dom_html.formElement Js.t -> string -> unit) ref - = ref (fun ?cookies_info:_ ?tmpl:_ _form _href -> assert false) + = ref (fun ?cookies_info ?tmpl form href -> assert false) let change_page_post_form_ = - ref (fun ?cookies_info:_ ?tmpl:_ _form _href -> assert false) + ref (fun ?cookies_info ?tmpl form href -> assert false) type client_form_handler = Dom_html.event Js.t -> bool Lwt.t @@ -540,7 +540,7 @@ let rebuild_attrib_val = function let class_list_of_racontent = function | Xml.AStr s -> [s] - | Xml.AStrL (_space, l) -> + | Xml.AStrL (space, l) -> l | _ -> failwith "attribute class is not a string" @@ -861,7 +861,7 @@ let form_handler (fun () -> Lwt_log.raise_error_f ~section "not a form element") in let kind = - if String.lowercase_ascii(Js.to_string form##._method) = "get" + if String.lowercase(Js.to_string form##._method) = "get" then `Form_get else `Form_post and f _ = Lwt.return_false in @@ -1008,7 +1008,7 @@ let is_attrib_attrib,get_attrib_id = attr##.name##(substring (0) n_len) = n_prefix_js), (fun attr -> attr##.value##(substring_toEnd v_len)) -let relink_attrib _root table (node:Dom_html.element Js.t) = +let relink_attrib root table (node:Dom_html.element Js.t) = Lwt_log.ign_debug ~section "Relink attribute"; let aux attr = if is_attrib_attrib attr diff --git a/src/lib/client/eliom_comet.ml b/src/lib/client/eliom_comet.ml index 1ec50ccae0..a2e43e31d8 100644 --- a/src/lib/client/eliom_comet.ml +++ b/src/lib/client/eliom_comet.ml @@ -393,14 +393,14 @@ struct let call_service_after_load_end service p1 p2 = let%lwt () = Eliom_client.wait_load_end () in - Eliom_client.call_service ~service p1 p2 + Eliom_client.call_service service p1 p2 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) !map [] + (fun channel { position } l -> (channel,position)::l) !map [] in Ecb.Stateless (Array.of_list l) @@ -414,8 +414,8 @@ struct | Stateful_state r -> incr r; List.iter (function - | ( _chan_id, Ecb.Data _ ) -> () - | ( _chan_id, Ecb.Closed ) -> + | ( chan_id, Ecb.Data _ ) -> () + | ( chan_id, Ecb.Closed ) -> Eliom_lib.Lwt_log.ign_warning ~section "update_stateful_state: received Closed: should not happen, this is an eliom bug, please report it" | ( chan_id, Ecb.Full ) -> @@ -468,7 +468,7 @@ struct raise (Comet_error ("update_stateless_state on stateful one")) let call_service - ({ hd_activity; hd_service = Ecb.Comet_service srv; _ } as hd) = + ({ hd_activity; hd_service = Ecb.Comet_service srv } as hd) = let%lwt () = Configuration.sleep_before_next_request (fun () -> hd_activity.focused) @@ -554,7 +554,7 @@ struct update_activity hd; aux 0 - let call_commands {hd_service = Ecb.Comet_service srv; _} command = + let call_commands {hd_service = Ecb.Comet_service srv} command = ignore (try%lwt call_service_after_load_end srv () @@ -684,22 +684,22 @@ let get_stateless_hd (service:Ecb.comet_service) : Service_handler.stateless han | Not_found -> init service Service_handler.stateless stateless_handler_table let activate () = - let f _ { hd_service_handler; _ } = + 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 + | Ecb.Stateless_channel (chan_service,chan_id,kind) -> + 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 @@ -738,7 +738,7 @@ let check_and_update_position position msg_pos data = (* stateless channels are registered with a position: when a channel is registered more than one time, it is possible to receive old messages: the position is used to filter them out. *) -let register' hd position (_chan_service:Ecb.comet_service) (chan_id:'a Ecb.chan_id) = +let register' hd position (chan_service:Ecb.comet_service) (chan_id:'a Ecb.chan_id) = let chan_id = Ecb.string_of_chan_id chan_id in let stream = Lwt_stream.filter_map_s (function @@ -786,7 +786,7 @@ let register ?(wake=true) (wrapped_chan:'a Ecb.wrapped_channel) = | Ecb.Stateless_channel (s,c,kind) -> register_stateless ~wake s c kind -let internal_unwrap ( wrapped_chan, _unwrapper ) = register wrapped_chan +let internal_unwrap ( wrapped_chan, unwrapper ) = register wrapped_chan let () = Eliom_unwrap.register_unwrapper Eliom_common.comet_channel_unwrap_id internal_unwrap diff --git a/src/lib/client/eliom_common.ml b/src/lib/client/eliom_common.ml index dcb3188029..15a661b2ff 100644 --- a/src/lib/client/eliom_common.ml +++ b/src/lib/client/eliom_common.ml @@ -26,7 +26,7 @@ let get_sp_option () = Some () type 'a wrapper = unit -let make_wrapper _f :'a wrapper = () +let make_wrapper f :'a wrapper = () let empty_wrapper () :'a wrapper = () type unwrap_id = Eliom_unwrap.unwrap_id @@ -54,9 +54,9 @@ module To_and_of_shared = struct type 'a t = 'a to_and_of - let of_string {of_string; _} = of_string + let of_string {of_string} = of_string - let to_string {to_string; _} = to_string + let to_string {to_string} = to_string let to_and_of tao = tao diff --git a/src/lib/client/eliom_content_.ml b/src/lib/client/eliom_content_.ml index a69fce189f..d6917362c0 100644 --- a/src/lib/client/eliom_content_.ml +++ b/src/lib/client/eliom_content_.ml @@ -27,9 +27,7 @@ module Xml = Xml module MakeManip (Kind : sig type +'a elt - - val tot: Xml.elt -> 'a elt [@@ocaml.warning "-32"] - + val tot: Xml.elt -> 'a elt val toelt: 'a elt -> Xml.elt end) (To_dom : sig @@ -50,9 +48,9 @@ module MakeManip let get_unique_node context (elt: 'a Kind.elt) : Dom.node Js.t = match Xml.get_node (Kind.toelt elt) with | Xml.DomNode node -> node - | Xml.ReactNode _s -> get_node elt - | Xml.ReactChildren (_node,_rl) -> get_node elt - | Xml.TyXMLNode _desc -> + | Xml.ReactNode s -> get_node elt + | Xml.ReactChildren (node,rl) -> get_node elt + | Xml.TyXMLNode desc -> let elt' = Kind.toelt elt in match Xml.get_node_id elt' with | Xml.NoId -> @@ -323,8 +321,8 @@ module Svg = struct module D = Svg.D module R = Svg.R module C = struct - let node ?init:_ x = x - let attr ?init:_ x = x + let node ?init x = x + let attr ?init x = x end type +'a elt = 'a F.elt @@ -421,8 +419,8 @@ module Html = struct end module C = struct - let node ?init:_ x = x - let attr ?init:_ x = x + let node ?init x = x + let attr ?init x = x end type +'a elt = 'a F.elt diff --git a/src/lib/client/eliom_parameter.ml b/src/lib/client/eliom_parameter.ml index c0abd26497..8e5e60721b 100644 --- a/src/lib/client/eliom_parameter.ml +++ b/src/lib/client/eliom_parameter.ml @@ -110,7 +110,7 @@ and reconstruct_params_form : Some ((x1, x2), m) | TUnit -> Some ((), m) - | TOption (TAtom (_, TString) as y, _b) -> + | TOption (TAtom (_, TString) as y, b) -> (match reconstruct_params_form m y with | Some ("", m) -> Some (None, m) @@ -118,7 +118,7 @@ and reconstruct_params_form : Some (Some s, m) | None -> Some (None, m)) - | TOption (y, _b) -> + | TOption (y, b) -> (match reconstruct_params_form m y with | Some (x, m) -> Some (Some x, m) @@ -141,7 +141,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; _}) -> + | TUserType (name, {of_string = f}) -> reconstruct_atom ~f m name | _ -> None @@ -156,7 +156,7 @@ 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/client/eliom_react.ml b/src/lib/client/eliom_react.ml index deb63c8ea4..ae4030b709 100644 --- a/src/lib/client/eliom_react.ml +++ b/src/lib/client/eliom_react.ml @@ -42,17 +42,17 @@ struct ((fun ?exn () -> !r ?exn ()), (fun f -> r := f)) - let internal_unwrap ( channel, _unwrapper ) = + let internal_unwrap ( channel, unwrapper ) = (* We want to catch more exceptions here than the usual exceptions caught in Eliom_comet. For example Channel_full. *) (* We transform the stream into a stream with exception: *) - let stream = Lwt_stream.wrap_exn channel in + let stream = Lwt_stream.map_exn channel in Lwt.async (fun () -> Lwt_stream.iter_s (function - | Error exn -> + | Lwt_stream.Error exn -> let%lwt () = handle_react_exn ~exn () in Lwt.fail exn - | Ok _ -> Lwt.return_unit) + | Lwt_stream.Value _ -> Lwt.return_unit) stream); E.of_stream channel @@ -67,7 +67,7 @@ struct type 'a t = ('a -> unit Lwt.t) - let internal_unwrap ( service, _unwrapper ) = + let internal_unwrap ( service, unwrapper ) = fun x -> Eliom_client.call_service ~service () x >|= fun _ -> () let () = @@ -82,7 +82,7 @@ struct struct type 'a t = 'a React.S.t - let internal_unwrap ( channel, value, _unwrapper ) = + let internal_unwrap ( channel, value, unwrapper ) = let e = E.of_stream channel in S.hold ~eq:(fun _ _ -> false) value e diff --git a/src/lib/client/eliom_registration.ml b/src/lib/client/eliom_registration.ml index a9cc696392..b78a7d4f69 100644 --- a/src/lib/client/eliom_registration.ml +++ b/src/lib/client/eliom_registration.ml @@ -108,7 +108,7 @@ let wrap service att f _ suffix = let wrap_na (service : (_, _, _, _, _, _, _, _, _, _, _) Eliom_service.t) - _non_att f _ suffix = + non_att f _ suffix = let gp = Eliom_service.get_params_type service and pp = Eliom_service.post_params_type service and si = !Eliom_request_info.get_sess_info () @@ -177,7 +177,7 @@ module Make (P : PARAM) = struct type return = P.return type result = P.result - let send ?options ?charset:_ ?code:_ ?content_type:_ ?headers:_ page = + let send ?options ?charset ?code ?content_type ?headers page = P.send ?options page let register @@ -218,7 +218,7 @@ module Action = Make (struct let reset_reload_fun = true - let send ?options _page = + let send ?options page = match options with | Some `Reload | None -> Eliom_client.perform_reload () @@ -236,7 +236,7 @@ module Unit = Make (struct let reset_reload_fun = true - let send ?options:_ _page = + let send ?options:_ page = Lwt.return_unit end) @@ -319,7 +319,7 @@ module Any = struct Lwt.return page let register - ?app ?scope:_ ?options:_ ?charset:_ ?code:_ ?content_type:_ + ?app ?scope:_ ?options ?charset:_ ?code:_ ?content_type:_ ?headers:_ ?secure_session:_ ~service ?error_handler:_ f = let f g p = let%lwt page = f g p in send page in diff --git a/src/lib/client/eliom_request.ml b/src/lib/client/eliom_request.ml index 023a167003..20a18057a2 100644 --- a/src/lib/client/eliom_request.ml +++ b/src/lib/client/eliom_request.ml @@ -56,9 +56,9 @@ let get_cookie_info_for_uri_js uri_js = (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 @@ -89,7 +89,7 @@ let redirect_post url params = in i##.value := v; Dom.appendChild f i - | `File _i -> + | `File i -> Lwt_log.raise_error ~section "redirect_post not implemented for files") params; f##.style##.display := (Js.string "none"); @@ -258,7 +258,7 @@ let send (match r.XmlHttpRequest.headers Eliom_common.half_xhr_redir_header with | None | Some "" -> Lwt.return (r.XmlHttpRequest.url, None) - | Some _uri -> + | Some uri -> redirect_post url (match post_args with | Some post_args -> post_args diff --git a/src/lib/client/eliom_request_info.ml b/src/lib/client/eliom_request_info.ml index 52ce648291..4cb1fd1808 100644 --- a/src/lib/client/eliom_request_info.ml +++ b/src/lib/client/eliom_request_info.ml @@ -84,7 +84,7 @@ let current_path_ = ref (remove_first_slash Url.Current.path) let set_current_path uri = current_path_ := Url.path_of_url_string (if uri = "./" then "" else uri) -let get_original_full_path_sp _sp = +let get_original_full_path_sp sp = (* returns current path, not the one when application started *) if Eliom_process.history_api && not !client_app_initialised then match Url.Current.get () with diff --git a/src/lib/client/eliom_route.ml b/src/lib/client/eliom_route.ml index bcb99ae0f7..3268aaaa59 100644 --- a/src/lib/client/eliom_route.ml +++ b/src/lib/client/eliom_route.ml @@ -21,11 +21,11 @@ module A = struct let site_data _ = () - let sess_info_of_info {i_sess_info; _} = i_sess_info + let sess_info_of_info {i_sess_info} = i_sess_info - let subpath_of_info {i_subpath; _} = i_subpath + let subpath_of_info {i_subpath} = i_subpath - let meth_of_info {i_meth; _} = i_meth + let meth_of_info {i_meth} = i_meth let make_params _ _ suffix _ = suffix @@ -54,15 +54,15 @@ module A = struct type t = table - let add {Eliom_common.key_meth; _} 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 @@ -71,9 +71,9 @@ module A = struct type t = unit - let up _n = () + let up n = () - let remove _n = () + let remove n = () end @@ -90,7 +90,7 @@ module A = struct ) 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 @@ -98,7 +98,7 @@ module A = struct let set tables l = tables.t_services <- l - let dlist_add ?sp:_ _tables _srv = () + let dlist_add ?sp:_ tables srv = () end @@ -114,19 +114,19 @@ let global_tables = A.Container.{ t_na_services = Hashtbl.create 256 } -let add_naservice {A.Container.t_na_services; _} k f = +let add_naservice {A.Container.t_na_services} k f = Hashtbl.add t_na_services k f -let call_naservice {A.Container.t_na_services; _} k = +let call_naservice {A.Container.t_na_services} k = try (Hashtbl.find t_na_services k) true None with Not_found -> Lwt.fail Eliom_common.Eliom_404 let rec na_key_of_params ~get = function - | (k, v) :: _l when k = Eliom_common.naservice_name -> + | (k, v) :: l when k = Eliom_common.naservice_name -> Some (if get then Eliom_common.SNa_get_ v else Eliom_common.SNa_post_ v) - | (k, v) :: _l when k = Eliom_common.naservice_num -> + | (k, v) :: l when k = Eliom_common.naservice_num -> Some (if get then Eliom_common.SNa_get' v else Eliom_common.SNa_post' v) | _ :: l -> na_key_of_params ~get l @@ -142,7 +142,7 @@ let rec remove_site_dir p p' = | _ -> 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 diff --git a/src/lib/client/eliom_service.ml b/src/lib/client/eliom_service.ml index 2e819f0ec3..c83b810df3 100644 --- a/src/lib/client/eliom_service.ml +++ b/src/lib/client/eliom_service.ml @@ -53,10 +53,8 @@ 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) @@ -65,8 +63,8 @@ let reload_fun : let reset_reload_fun service = service.reload_fun <- Rf_keep -let register_delayed_get_or_na_coservice ~sp:_ _s = +let register_delayed_get_or_na_coservice ~sp s = failwith "CSRF coservice not implemented client side for now" -let register_delayed_post_coservice ~sp:_ _s _getname = +let register_delayed_post_coservice ~sp s getname = failwith "CSRF coservice not implemented client side for now" diff --git a/src/lib/client/eliommod_dom.ml b/src/lib/client/eliommod_dom.ml index 86696ff860..05d11bd39e 100644 --- a/src/lib/client/eliommod_dom.ml +++ b/src/lib/client/eliommod_dom.ml @@ -546,7 +546,7 @@ let rewrite_css_url ~prefix css pos = if pos < String.length css then match Regexp.search url_re css pos with | None -> Buffer.add_substring buf css pos (String.length css - pos) - | Some (i, _res) -> + | Some (i, res) -> Buffer.add_substring buf css pos (i - pos); try let i, href = parse_url ~prefix css i in @@ -575,7 +575,7 @@ let rec rewrite_css ~max (media, href, css) = if !Eliom_config.debug_timings then Firebug.console##(timeEnd (Js.string ("rewrite_CSS: "^href))); Lwt.return (imports @ [(media, css)]) - with _e -> + with e -> Lwt.return [(media, Printf.sprintf "@import url(%s);" href)] and rewrite_css_import ?(charset = "") ~max ~prefix ~media css pos = @@ -697,7 +697,7 @@ let _ = ignore (Dom.addEventListener Dom_html.document (Dom.Event.make "scroll") - (Dom_html.handler (fun _event -> + (Dom_html.handler (fun event -> current_position := createDocumentScroll (); Js._false)) Js._true : Dom_html.event_listener_id) diff --git a/src/lib/common/dune b/src/lib/common/dune index b88dcf42d3..f2106e263f 100644 --- a/src/lib/common/dune +++ b/src/lib/common/dune @@ -1,5 +1,5 @@ (library (name common) (public_name eliom.common) - (libraries lwt_log lwt_log.core ocsigenserver) + (libraries lwt_log ocsigenserver) (wrapped false)) \ No newline at end of file diff --git a/src/lib/common/eliom_wrap.ml b/src/lib/common/eliom_wrap.ml index 9f788242fc..0796000601 100644 --- a/src/lib/common/eliom_wrap.ml +++ b/src/lib/common/eliom_wrap.ml @@ -98,7 +98,7 @@ let none = Obj.repr 0 (* Unallocated entry in an array or in a hash-table *) module DynArray = struct type 'a t = 'a array ref - let rec check_size (a:'a t) i = + let rec check_size a i = let len = Array.length !a in if i > len then begin let old_a = !a in @@ -235,8 +235,35 @@ module Tbl = struct slight chance to perform an allocation; in which case, the table will no longer be up to date... *) let was_up_to_date tbl = tbl.gc = gc_count () + + let add_on_resize tbl f = tbl.on_resize <- f :: tbl.on_resize; end +(* Returns whether we should recursively scan the value or should + consider it as opaque. Also check for values that cannot be + serialized. *) +let can_scan v = + Obj.is_block v && + let tag = Obj.tag v in + if tag >= Obj.no_scan_tag then + false + else if + tag <= Obj.last_non_constant_constructor_tag || tag = Obj.forward_tag + then + true + else begin + if tag = Obj.lazy_tag then + failwith "lazy values must be forced before wrapping"; + if tag = Obj.object_tag then failwith "cannot wrap object values"; + if tag = Obj.closure_tag then failwith "cannot wrap functional values"; + if tag = Obj.infix_tag then + failwith "cannot wrap functional values: infix tag"; + (* Should not happen (in case a new kind of value is added) *) + failwith (Printf.sprintf "cannot wrap value (unexpected tag %d)" tag) + end + +type kind = Opaque | Scannable | Forward + let obj_kind v = if not (Obj.is_block v) then `Opaque diff --git a/src/lib/eliom/eliom_form.eliom b/src/lib/eliom/eliom_form.eliom index 0809c3f36c..2ea0674258 100644 --- a/src/lib/eliom/eliom_form.eliom +++ b/src/lib/eliom/eliom_form.eliom @@ -168,7 +168,7 @@ module Make_links (Html : Html) = struct Html.a_src uri :: (a :> Html_types.script_attrib attrib list) in - Html.script ~a (Html.txt "") + Html.script ~a (Html.pcdata "") end @@ -248,7 +248,7 @@ module Make (Html : Html) = struct let make_textarea ?(a = []) ~name ?(value = "") () = let a = a_name name :: (a :> Html_types.textarea_attrib attrib list) in - textarea ~a (txt value) + textarea ~a (pcdata value) let make_select ?(a = []) ~multiple ~name elt elts = let a = if multiple then a_multiple () :: a else a in @@ -327,7 +327,7 @@ module Make (Html : Html) = struct let get_form ?absolute ?absolute_path ?https ?a ~service ?hostname ?port - ?fragment ?keep_nl_params ?nl_params ?xhr:_ f = + ?fragment ?keep_nl_params ?nl_params ?xhr f = get_form_ (fun x f -> f x) (fun x -> x) ?absolute ?absolute_path @@ -375,7 +375,7 @@ module Make (Html : Html) = struct let post_form ?absolute ?absolute_path ?https ?a ~service ?hostname ?port - ?fragment ?keep_nl_params ?keep_get_na_params ?nl_params ?xhr:_ + ?fragment ?keep_nl_params ?keep_get_na_params ?nl_params ?xhr f getparams = post_form_ (fun x f -> f x) (fun x -> x) ?absolute ?absolute_path ?https ?a ~service ?hostname ?port @@ -531,7 +531,7 @@ module Make (Html : Html) = struct let make_opt (a, cv, co, sel) = (match co with | None -> - make_option ~a ~selected:sel (txt (string_of cv)) + make_option ~a ~selected:sel (pcdata (string_of cv)) | Some c -> make_option ~a ~selected:sel ~value:(string_of cv) c) in let make_optg = function diff --git a/src/lib/eliom/eliom_service_base.eliom b/src/lib/eliom/eliom_service_base.eliom index a2c8b159ca..2823c224e3 100644 --- a/src/lib/eliom/eliom_service_base.eliom +++ b/src/lib/eliom/eliom_service_base.eliom @@ -170,7 +170,7 @@ let pre_wrap s = { 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 @@ -191,11 +191,11 @@ let priority s = s.priority let internal_set_client_fun ~service f = service.client_fun <- Some [%client 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 @@ -288,7 +288,7 @@ type clvpreapp = { } let preapply_client_fun = { - clvpreapp_f = fun _f _getparams -> failwith "preapply_client_fun" + clvpreapp_f = fun f getparams -> failwith "preapply_client_fun" } (* will be initialized later (in Eliom_content for now), when client @@ -299,7 +299,7 @@ let rec append_suffix l m = match l with | [] -> m - | [_eliom_suffix_internal_name] -> + | [eliom_suffix_internal_name] -> m | a :: ll -> a :: append_suffix ll m @@ -328,7 +328,7 @@ let preapply ~service getparams = | Some suff -> append_suffix k.fullpath suff | _ -> k.fullpath); }; - | _ -> .); + | k -> k); client_fun = Some [%client ref @@ -444,16 +444,16 @@ let default_csrf_scope = function exception Unreachable_exn let attached_info = function - | {info = Attached k; _} -> + | {info = Attached k} -> k | _ -> - . + failwith "attached_info" let non_attached_info = function - | {info = Nonattached k; _} -> + | {info = Nonattached k} -> k | _ -> - . + failwith "non_attached_info" (** Create a main service (not a coservice), internal or external *) let main_service @@ -521,7 +521,7 @@ let extern ~reload_fun:Rf_keep () -let which_meth {meth; _} = meth +let which_meth {meth} = meth let which_meth_untyped (type m) (s : (_, _, m, _, _, _, _, _, _, _, _) t) = diff --git a/src/lib/eliom/eliom_shared.eliom b/src/lib/eliom/eliom_shared.eliom index e44b4a6a9d..98aba9df1f 100644 --- a/src/lib/eliom/eliom_shared.eliom +++ b/src/lib/eliom/eliom_shared.eliom @@ -51,7 +51,7 @@ module Value = struct sh_mark : 'a t Eliom_wrap.wrapper } - 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 @@ -62,9 +62,9 @@ module Value = struct sh_mark = shared_value_mark () } - let client {sh_client; _} = sh_client + let client {sh_client} = sh_client - let local {sh_server; _} = sh_server + let local {sh_server} = sh_server end ] @@ -72,12 +72,8 @@ end [%%client module React = struct - [@@@ocaml.warning "-34"] - type step = React.step - [@@@ocaml.warning "+34"] - module S = struct include React.S @@ -165,7 +161,7 @@ module ReactiveData = struct let new_waiter = Lwt.wait () in waiter := new_waiter; let%lwt new_msg = map_msg_p_lwt f msg in - let%lwt _rr, rhandle = r_th in + let%lwt rr, rhandle = r_th in let%lwt () = fst waiter1 in (match new_msg with | ReactiveData.RList.Set s -> @@ -202,7 +198,7 @@ module ReactiveData = struct Lwt.return (ReactiveData.RList.create r) in let effectul_event = map_p_aux r_th f l in - let%lwt rr, _rhandle = r_th in + let%lwt rr, rhandle = r_th in (* We keep a reference to the effectul_event in the resulting reactive list in order that the effectul_event is garbage collected only if the resulting list is garbage @@ -276,26 +272,26 @@ module FakeReact = struct type 'a t = 'a * bool let create ?synced:(synced = false) x = ((x, synced), - fun ?step:_ _ -> + fun ?step _ -> failwith "Fact react values cannot be changed on server side") let value (x, _) = x let const ?synced:(synced = false) x = (x, synced) let synced (_, b) = b - let map ?eq:_ (f : 'a -> 'b) ((x, b) : 'a t) : 'b t = f x, b - let fmap ?eq:_ f i (s, b) = + let map ?eq (f : 'a -> 'b) ((x, b) : 'a t) : 'b t = f x, b + let fmap ?eq f i (s, b) = (match f s with Some v -> v | None -> i), b - let merge ?eq:_ f acc l = + let merge ?eq f acc l = let f (acc, acc_b) (x, b) = f acc x, acc_b && b in List.fold_left f (acc, true) l - let l2 ?eq:_ f (x1, b1) (x2, b2) = + let l2 ?eq f (x1, b1) (x2, b2) = f x1 x2, b1 && b2 - let l3 ?eq:_ f (x1, b1) (x2, b2) (x3, b3) = + let l3 ?eq f (x1, b1) (x2, b2) (x3, b3) = f x1 x2 x3, b1 && b2 && b3 - let l4 ?eq:_ f (x1, b1) (x2, b2) (x3, b3) (x4, b4) = + let l4 ?eq f (x1, b1) (x2, b2) (x3, b3) (x4, b4) = f x1 x2 x3 x4, b1 && b2 && b3 && b4 - let l5 ?eq:_ f (x1, b1) (x2, b2) (x3, b3) (x4, b4) (x5, b5) = + let l5 ?eq f (x1, b1) (x2, b2) (x3, b3) (x4, b4) (x5, b5) = f x1 x2 x3 x4 x5, b1 && b2 && b3 && b4 && b5 - let l6 ?eq:_ f (x1, b1) (x2, b2) (x3, b3) (x4, b4) (x5, b5) (x6, b6) = + let l6 ?eq f (x1, b1) (x2, b2) (x3, b3) (x4, b4) (x5, b5) (x6, b6) = f x1 x2 x3 x4 x5 x6, b1 && b2 && b3 && b4 && b5 && b6 end end @@ -322,9 +318,9 @@ module FakeReactiveData = struct let singleton_s s = [FakeReact.S.value s], FakeReact.S.synced s let value (l, _) = l let synced (_, b) = b - let signal ?eq:_ (l, synced) = fst (FakeReact.S.create ~synced l) + let signal ?eq (l, synced) = fst (FakeReact.S.create ~synced l) let map f (l, b) = List.map f l, b - let from_signal ?eq:_ s = FakeReact.S.(value s, synced s) + let from_signal ?eq s = FakeReact.S.(value s, synced s) end end ] @@ -589,7 +585,7 @@ module React = struct let merge_s ?eq (f : ('a -> 'b -> 'a Lwt.t) Value.t) (acc : 'a) (l : 'b t list) : 'a t Lwt.t = let%lwt server_result, synced = - let f (acc, _acc_b) v = + let f (acc, acc_b) v = let v = Value.local v and f = Value.local f in let%lwt acc = f acc (FakeReact.S.value v) in let acc_b = FakeReact.S.synced v in diff --git a/src/lib/eliom/eliom_shared_content.eliom b/src/lib/eliom/eliom_shared_content.eliom index aab10d9351..a1d53820c6 100644 --- a/src/lib/eliom/eliom_shared_content.eliom +++ b/src/lib/eliom/eliom_shared_content.eliom @@ -435,7 +435,7 @@ module Html = struct include Eliom_content_core.Html.Make(Xml)(Wrapped_functions)(Svg.R) - let pcdata x = txt x |> Unsafe.coerce_elt + let pcdata x = pcdata x |> Unsafe.coerce_elt end diff --git a/src/lib/server/common/dune b/src/lib/server/common/dune index ffc628d0c6..cdf5474dd4 100644 --- a/src/lib/server/common/dune +++ b/src/lib/server/common/dune @@ -2,6 +2,10 @@ (name internalserver) (wrapped false) (public_name eliom.server.common) - (libraries eliom.common js_of_ocaml ocsigenserver ocsigenserver.ext react) + (libraries + eliom.common + js_of_ocaml + ocsigenserver.ext + react) (preprocess (pps js_of_ocaml-ppx_deriving_json lwt_ppx))) diff --git a/src/lib/server/common/eliom_common.ml b/src/lib/server/common/eliom_common.ml index 692c860f68..d60e4e708f 100644 --- a/src/lib/server/common/eliom_common.ml +++ b/src/lib/server/common/eliom_common.ml @@ -523,7 +523,7 @@ let make_full_state_name2 site_dir_string) 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 @@ -794,7 +794,7 @@ let empty_tables max forsession = then let dlist = Ocsigen_cache.Dlist.create max in Ocsigen_cache.Dlist.set_finaliser_before (dlist_finaliser t2) dlist; - fun ?sp:_ v -> add_dlist_ dlist v + fun ?sp v -> add_dlist_ dlist v else fun ?sp v -> let ip, max, sitedata = @@ -846,7 +846,7 @@ sessionkind|S?|sitedirstring|"ref" ou "comet" ou ""|hiername *) let full_state_name_of_cookie_name cookie_level cookiename = - let _pref, cookiename = Ocsigen_lib.String.sep '|' cookiename in + let pref, cookiename = Ocsigen_lib.String.sep '|' cookiename in let secure, cookiename = Ocsigen_lib.String.sep '|' cookiename in let sitedirstring, cookiename = Ocsigen_lib.String.sep '|' cookiename in let hier1, hiername = Ocsigen_lib.String.sep '|' cookiename in @@ -887,8 +887,6 @@ 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 () -[@@@ocaml.warning "-39-32"] - type cpi = client_process_info = { cpi_ssl : bool; cpi_hostname : string; @@ -896,8 +894,6 @@ type cpi = client_process_info = { cpi_original_full_path : string list; } [@@deriving json] -[@@@ocaml.warning "+39+32"] - let get_session_info req previous_extension_err = let req_whole = req and ri = req.Ocsigen_extensions.request_info @@ -1363,19 +1359,19 @@ module To_and_of_shared = struct let wrapper : wrapper = Obj.magic @@ Eliom_wrap.create_wrapper @@ function - | {client = Some tao; _} -> + | {client = Some tao} -> tao - | {client = None; _} -> + | {client = None} -> failwith "Cannot wrap user type parameter.\n\ Use the ?client_to_and_of parameter of Eliom_parameter.user_type\n\ or (Eliom_parameter.all_suffix_user)" - let to_string {server = {to_string; _}; _} = to_string + let to_string {server = {to_string}} = to_string - let of_string {server = {of_string; _}; _} = of_string + let of_string {server = {of_string}} = of_string - let to_and_of {server; _} = server + let to_and_of {server} = server let create ?client_to_and_of server = { server ; diff --git a/src/lib/server/dune b/src/lib/server/dune index 701101851c..0156828043 100644 --- a/src/lib/server/dune +++ b/src/lib/server/dune @@ -5,17 +5,7 @@ (libraries eliom.common eliom.server.common - ipaddr - lwt - lwt_log - lwt_log.core - lwt_react - netstring-pcre - ocsigenserver - ocsigenserver.cookies - ocsigenserver.ext - react - tyxml) + lwt_react) (preprocess (pps lwt_ppx diff --git a/src/lib/server/eliom_bus.ml b/src/lib/server/eliom_bus.ml index 71b2d6a61f..eadff36b7f 100644 --- a/src/lib/server/eliom_bus.ml +++ b/src/lib/server/eliom_bus.ml @@ -56,7 +56,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 :> (_, _ list, _, _, _, Eliom_service.non_ext, _, _, _, _, _) diff --git a/src/lib/server/eliom_comet.ml b/src/lib/server/eliom_comet.ml index c05d323533..f184c95493 100644 --- a/src/lib/server/eliom_comet.ml +++ b/src/lib/server/eliom_comet.ml @@ -150,7 +150,6 @@ struct match Weak.get channel 0 with | None -> [%lwt raise ( Not_found)] - [@warning "-22"] (* terminates the loop: remove reference on the stream, etc ... *) | Some channel -> channel.ch_index <- succ channel.ch_index; @@ -232,17 +231,17 @@ struct | Eliom_lib.Left (channel, position) -> match position with | Eliom_comet_base.Newest i when i > channel.ch_index -> false - | Eliom_comet_base.Newest _i -> true + | Eliom_comet_base.Newest i -> true | Eliom_comet_base.After i when i > channel.ch_index -> false - | Eliom_comet_base.After _i -> true - | Eliom_comet_base.Last _n when (Dlist.size channel.ch_content) > 0 -> true - | Eliom_comet_base.Last _n -> false + | Eliom_comet_base.After i -> true + | Eliom_comet_base.Last n when (Dlist.size channel.ch_content) > 0 -> true + | Eliom_comet_base.Last n -> false let really_wait_data requests = let rec make_list = function | [] -> [] | (Eliom_lib.Left (channel,_))::q -> (Lwt_condition.wait channel.ch_wakeup)::(make_list q) - | Eliom_lib.Right _ :: _q -> + | Eliom_lib.Right _ :: q -> assert false (* closed channels are considered to have data *) in Lwt.pick (make_list requests) @@ -284,9 +283,9 @@ struct Eliom_comet_base.Comet_service (Eliom_common.force_lazy_site_value global_service) - 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) @@ -494,7 +493,6 @@ end = struct let ri = Eliom_request_info.get_ri () in let%lwt () = Ocsigen_extensions.Ocsigen_request_info.connection_closed ri in [%lwt raise ( Connection_closed)] - [@ocaml.warning "-22"] (* register the service handler.hd_service *) let run_handler handler = @@ -550,7 +548,7 @@ end = struct Lwt.return (encode_downgoing []) in let - {hd_service = Eliom_comet_base.Internal_comet_service service; _} = + {hd_service = Eliom_comet_base.Internal_comet_service service} = handler in Comet.register ~scope:handler.hd_scope ~service f @@ -669,11 +667,11 @@ end = struct ch_stream = stream; ch_id = name; } - let get_id {ch_id;_} = + let get_id {ch_id} = ch_id - let get_service {ch_handler;_} = - let {hd_service = Ecb.Internal_comet_service srv; _} = ch_handler in + let get_service {ch_handler} = + let {hd_service = Ecb.Internal_comet_service srv} = ch_handler in Ecb.Comet_service srv end @@ -820,7 +818,7 @@ end = struct let create ?scope ?name ?(size=1000) stream = match scope with | None -> create_stateful ?name ~size stream - | Some ((`Client_process _n) as scope) -> create_stateful ~scope ?name ~size stream + | Some ((`Client_process n) as scope) -> create_stateful ~scope ?name ~size stream | Some `Site -> create_stateless ?name ~size stream let external_channel ?(history=1) ?(newest=false) ~prefix ~name () = diff --git a/src/lib/server/eliom_config.ml b/src/lib/server/eliom_config.ml index 2c65c845b5..8d8e31d019 100644 --- a/src/lib/server/eliom_config.ml +++ b/src/lib/server/eliom_config.ml @@ -38,7 +38,7 @@ let get_default_links_xhr () = let sitedata = Eliom_request_info.find_sitedata "get_default_links_xhr" in sitedata.Eliom_common.default_links_xhr#get -let set_default_links_xhr ?override_configfile:_ v = +let set_default_links_xhr ?override_configfile v = let sitedata = Eliom_request_info.find_sitedata "set_default_links_xhr" in sitedata.Eliom_common.default_links_xhr#set v diff --git a/src/lib/server/eliom_content_core.ml b/src/lib/server/eliom_content_core.ml index a1751e6873..e48250eca1 100644 --- a/src/lib/server/eliom_content_core.ml +++ b/src/lib/server/eliom_content_core.ml @@ -56,7 +56,7 @@ module Xml = struct wrapper_mark : elt Eliom_wrap.wrapper } - let content { elt; _ } = match elt.recontent with + let content { elt } = match elt.recontent with | RE e -> e | RELazy e -> Eliom_lazy.force e @@ -64,14 +64,14 @@ module Xml = struct let node_ids_in_content = ref Node_id_set.empty let wrapper_mark = Eliom_wrap.create_wrapper - (fun { elt; _ } -> + (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 @@ -85,7 +85,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 @@ -242,7 +242,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 diff --git a/src/lib/server/eliom_error_pages.ml b/src/lib/server/eliom_error_pages.ml index 1380319eaa..31c1f677d1 100644 --- a/src/lib/server/eliom_error_pages.ml +++ b/src/lib/server/eliom_error_pages.ml @@ -22,15 +22,15 @@ open Html.F let page_error_param_type l = let s = match l with - [] -> [txt "Wrong type for parameter"] - | [(n,_)] -> [txt "Wrong type for parameter ";em [txt n];txt "."] + [] -> [pcdata "Wrong type for parameter"] + | [(n,_)] -> [pcdata "Wrong type for parameter ";em [pcdata n];pcdata "."] | (n,_)::ll -> - (txt "Wrong type for parameters "):: - (List.fold_left (fun deb (n,_) -> (em [txt n])::(txt ", ")::deb) - [em [txt n];txt "."] ll) + (pcdata "Wrong type for parameters "):: + (List.fold_left (fun deb (n,_) -> (em [pcdata n])::(pcdata ", ")::deb) + [em [pcdata n];pcdata "."] ll) in html - (head (title (txt "")) []) + (head (title (pcdata "")) []) (body [h1 s] ) @@ -38,36 +38,36 @@ let page_error_param_type l = let page_bad_param after_action gl pl = let s = "Wrong parameters" in html - (head (title (txt s)) []) + (head (title (pcdata s)) []) (body - ((h1 [txt s]):: + ((h1 [pcdata s]):: (if Ocsigen_config.get_debugmode () then - [h2 [txt "Debugging information:"]; + [h2 [pcdata "Debugging information:"]; (if after_action then - (p [txt "An action occurred successfully. But Eliom was unable to find the service for displaying the page."]) + (p [pcdata "An action occurred successfully. But Eliom was unable to find the service for displaying the page."]) else - (p [txt "Eliom was unable to find a service matching these parameters."])); + (p [pcdata "Eliom was unable to find a service matching these parameters."])); (match gl with - | [] -> p [txt "No GET parameters have been given to services."] + | [] -> p [pcdata "No GET parameters have been given to services."] | (n, a)::l -> - p ((txt "GET parameters given to services: "):: + p ((pcdata "GET parameters given to services: "):: [em - ((txt n)::(txt "=")::(txt a):: + ((pcdata n)::(pcdata "=")::(pcdata a):: (List.fold_right (fun (n, a) b -> - (txt "&"):: - (txt n)::(txt "=")::(txt a)::b) - l [txt "."]))])); + (pcdata "&"):: + (pcdata n)::(pcdata "=")::(pcdata a)::b) + l [pcdata "."]))])); (match pl with - | [] -> p [txt "No POST parameters have been given to services."] + | [] -> p [pcdata "No POST parameters have been given to services."] | a::l -> - p ((txt "Names of POST parameters given to services: "):: - (em [txt a]):: + p ((pcdata "Names of POST parameters given to services: "):: + (em [pcdata a]):: (List.fold_right - (fun n b -> (txt ", ")::(em [txt n])::b) - l [txt "."])))] + (fun n b -> (pcdata ", ")::(em [pcdata n])::b) + l [pcdata "."])))] else []) ) ) @@ -75,7 +75,7 @@ let page_bad_param after_action gl pl = let page_session_expired = let s = "Session expired" in html - (head (title (txt s)) []) + (head (title (pcdata s)) []) (body - [h1 [txt s]] + [h1 [pcdata s]] ) diff --git a/src/lib/server/eliom_extension.ml b/src/lib/server/eliom_extension.ml index 31cedadde6..e885c6ab5f 100644 --- a/src/lib/server/eliom_extension.ml +++ b/src/lib/server/eliom_extension.ml @@ -35,6 +35,6 @@ let register_eliom_extension f = let get_eliom_extension () = !module_action -let run_eliom_extension (fext : eliom_extension_sig) _now info sitedata = +let run_eliom_extension (fext : eliom_extension_sig) now info sitedata = let sp = Eliom_common.make_server_params sitedata info None None in Lwt.with_value Eliom_common.sp_key (Some sp) fext diff --git a/src/lib/server/eliom_extension_template.ml b/src/lib/server/eliom_extension_template.ml index 2c9c3870bb..ca4991dafc 100644 --- a/src/lib/server/eliom_extension_template.ml +++ b/src/lib/server/eliom_extension_template.ml @@ -27,7 +27,7 @@ let _ = Eliom_extension.register_eliom_extension - (fun _sp -> + (fun sp -> Lwt.return (Ocsigen_extensions.Ext_found (fun () -> diff --git a/src/lib/server/eliom_mkreg.ml b/src/lib/server/eliom_mkreg.ml index 40ee4838a3..499a8381c9 100644 --- a/src/lib/server/eliom_mkreg.ml +++ b/src/lib/server/eliom_mkreg.ml @@ -120,7 +120,6 @@ let check_process_redir sp f param = (Lazy.force (Ocsigen_extensions.Ocsigen_request_info.get_params ri)) ))))] - [@ocaml.warning "-22"] (* We do not put hostname and port. It is ok with half or full xhr redirections. *) (* If an action occured before, @@ -206,7 +205,7 @@ let register_aux pages | None -> None | Some t -> Some (t, ref (t +. Unix.time ())) in - let f table attsernames = + let f table ((attserget, attserpost) as attsernames) = Eliom_route.add_service priority table @@ -519,7 +518,7 @@ let send pages Lwt.return (pages.result_of_http_result result) let register pages - ?app:_ + ?app ?scope ?options ?charset @@ -557,8 +556,8 @@ let register pages | _ -> raise (Eliom_common.Eliom_site_information_not_available "register")) - | None, Some _sp - | Some `Site, Some _sp -> + | None, Some sp + | Some `Site, Some sp -> register_aux pages ?options ?charset diff --git a/src/lib/server/eliom_notif.ml b/src/lib/server/eliom_notif.ml index 2a9263c88b..978615a815 100644 --- a/src/lib/server/eliom_notif.ml +++ b/src/lib/server/eliom_notif.ml @@ -174,7 +174,7 @@ module Make (A : ARG) : S I.remove identity id module Ext = struct - let unlisten ?sitedata:_ state (key : A.key) = + let unlisten ?sitedata state (key : A.key) = let uc = Eliom_reference.Volatile.Ext.get state identity_r in I.remove uc key end diff --git a/src/lib/server/eliom_parameter.ml b/src/lib/server/eliom_parameter.ml index f172d66ca8..315b6497fc 100644 --- a/src/lib/server/eliom_parameter.ml +++ b/src/lib/server/eliom_parameter.ml @@ -57,7 +57,7 @@ let all_suffix_user let regexp reg dest ~to_string n = user_type - ~of_string:(fun s -> + (fun s -> match Netstring_pcre.string_match reg s 0 with | Some _ -> begin @@ -68,13 +68,13 @@ let regexp reg dest ~to_string n = raise (Failure "User does not exist") end | _ -> raise (Failure "Regexp not matching")) - ~to_string + 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 - ~of_string:(fun s -> + (fun s -> match Netstring_pcre.string_match reg s 0 with | Some _ -> begin @@ -85,7 +85,7 @@ let all_suffix_regexp reg dest ~(to_string : 'a -> string) (n : string) : raise (Failure "User does not exist") end | _ -> raise (Failure "Regexp not matching")) - ~to_string + to_string n (* Non localized parameters *) @@ -94,8 +94,7 @@ let get_non_localized_parameters params files ~getorpost ~sp {name; get; post; - param = paramtype; - _} = + param = paramtype} = (* non localized parameters are parsed only once, and cached in request_cache *) let key = match getorpost with `Get -> get | `Post -> post in diff --git a/src/lib/server/eliom_react.ml b/src/lib/server/eliom_react.ml index b4587d46ff..cf41ea1461 100644 --- a/src/lib/server/eliom_react.ml +++ b/src/lib/server/eliom_react.ml @@ -59,8 +59,8 @@ 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 @@ -87,7 +87,7 @@ struct match scope with | Some `Site -> stateless ?throttling ?name ?size e | None -> stateful ?throttling ?name ?size e - | Some ((`Client_process _n) as scope) -> + | Some ((`Client_process n) as scope) -> stateful ~scope ?throttling ?name ?size e in { t; react_down_mark=react_down_mark () } @@ -212,8 +212,7 @@ struct let wrap_stateful {throttling=t; signal=s; - name=name; - _} = + name=name} = let s : 'a S.t = (match t with | None -> s @@ -227,14 +226,13 @@ struct let wrap_stateless {sl_signal=s; - channel; - _} = + 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 @@ -266,7 +264,7 @@ struct match scope with | Some `Site -> stateless ?throttling ?name s | None -> stateful ?throttling ?name s - | Some ((`Client_process _n) as scope) -> + | Some ((`Client_process n) as scope) -> stateful ~scope ?throttling ?name s in { t; signal_down_mark=signal_down_mark () } diff --git a/src/lib/server/eliom_reference.ml b/src/lib/server/eliom_reference.ml index 815c81ade1..88f1add3ad 100644 --- a/src/lib/server/eliom_reference.ml +++ b/src/lib/server/eliom_reference.ml @@ -154,7 +154,7 @@ module Volatile = struct let modify state eref f = set state eref (f (get state eref)) - let unset state (_f, _, table : _ eref) = + let unset state (f, _, table : _ eref) = match table with | Vol t -> Eliom_state.Ext.Low_level.remove_volatile_data ~state ~table:(Lazy.force t); @@ -245,7 +245,7 @@ let set (_, _, table as eref) value = let modify eref f = get eref >>= fun x -> set eref (f x) -let unset (_f, _, table as eref) = +let unset (f, _, table as eref) = match table with | Per t -> t >>= fun t -> diff --git a/src/lib/server/eliom_registration.ml b/src/lib/server/eliom_registration.ml index 6fb7e12a1c..e80dcfb76c 100644 --- a/src/lib/server/eliom_registration.ml +++ b/src/lib/server/eliom_registration.ml @@ -94,7 +94,6 @@ module Html_make_reg_base | Some headers -> Http_headers.with_defaults headers (Ocsigen_http_frame.Result.headers r)) ()) - [@@ocaml.warning "-27"] end @@ -159,7 +158,6 @@ module Make_typed_xml_registration Http_headers.with_defaults headers (Ocsigen_http_frame.Result.headers r)) ()) - [@@ocaml.warning "-27"] end @@ -283,7 +281,6 @@ module HtmlText_reg_base = struct | Some headers -> Http_headers.with_defaults headers (Ocsigen_http_frame.Result.headers r)) ()) - [@@ocaml.warning "-27"] end @@ -312,13 +309,11 @@ module Action_reg_base = struct in the configuration file (they have already been taken into account) *) fun ri res -> Polytables.set - ~table:(Ocsigen_extensions.Ocsigen_request_info.request_cache ri) - ~key:Eliom_common.found_stop_key - ~value:(); + (Ocsigen_extensions.Ocsigen_request_info.request_cache ri) Eliom_common.found_stop_key (); res let send - ?(options = `Reload) ?charset:_ ?(code = 204) + ?(options = `Reload) ?charset ?(code = 204) ?content_type ?headers () = let user_cookies = Eliom_request_info.get_user_cookies () in if options = `NoReload @@ -359,7 +354,7 @@ module Action_reg_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 @@ -418,9 +413,9 @@ module Action_reg_base = struct (* no post params, GET attached coservice *) -> Polytables.set - ~table:(Ocsigen_extensions.Ocsigen_request_info.request_cache ri.Ocsigen_extensions.request_info) - ~key:Eliom_common.eliom_params_after_action - ~value:(si.Eliom_common.si_all_get_params, + (Ocsigen_extensions.Ocsigen_request_info.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, @@ -448,9 +443,9 @@ module Action_reg_base = struct (* retry without POST params *) Polytables.set - ~table:(Ocsigen_extensions.Ocsigen_request_info.request_cache ri.Ocsigen_extensions.request_info) - ~key:Eliom_common.eliom_params_after_action - ~value:(si.Eliom_common.si_all_get_params, + (Ocsigen_extensions.Ocsigen_request_info.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, si.Eliom_common.si_all_file_params, si.Eliom_common.si_nl_get_params, @@ -480,9 +475,9 @@ module Action_reg_base = struct (we impose GET to prevent that) *) Polytables.set - ~table:(Ocsigen_extensions.Ocsigen_request_info.request_cache ri.Ocsigen_extensions.request_info) - ~key:Eliom_common.eliom_params_after_action - ~value:(si.Eliom_common.si_all_get_params, + (Ocsigen_extensions.Ocsigen_request_info.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, si.Eliom_common.si_all_file_params, si.Eliom_common.si_nl_get_params, @@ -523,8 +518,8 @@ module Unit_reg_base = struct let send_appl_content = Eliom_service.XAlways - let send ?options:_ ?charset:_ ?(code = 204) - ?content_type ?headers _content = + let send ?options ?charset ?(code = 204) + ?content_type ?headers content = let empty_result = Ocsigen_http_frame.Result.empty () in Lwt.return (Ocsigen_http_frame.Result.update empty_result @@ -556,7 +551,7 @@ module Any_reg_base = struct (* let send_appl_content = Eliom_service.XNever *) let send_appl_content = Eliom_service.XAlways - let send ?options:_ ?charset ?code:_ + let send ?options ?charset ?code ?content_type ?headers (res:'a kind) = let res = Result_types.cast_kind res in Lwt.return @@ -624,7 +619,7 @@ module File_reg_base = struct let sp = Eliom_common.get_sp () in let request = Eliom_request_info.get_request_sp sp in let file = - 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? *) | Ocsigen_local_files.Failed_404 @@ -662,7 +657,7 @@ 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 () : Ocsigen_local_files.resolved); true with @@ -687,7 +682,7 @@ module File_ct_reg_base = struct let sp = Eliom_common.get_sp () in let request = Eliom_request_info.get_request_sp sp in let file = - 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? *) | Ocsigen_local_files.Failed_404 @@ -725,7 +720,7 @@ 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 () : Ocsigen_local_files.resolved); true with @@ -745,7 +740,7 @@ module Streamlist_reg_base = struct let send_appl_content = Eliom_service.XNever - let send ?options:_ ?charset ?code + let send ?options ?charset ?code ?content_type ?headers content = Ocsigen_senders.Streamlist_content.result_of_content content >>= fun r -> Lwt.return @@ -949,7 +944,7 @@ module Ocaml_reg_base = struct let send_appl_content = Eliom_service.XNever - let send ?options:_ ?charset ?code + let send ?options ?charset ?code ?content_type ?headers content = Result_types.cast_kind_lwt (Text.send ?charset ?code @@ -1353,7 +1348,7 @@ module Eliom_appl_reg_make_param @ [Eliom_content.Html.F.a_src uri] in - Eliom_content.Html.F.script ~a (Eliom_content.Html.F.txt "") :: rem + Eliom_content.Html.F.script ~a (Eliom_content.Html.F.pcdata "") :: rem end else rem @@ -1655,7 +1650,7 @@ module String_redir_reg_base = struct let send_appl_content = Eliom_service.XAlways (* actually, the service will decide itself *) - let send ?(options = `Found) ?charset:_ ?code + let send ?(options = `Found) ?charset ?code ?content_type ?headers content = let uri = content in let empty_result = Ocsigen_http_frame.Result.empty () in @@ -1734,7 +1729,7 @@ module Redir_reg_base = struct let send_appl_content = Eliom_service.XAlways (* actually, the service will decide itself *) - let send ?(options = `Found) ?charset:_ ?code + let send ?(options = `Found) ?charset ?code ?content_type ?headers (Redirection service) = let uri = Eliom_uri.make_string_uri ~service () in let empty_result = Ocsigen_http_frame.Result.empty () in diff --git a/src/lib/server/eliom_route.ml b/src/lib/server/eliom_route.ml index 5873f240f5..fb90ea9665 100644 --- a/src/lib/server/eliom_route.ml +++ b/src/lib/server/eliom_route.ml @@ -12,7 +12,7 @@ include Eliom_route_base.Make (struct let sess_info_of_info (_, i, _, _, _) = i - let meth_of_info ({request_info; _}, _, _, _, _) = + let meth_of_info ({request_info}, _, _, _, _) = match Ocsigen_request_info.meth request_info with | Ocsigen_http_frame.Http_header.GET -> `Get @@ -25,7 +25,7 @@ include Eliom_route_base.Make (struct | _ -> `Other - let subpath_of_info ({request_info; _}, _, _, _, _) = + let subpath_of_info ({request_info}, _, _, _, _) = Ocsigen_request_info.sub_path request_info module Container = struct @@ -34,7 +34,7 @@ include Eliom_route_base.Make (struct 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 @@ -87,7 +87,7 @@ include Eliom_route_base.Make (struct end) -let find_aux now sitedata info _e sci : Ocsigen_http_frame.Result.result Lwt.t = +let find_aux now sitedata info e sci : Ocsigen_http_frame.Result.result Lwt.t = Eliom_common.Full_state_name_table.fold (fun fullsessname (_, r) beg -> try%lwt @@ -174,9 +174,9 @@ let get_page *) Lwt_log.ign_info ~section "Link too old. Try without POST parameters:"; Polytables.set - ~table:(Ocsigen_request_info.request_cache ri.request_info) - ~key:Eliom_common.eliom_link_too_old - ~value:true; + (Ocsigen_request_info.request_cache ri.request_info) + Eliom_common.eliom_link_too_old + true; fail (Eliom_common.Eliom_retry_with ({ri with request_info = Ocsigen_request_info.update ri.request_info @@ -208,9 +208,9 @@ let get_page *) Lwt_log.ign_info ~section "Link to old. Trying without GET state parameters and POST parameters:"; Polytables.set - ~table:(Ocsigen_request_info.request_cache ri.request_info) - ~key:Eliom_common.eliom_link_too_old - ~value:true; + (Ocsigen_request_info.request_cache ri.request_info) + Eliom_common.eliom_link_too_old + true; fail (Eliom_common.Eliom_retry_with ({ri with request_info = Ocsigen_request_info.update ri.request_info @@ -401,9 +401,9 @@ let make_naservice (*VVV (Some, Some) or (_, Some)? *) Lwt_log.ign_info ~section "Link too old to a non-attached POST coservice. Try without POST parameters:"; Polytables.set - ~table:(Ocsigen_request_info.request_cache ri.request_info) - ~key:Eliom_common.eliom_link_too_old - ~value:true; + (Ocsigen_request_info.request_cache ri.request_info) + Eliom_common.eliom_link_too_old + true; Eliom_common.get_session_info {ri with Ocsigen_extensions.request_info = Ocsigen_request_info.update ri.request_info @@ -418,7 +418,7 @@ let make_naservice () } si.Eliom_common.si_previous_extension_error - >>= fun (ri', si', _previous_tab_cookies_info) -> + >>= fun (ri', si', previous_tab_cookies_info) -> Lwt.fail (Eliom_common.Eliom_retry_with (ri', si', all_cookie_info, @@ -429,9 +429,9 @@ let make_naservice | Eliom_common.RNa_get' _ -> Lwt_log.ign_info ~section "Link too old. Try without non-attached parameters:"; Polytables.set - ~table:(Ocsigen_request_info.request_cache ri.request_info) - ~key:Eliom_common.eliom_link_too_old - ~value:true; + (Ocsigen_request_info.request_cache ri.request_info) + Eliom_common.eliom_link_too_old + true; Eliom_common.get_session_info {ri with request_info = Ocsigen_request_info.update ri.request_info @@ -446,7 +446,7 @@ let make_naservice () } si.Eliom_common.si_previous_extension_error - >>= fun (ri', si', _previous_tab_cookies_info) -> + >>= fun (ri', si', previous_tab_cookies_info) -> Lwt.fail (Eliom_common.Eliom_retry_with (ri', si', all_cookie_info, all_tab_cookie_info, diff --git a/src/lib/server/eliom_service.ml b/src/lib/server/eliom_service.ml index 4a0321fc87..94f0450b13 100644 --- a/src/lib/server/eliom_service.ml +++ b/src/lib/server/eliom_service.ml @@ -242,7 +242,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 = @@ -253,16 +253,16 @@ let attach : | SNa_get_ s -> SAtt_na_named s | SNa_get' s -> SAtt_na_anon s | SNa_get_csrf_safe a -> SAtt_na_csrf_safe a - | SNa_post_ _s -> fallbackkind.get_name (*VVV check *) - | SNa_post' _s -> fallbackkind.get_name (*VVV check *) - | SNa_post_csrf_safe _a -> fallbackkind.get_name (*VVV check *) + | SNa_post_ s -> fallbackkind.get_name (*VVV check *) + | SNa_post' s -> fallbackkind.get_name (*VVV check *) + | SNa_post_csrf_safe a -> fallbackkind.get_name (*VVV check *) | _ -> failwith error_msg (*VVV Do we want to make possible to attach POST na coservices on GET attached coservices? *) and post_name = match na_name with - | SNa_get_ _s -> SAtt_no - | SNa_get' _s -> SAtt_no - | SNa_get_csrf_safe _a -> SAtt_no + | SNa_get_ s -> SAtt_no + | SNa_get' s -> SAtt_no + | SNa_get_csrf_safe a -> SAtt_no | SNa_post_ s -> SAtt_na_named s | SNa_post' s -> SAtt_na_anon s | SNa_post_csrf_safe a -> SAtt_na_csrf_safe a @@ -393,7 +393,7 @@ let unregister ?scope ?secure raise (Eliom_common.Eliom_site_information_not_available "unregister")) - | Some _sp -> + | Some sp -> Eliom_state.get_global_table () in remove_service table service diff --git a/src/lib/server/eliom_state.ml b/src/lib/server/eliom_state.ml index e1c4d8ace5..7a773abac6 100644 --- a/src/lib/server/eliom_state.ml +++ b/src/lib/server/eliom_state.ml @@ -161,7 +161,7 @@ let set_global_persistent_data_state_timeout 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_o:secure ~sitedata () in + let secure = Eliom_common.get_secure secure sitedata () in Eliommod_timeouts.get_global ~kind:`Service ~cookie_scope ~secure sitedata @@ -394,7 +394,7 @@ let rec close_volatile_state_if_empty ~scope ?secure () = -let close_persistent_state_if_empty ~scope:_ ?secure:_ () = +let close_persistent_state_if_empty ~scope ?secure () = Lwt.return_unit (*VVV Can we implement this function? *) @@ -481,7 +481,7 @@ let get_service_session_group_size in match !(c.Eliom_common.sc_session_group) with | _, _, Right _ -> None - | _, _, Left _v -> + | _, _, Left v -> Some (Eliommod_sessiongroups.Serv.group_size !(c.Eliom_common.sc_session_group)) with | Not_found @@ -564,7 +564,7 @@ let get_volatile_data_session_group_size in match !(c.Eliom_common.dc_session_group) with | _, _, Right _ -> None - | _, _, Left _v -> + | _, _, Left v -> Some (Eliommod_sessiongroups.Data.group_size !(c.Eliom_common.dc_session_group)) with | Not_found @@ -971,7 +971,7 @@ let create_volatile_table ~scope ?secure () = | None -> raise (Eliom_common.Eliom_site_information_not_available "create_volatile_table")) - | Some _sp -> + | Some sp -> let sp = Eliom_common.get_sp () in let sitedata = Eliom_request_info.get_sitedata_sp ~sp in let secure = Eliom_common.get_secure ~secure_o:secure ~sitedata () in @@ -1276,16 +1276,16 @@ module Ext = struct in Eliommod_sessiongroups.Pers.remove_group ~cookie_level:`Session sitedata sgr_o - | (_, `Service, (_cookie : string)) -> + | (_, `Service, (cookie : string)) -> let (_, (_, _, _, _, _sgr, sgrnode)) = get_service_cookie_info state in Eliommod_sessiongroups.Serv.remove sgrnode; Lwt.return_unit - | (_, `Data, _cookie) -> + | (_, `Data, cookie) -> let (_, (_, _, _, _sgr, sgrnode)) = get_volatile_data_cookie_info state in Eliommod_sessiongroups.Data.remove sgrnode; Lwt.return_unit - | (_, `Pers, _cookie) -> + | (_, `Pers, cookie) -> get_persistent_cookie_info state >>= fun (cookie, ((scope, _, _), _, _, sgr_o)) -> let sitedata = get_sitedata () in @@ -1307,8 +1307,8 @@ module Ext = struct | `Client_process _ -> failwith "fold_sub_states" in let reduce_level = function - | `Session_group _n -> `Session - | `Session _n -> `Client_process + | `Session_group n -> `Session + | `Session n -> `Client_process | `Client_process _ -> failwith "fold_sub_states" in let sub_states_level = reduce_level s in @@ -1338,7 +1338,7 @@ module Ext = struct ~(state : Eliom_common.user_scope * [> `Data | `Service ] * string) f e = let state' = (state :> ('aa, 'bb) state) in - let (_sitedata, _sub_states_level, _id, _f) as a = + let (sitedata, sub_states_level, id, f) as a = fold_sub_states_aux_aux ?sitedata ~state:state' f in fold_sub_states_aux Ocsigen_cache.Dlist.fold Ocsigen_lib.id a e state @@ -1350,7 +1350,7 @@ module Ext = struct | (_, `Pers, _) -> (Eliommod_sessiongroups.Pers.find (Eliom_common.make_persistent_full_group_name - ~cookie_level:sub_states_level sitedata.Eliom_common.site_dir_string (Some id)) + sub_states_level sitedata.Eliom_common.site_dir_string (Some id)) >>= fun l -> Lwt_list.fold_left_s f e l) | _ -> @@ -1384,7 +1384,7 @@ module Ext = struct (*VVV Does not work with volatile group data *) let get_volatile_data ~state:((state_scope, _, cookie) : ('s, [ `Data ]) state) - ~table:(table_scope, _secure, t : 'a volatile_table) = + ~table:(table_scope, secure, t : 'a volatile_table) = check_scopes table_scope state_scope; Eliom_common.SessionCookies.find t cookie @@ -1396,7 +1396,7 @@ module Ext = struct let set_volatile_data ~state:((state_scope, _, cookie) : ('s, [ `Data ]) state) - ~table:(table_scope, _secure, t : 'a volatile_table) + ~table:(table_scope, secure, t : 'a volatile_table) value = check_scopes table_scope state_scope; Eliom_common.SessionCookies.replace t cookie value @@ -1464,7 +1464,7 @@ module Ext = struct let unset_service_cookie_timeout ~cookie:(_, (_, _, _, r, _, _)) = r := TGlobal - let unset_volatile_data_cookie_timeout ~cookie:(_cookie, (_, _, r, _, _)) = + let unset_volatile_data_cookie_timeout ~cookie:(cookie, (_, _, r, _, _)) = r := TGlobal let unset_persistent_data_cookie_timeout diff --git a/src/lib/shared/eliom_comet_base.ml b/src/lib/shared/eliom_comet_base.ml index 515c720189..7c0036cd68 100644 --- a/src/lib/shared/eliom_comet_base.ml +++ b/src/lib/shared/eliom_comet_base.ml @@ -24,7 +24,6 @@ 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" -[@@@ocaml.warning "-39"] type position = | Newest of int | After of int @@ -65,7 +64,6 @@ type answer = | State_closed | Comet_error of string [@@deriving json] -[@@@ocaml.warning "+39"] type comet_service = Comet_service : diff --git a/src/lib/shared/eliom_common_base.ml b/src/lib/shared/eliom_common_base.ml index ca78d4f60b..9fe214d5e1 100644 --- a/src/lib/shared/eliom_common_base.ml +++ b/src/lib/shared/eliom_common_base.ml @@ -55,14 +55,14 @@ type cookie_scope = [ `Session of scope_hierarchy | `Client_process of scope_hierarchy ] let level_of_user_scope : [< user_scope ] -> [> user_level ] = function - | `Session _n -> `Session - | `Session_group _n -> `Session_group - | `Client_process _n -> `Client_process + | `Session n -> `Session + | `Session_group n -> `Session_group + | `Client_process n -> `Client_process let cookie_level_of_user_scope : [< user_scope ] -> [> cookie_level ] = function - | `Session _n - | `Session_group _n -> `Session - | `Client_process _n -> `Client_process + | `Session n + | `Session_group n -> `Session + | `Client_process n -> `Client_process let cookie_scope_of_user_scope : [< user_scope ] -> [> cookie_scope ] = function | `Session n @@ -314,7 +314,7 @@ let prefixlengthminusone = prefixlength - 1 let split_nl_prefix_param l = let rec aux other map = function | [] -> (map, other) - | ((n, _v) as a)::l -> + | ((n, v) as a)::l -> if String.first_diff n nl_param_prefix 0 prefixlengthminusone = prefixlength then @@ -349,7 +349,7 @@ let remove_prefixed_param pref l = let len = String.length pref in let rec aux = function | [] -> [] - | ((n,_v) as a)::l -> + | ((n,v) as a)::l -> try if (String.sub n 0 len) = pref then aux l diff --git a/src/lib/shared/eliom_cookies_base.ml b/src/lib/shared/eliom_cookies_base.ml index 6d4a33d31b..aff3913e41 100644 --- a/src/lib/shared/eliom_cookies_base.ml +++ b/src/lib/shared/eliom_cookies_base.ml @@ -1,7 +1,5 @@ open Ocsigen_cookies -[@@@ocaml.warning "-39"] - type cookie = Ocsigen_cookies.cookie = | OSet of float option (* exp date *) * string (* value *) * bool (* secure *) | OUnset @@ -11,8 +9,6 @@ type cookie_array = ( string array * (( string * cookie ) array )) array [@@deriving json] -[@@@ocaml.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/shared/eliom_parameter_base.ml b/src/lib/shared/eliom_parameter_base.ml index e6e6d13e33..583cdd9c98 100644 --- a/src/lib/shared/eliom_parameter_base.ml +++ b/src/lib/shared/eliom_parameter_base.ml @@ -193,12 +193,12 @@ 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 _n -> (make_suffix (TAtom ("",TInt)) (params.abscissa))@ + | TCoord n -> (make_suffix (TAtom ("",TInt)) (params.abscissa))@ (make_suffix (TAtom ("",TInt)) (params.ordinate)) | TUnit -> [""] | TConst v -> [v] @@ -220,7 +220,7 @@ let rec make_suffix : type a c. (a,'b,c) params_type -> a -> string list = fun t (make_suffix typ l)) | TUserType (_, tao) -> [ Eliom_common.To_and_of_shared.to_string tao params ] - | TTypeFilter (t, _check) -> make_suffix t params + | TTypeFilter (t, check) -> make_suffix t params | TSum (t1, t2) -> (match params with | Inj1 p -> make_suffix t1 p @@ -239,7 +239,7 @@ let rec aux : type a c. (a,'b,c) params_type -> string list option -> 'y -> a -> 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) -> @@ -283,7 +283,7 @@ let rec aux : type a c. (a,'b,c) params_type -> string list option -> 'y -> a -> psuff, nlp, ((pref ^ name ^ suff), insert_string (Eliom_common.To_and_of_shared.to_string tao params)) :: l - | TTypeFilter (t, _check) -> aux t psuff nlp params pref suff l + | TTypeFilter (t, check) -> aux t psuff nlp params pref suff l | TUnit -> psuff, nlp, l | TAny -> psuff, nlp, l@(List.map (fun (x,v) -> x,insert_string v) params) | TConst _ -> psuff, nlp, l @@ -359,11 +359,11 @@ let rec walk_parameter_tree : type a c. string -> (a,'b,c) params_type -> a to_a | TAny -> None | TNLParams _ -> None | TUnit -> None - | TOption (_o,_) -> failwith "walk_parameter_tree with option" - | TSet _o -> failwith "walk_parameter_tree with set" - | TList (_, _o) -> failwith "walk_parameter_tree with list" - | TProd (_a, _b) -> failwith "walk_parameter_tree with tuple" - | TSum (_a, _b) -> failwith "walk_parameter_tree with sum" + | TOption (o,_) -> failwith "walk_parameter_tree with option" + | TSet o -> failwith "walk_parameter_tree with set" + | TList (_, o) -> failwith "walk_parameter_tree with list" + | TProd (a, b) -> failwith "walk_parameter_tree with tuple" + | TSum (a, b) -> failwith "walk_parameter_tree with sum" | TRaw_post_data -> failwith "walk_parameter_tree with raw post data" @@ -385,12 +385,12 @@ let construct_params nonlocparams typ p = let make_params_names params = let rec aux : type a c. bool -> string -> string -> (a,'b,c) params_type -> bool * c = 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 issuffix, (a, b) - | TAtom(name,_a) -> issuffix, prefix^name^suffix + | TAtom(name,a) -> issuffix, prefix^name^suffix | TCoord(name) -> issuffix, prefix^name^suffix | TFile name -> issuffix, prefix^name^suffix | TUserType (name, _) -> issuffix, prefix^name^suffix @@ -471,7 +471,7 @@ let nl_prod specification *) 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 @@ -594,8 +594,8 @@ let reconstruct_params_ typ params files nosuffixversion urlsuffix : 'a = [] with e -> raise (Eliom_common.Eliom_Typing_Error [("", e)])) - | TOption (_t,_), [] -> None, [] - | TOption (_t,_), ""::l -> None, l + | TOption (t,_), [] -> None, [] + | TOption (t,_), ""::l -> None, l | TOption (t,_), l -> let r, ll = parse_suffix t l in Some r, ll @@ -629,14 +629,14 @@ let reconstruct_params_ typ params files nosuffixversion urlsuffix : 'a = | r, l -> let rr, ll = parse_suffix t2 l in (r, rr), ll) - | TAtom (_name, t), v::l -> + | TAtom (name, t), v::l -> (try atom_of_string t v, l with e -> raise (Eliom_common.Eliom_Typing_Error [("", e)])) - | TUserType (_name, tao), v::l -> + | TUserType (name, tao), v::l -> (try Eliom_common.To_and_of_shared.of_string tao v, l with e -> raise (Eliom_common.Eliom_Typing_Error [("", e)])) - | TTypeFilter (_t, None), _ -> failwith "Type filter without filter" + | TTypeFilter (t, None), _ -> failwith "Type filter without filter" | TTypeFilter (t, Some check), l -> let (v, _) as a = parse_suffix t l in check v; @@ -658,7 +658,7 @@ let reconstruct_params_ typ params files nosuffixversion urlsuffix : 'a = | TNLParams _, _ -> failwith "It is not possible to have non localized parameters in suffix" | TJson (_, Some typ), v::l -> Deriving_Json.from_string typ v, l - | TJson (_, None), _v::_l -> assert false (* client side only *) + | TJson (_, None), v::l -> assert false (* client side only *) | TAny, _ -> failwith "It is not possible to use any in suffix. May be try with all_suffix ?" | TFile _, _ -> assert false | TRaw_post_data, _ -> assert false @@ -689,7 +689,7 @@ let reconstruct_params_ typ params files nosuffixversion urlsuffix : 'a = and aux : type a c. (a, 'b, c) params_type -> params' -> files -> string -> string -> a res_reconstr_param = 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) -> @@ -710,7 +710,7 @@ let reconstruct_params_ typ params files nosuffixversion urlsuffix : 'a = | Errors_ (errs, ll, ff) when List.for_all (fun (_,s,_) -> s="") errs -> Res_ (None, ll, ff) | Errors_ err -> Errors_ err) with Not_found -> Res_ (None, params, files)) - | TOption (t,_b) -> + | TOption (t,b) -> (try (match aux t params files pref suff with | Res_ (v, l, f) -> Res_ (Some v, l, f) @@ -733,7 +733,7 @@ let reconstruct_params_ typ params files nosuffixversion urlsuffix : 'a = | Res_ (vv2, ll2, ff2) -> Res_ (vv::vv2, ll2, ff2) | err -> err) - | Errors_ (_errs, ll, ff) when ll = params && ff = files -> + | Errors_ (errs, ll, ff) when ll = params && ff = files -> Res_ ([], params, files) | Errors_ (errs, ll, ff) -> (match aux_set ll ff with @@ -765,7 +765,7 @@ let reconstruct_params_ typ params files nosuffixversion urlsuffix : 'a = end | TAtom (name,TBool) -> (try - let _v,l = (List.assoc_remove (pref^name^suff) params) in + let v,l = (List.assoc_remove (pref^name^suff) params) in Res_ (true,l,files) with Not_found -> Res_ (false, params, files)) @@ -804,7 +804,7 @@ let reconstruct_params_ typ params files nosuffixversion urlsuffix : 'a = let v,l = (List.assoc_remove (pref^name^suff) params) in (try Res_ (Eliom_common.To_and_of_shared.of_string tao v,l,files) with e -> Errors_ ([(pref^name^suff),v,e], l, files)) - | TTypeFilter (_t, None) -> failwith "Type filter without filter" + | TTypeFilter (t, None) -> failwith "Type filter without filter" | TTypeFilter (t, Some check) -> (match aux t params files pref suff with | Res_ (v, l, files) as a -> @@ -841,7 +841,7 @@ let reconstruct_params_ typ params files nosuffixversion urlsuffix : 'a = | TJson (name, Some typ) -> let v,l = List.assoc_remove (pref^name^suff) params in Res_ ((of_json ~typ v),l,files) - | TJson (_name, None) -> assert false + | TJson (name, None) -> assert false (* Never unmarshal server side without type! *) | TRaw_post_data -> raise Eliom_common.Eliom_Wrong_parameter in @@ -856,12 +856,12 @@ let reconstruct_params_ typ params files nosuffixversion urlsuffix : 'a = "Eliom_Wrong_parameter: params non-empty (ERROR): %a" (fun () l -> String.concat ", " (List.map (fun (x,k) -> x^"="^k) l)) l; if files <> [] then Lwt_log.ign_debug_f ~section - "Eliom_Wrong_parameter: files non-empty (ERROR): %a" (fun () files -> String.concat ", " (List.map (fun (x,_k) -> x) files)) files; + "Eliom_Wrong_parameter: files non-empty (ERROR): %a" (fun () files -> String.concat ", " (List.map (fun (x,k) -> x) files)) files; raise Eliom_common.Eliom_Wrong_parameter end | Errors_ (errs, l, files) -> if (l, files) = ([], []) - then raise (Eliom_common.Eliom_Typing_Error (List.map (fun (v,_l,e) -> (v,e)) errs)) + then raise (Eliom_common.Eliom_Typing_Error (List.map (fun (v,l,e) -> (v,e)) errs)) else raise Eliom_common.Eliom_Wrong_parameter with | Not_found -> raise Eliom_common.Eliom_Wrong_parameter diff --git a/src/lib/shared/eliom_route_base.ml b/src/lib/shared/eliom_route_base.ml index a0c1d8553a..50624b23d5 100644 --- a/src/lib/shared/eliom_route_base.ml +++ b/src/lib/shared/eliom_route_base.ml @@ -121,7 +121,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. *) @@ -202,11 +202,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 @@ -221,7 +221,7 @@ module Make (P : PARAM) = struct 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 @@ -239,7 +239,7 @@ module Make (P : PARAM) = struct - only one for each key - we add a node in the dlist to limit their number *) (try - let (nodeopt, _l), newt = + let (nodeopt, l), newt = P.Table.find key !tref, P.Table.remove key !tref in (match nodeopt with @@ -250,10 +250,9 @@ module Make (P : PARAM) = struct 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.SAtt_no, Eliom_common.SAtt_no } -> (try - let _nodeopt, l = P.Table.find key !tref + let nodeopt, l = P.Table.find key !tref and newt = P.Table.remove key !tref in (* nodeopt should be None *) try @@ -276,7 +275,7 @@ module Make (P : PARAM) = struct tref := P.Table.add key (None, [service]) !tref) | _ -> try - let _nodeopt, l = P.Table.find key !tref + let nodeopt, l = P.Table.find key !tref and newt = P.Table.remove key !tref in let _, oldl = find_and_remove_id l s_id in (* if there was an old version with the same id, we remove it *) @@ -329,7 +328,7 @@ module Make (P : PARAM) = struct let direltref = find_dircontent !dircontentref a in match !direltref with | Eliom_common.Dir dcr -> search_page_table_ref dcr l - | Eliom_common.File _ptr -> + | Eliom_common.File ptr -> raise (Eliom_common.Eliom_page_erasing a) with | Not_found -> @@ -439,7 +438,7 @@ module Make (P : PARAM) = struct | Eliom_common.File page_table_ref -> (match l with | [] -> find false page_table_ref None - | _l -> (* We have a file with suffix *) + | l -> (* We have a file with suffix *) raise Eliom_common.Eliom_Wrong_parameter))) (function | Exn1 | Eliom_common.Eliom_Wrong_parameter as e -> diff --git a/src/lib/shared/eliom_runtime.ml b/src/lib/shared/eliom_runtime.ml index 13446299c5..fce9f00b18 100644 --- a/src/lib/shared/eliom_runtime.ml +++ b/src/lib/shared/eliom_runtime.ml @@ -48,9 +48,7 @@ module RawXML = struct | Space -> " " | Comma -> ", " - [@@@ocaml.warning "-39"] type cookie_info = (bool * string list) [@@deriving json] - [@@@ocaml.warning "+39"] type caml_event_handler = | CE_registered_closure of @@ -114,10 +112,10 @@ module RawXML = struct and attrib = aname * racontent let aname = function - | name, RACamlEventHandler (CE_registered_closure (_crypto, _)) -> + | name, RACamlEventHandler (CE_registered_closure (crypto, _)) -> closure_name_prefix^name - | _, RAClient (_s, Some (name,_), _c) - | name, RAClient (_s, None, _c) -> client_name_prefix^name + | _, RAClient (s, Some (name,_), c) + | name, RAClient (s, None, c) -> client_name_prefix^name | name, _ -> name let acontent = function | _ ,RAReact s -> (match React.S.value s with None -> AStr "" | Some x -> x) @@ -165,7 +163,7 @@ module RawXML = struct let filter_class_value acc = function | AStr v -> v :: acc - | AStrL (_space, v) -> + | AStrL (space, v) -> v @ acc | _ -> failwith "attribute class is not a string" @@ -179,7 +177,7 @@ module RawXML = struct begin match Eliom_lazy.force link_info with | None -> freepos, acc_class, acc_attr - | Some (_kind, cookie_info, tmpl, _) -> + | Some (kind, cookie_info, tmpl, _) -> let acc_class = ce_call_service_class::acc_class in let acc_attr = match cookie_info with diff --git a/src/lib/shared/eliom_uri.ml b/src/lib/shared/eliom_uri.ml index 3d4aa7c062..c209d43ba2 100644 --- a/src/lib/shared/eliom_uri.ml +++ b/src/lib/shared/eliom_uri.ml @@ -44,10 +44,10 @@ let reconstruct_absolute_url_path = string_of_url_path_suff let reconstruct_relative_url_path current_url u = let rec drop cururl desturl = match cururl, desturl with - | _a::l, [_b] -> l, desturl - | [_a], m -> [], m + | a::l, [b] -> l, desturl + | [a], m -> [], m | a::l, b::m when a = b -> drop l m - | _a::l, m -> l, m + | a::l, m -> l, m | [], m -> [], m in let rec makedotdot = function | [] -> [] @@ -101,7 +101,7 @@ let make_proto_prefix 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 || @@ -354,7 +354,7 @@ let make_uri_components let make_string_uri_from_components (uri, params, fragment) = let s = - Eliom_lib.String.may_concat uri ~sep:"?" + Eliom_lib.String.may_concat uri "?" (Eliom_parameter.construct_params_string params) in match fragment with @@ -507,7 +507,7 @@ let make_post_uri_components_ (* for getparams and non localized params: *) - let _suff, params = + let suff, params = Eliom_parameter.construct_params_list nlp (Eliom_service.get_params_type service) getparams (* if nl params were already present, they will be replaced @@ -674,7 +674,7 @@ let make_cookies_info (https, service) = None else Some (Eliom_service.full_path attser) - | Eliom_service.Nonattached _naser -> + | Eliom_service.Nonattached naser -> Some (Eliom_request_info.get_csp_original_full_path ()) in match get_path_ ~service with From f6aef02ca0c8f3f0fe009c3e88100c99a2206108 Mon Sep 17 00:00:00 2001 From: John Christopher McAlpine Date: Tue, 16 Apr 2019 14:50:08 +0200 Subject: [PATCH 08/10] purge unnecessary dune libs and unnecessary warning corrections --- src/lib/server/eliommod.ml | 22 +++++++++++----------- src/lib/server/eliommod_cli.ml | 2 +- src/lib/server/eliommod_cookies.ml | 14 +++++++------- src/lib/server/eliommod_datasess.ml | 10 +++++----- src/lib/server/eliommod_gc.ml | 12 ++++++------ src/lib/server/eliommod_pagegen.ml | 24 ++++++++++++------------ src/lib/server/eliommod_persess.ml | 8 ++++---- src/lib/server/eliommod_sessadmin.ml | 14 +++++++------- src/lib/server/eliommod_sessiongroups.ml | 4 ++-- src/lib/server/eliommod_timeouts.ml | 2 +- 10 files changed, 56 insertions(+), 56 deletions(-) diff --git a/src/lib/server/eliommod.ml b/src/lib/server/eliommod.ml index 51b8129fb5..a5a12303ad 100644 --- a/src/lib/server/eliommod.ml +++ b/src/lib/server/eliommod.ml @@ -123,8 +123,8 @@ let new_sitedata = session_services = Eliommod_cookies.new_service_cookie_table (); session_data = Eliommod_cookies.new_data_cookie_table (); group_of_groups = gog; - remove_session_data = (fun _cookie -> ()); - not_bound_in_data_tables = (fun _cookie -> true); + remove_session_data = (fun cookie -> ()); + not_bound_in_data_tables = (fun cookie -> true); exn_handler = Eliommod_pagegen.def_handler; unregistered_services = []; unregistered_na_services = []; @@ -257,7 +257,7 @@ let parse_eliom_option | ("level", "clientprocess")::l | ("level", "process")::l | ("level", "tab")::l -> aux (v, sn, `Client_process) l - | ("level", _)::_l -> + | ("level", _)::l -> raise (Error_in_config_file ("Eliom: Wrong attribute value for level in "^tn^" tag")) @@ -514,7 +514,7 @@ let parse_eliom_options f l = let rec parse_global_config = function | [] -> () - | (Xml.Element ("sessiongcfrequency", [("value", s)], _p))::ll -> + | (Xml.Element ("sessiongcfrequency", [("value", s)], p))::ll -> (try let t = float_of_string s in Eliommod_gc.set_servicesessiongcfrequency (Some t); @@ -528,7 +528,7 @@ let rec parse_global_config = function else raise (Error_in_config_file "Eliom: Wrong value for ")); parse_global_config ll - | (Xml.Element ("servicesessiongcfrequency", [("value", s)], _p))::ll -> + | (Xml.Element ("servicesessiongcfrequency", [("value", s)], p))::ll -> (try Eliommod_gc.set_servicesessiongcfrequency (Some (float_of_string s)) with Failure _ -> @@ -537,7 +537,7 @@ let rec parse_global_config = function else raise (Error_in_config_file "Eliom: Wrong value for ")); parse_global_config ll - | (Xml.Element ("datasessiongcfrequency", [("value", s)], _p))::ll -> + | (Xml.Element ("datasessiongcfrequency", [("value", s)], p))::ll -> (try Eliommod_gc.set_datasessiongcfrequency (Some (float_of_string s)) with Failure _ -> @@ -547,7 +547,7 @@ let rec parse_global_config = function "Eliom: Wrong value for ")); parse_global_config ll | (Xml.Element ("persistentsessiongcfrequency", - [("value", s)], _p))::ll -> + [("value", s)], p))::ll -> (try Eliommod_gc.set_persistentsessiongcfrequency (Some (float_of_string s)) @@ -698,7 +698,7 @@ let config_in_tag = ref "" (* the parent tag of the currently handled tag *) type module_to_load = Files of string list | Name of string -let load_eliom_module _sitedata cmo_or_name parent_tag content = +let load_eliom_module sitedata cmo_or_name parent_tag content = let preload () = config := content; config_in_tag := parent_tag; @@ -790,7 +790,7 @@ let parse_config hostpattern conf_info site_dir = | (s, _)::_ -> raise (Error_in_config_file ("Wrong attribute for : "^s)) - in fun _ _parse_site -> function + in fun _ parse_site -> function | Xml.Element ("eliommodule", atts, content) -> Eliom_extension.register_eliom_extension default_module_action; @@ -825,9 +825,9 @@ let parse_config hostpattern conf_info site_dir = let state_hier : Eliom_common.scope_hierarchy = match state_hier with | None -> Eliom_common_base.Default_ref_hier - | Some s when String.lowercase_ascii s = "default" -> + | Some s when String.lowercase s = "default" -> Eliom_common_base.Default_ref_hier - | Some s when String.lowercase_ascii s = "comet" -> + | Some s when String.lowercase s = "comet" -> Eliom_common_base.Default_comet_hier | Some s -> Eliom_common_base.User_hier s in diff --git a/src/lib/server/eliommod_cli.ml b/src/lib/server/eliommod_cli.ml index be610569c0..9bf730961a 100644 --- a/src/lib/server/eliommod_cli.ml +++ b/src/lib/server/eliommod_cli.ml @@ -23,7 +23,7 @@ let fresh_id = fun () -> c := !c+1; "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 df27ed518b..bd6790b3c9 100644 --- a/src/lib/server/eliommod_cookies.ml +++ b/src/lib/server/eliommod_cookies.ml @@ -50,7 +50,7 @@ let get_cookie_info Eliom_common.Full_state_name_table.fold (fun name value (oktable, failedlist) -> try - let _full_state_name, ta, expref, timeout_ref, sessgrpref, sessgrpnode = + let full_state_name, ta, expref, timeout_ref, sessgrpref, sessgrpnode = Eliom_common.SessionCookies.find sitedata.Eliom_common.session_services value in @@ -106,7 +106,7 @@ let get_cookie_info (fun value -> lazy (try - let _full_state_name, expref, timeout_ref, sessgrpref, sessgrpnode = + let full_state_name, expref, timeout_ref, sessgrpref, sessgrpnode = Eliom_common.SessionCookies.find sitedata.Eliom_common.session_data value in @@ -154,7 +154,7 @@ let get_cookie_info (fun () -> Lazy.force Eliom_common.persistent_cookies_table >>= fun table -> Ocsipersist.find table value >>= - fun (_full_state_name, persexp, perstimeout, sessgrp) -> + fun (full_state_name, persexp, perstimeout, sessgrp) -> Eliommod_sessiongroups.Pers.up value sessgrp >>= fun () -> match persexp with @@ -391,12 +391,12 @@ let compute_new_ri_cookies' (*VVV We always keep secure cookies, event if the protocol is not secure, because this function is for actions only. Is that right? *) match v with - | Ocsigen_cookies.OSet (Some exp, value, _secure) + | Ocsigen_cookies.OSet (Some exp, value, secure) when exp>now -> CookiesTable.add name value cookies - | Ocsigen_cookies.OSet (None, value, _secure) -> + | Ocsigen_cookies.OSet (None, value, secure) -> CookiesTable.add name value cookies - | Ocsigen_cookies.OSet (Some exp, _value, _secure) + | Ocsigen_cookies.OSet (Some exp, value, secure) when exp<=now -> CookiesTable.remove name cookies | Ocsigen_cookies.OUnset -> @@ -425,7 +425,7 @@ let compute_new_ri_cookies compute_new_ri_cookies' now ripath ricookies cookies_set_by_page in (* then session cookies: *) - let f _secure (service_cookie_info, data_cookie_info, pers_cookie_info) ric = + let f secure (service_cookie_info, data_cookie_info, pers_cookie_info) ric = let ric = Eliom_common.Full_state_name_table.fold (fun ((sc, _, _) as full_st_name) (_, v) beg -> diff --git a/src/lib/server/eliommod_datasess.ml b/src/lib/server/eliommod_datasess.ml index 712f4ceb7b..6cd5c781df 100644 --- a/src/lib/server/eliommod_datasess.ml +++ b/src/lib/server/eliommod_datasess.ml @@ -41,7 +41,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 @@ -156,14 +156,14 @@ 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 let full_st_name = Eliom_common.make_full_state_name ~sp ~secure ~scope:cookie_scope in try - let (_old, ior) = + let (old, ior) = Lazy.force (Eliom_common.Full_state_name_table.find full_st_name !cookie_info) in @@ -182,7 +182,7 @@ let rec find_or_create_data_cookie ?set_session_group | Eliom_common.SC c -> (match set_session_group with | None -> () - | Some _session_group -> + | Some session_group -> let fullsessgrp = fullsessgrp ~cookie_level ~sp set_session_group in let node = Eliommod_sessiongroups.Data.move sitedata @@ -228,7 +228,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 1e9ea4d0f4..5aaf0d0096 100644 --- a/src/lib/server/eliommod_gc.ml +++ b/src/lib/server/eliommod_gc.ml @@ -63,10 +63,10 @@ let gc_timeouted_services now tables = Eliom_common.Serv_Table.fold (*VVV not tail recursive: may be a problem if lots of coservices *) (fun ptk (`Ptc (nodeopt, l)) thr -> - thr >>= fun _thr -> (* we wait for the previous one + thr >>= fun thr -> (* 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 -> @@ -87,7 +87,7 @@ let gc_timeouted_services now tables = then match List.fold_right - (fun ({Eliom_common.s_expire; _} as a) + (fun ({Eliom_common.s_expire} as a) foll -> match s_expire with | Some (_, e) when !e < now -> foll @@ -194,7 +194,7 @@ let service_session_gc sitedata = (* private continuation tables: *) Eliom_common.SessionCookies.fold - (fun k (_sessname, + (fun k (sessname, tables, exp, _, @@ -214,7 +214,7 @@ let service_session_gc sitedata = tables.Eliom_common.table_naservices else return_unit) >>= fun () -> (match !session_group_ref with - | (_, _scope, Right _) (* no group *) + | (_, scope, Right _) (* no group *) (*VVV check this *) when (Eliommod_sessiongroups.Serv.group_size @@ -254,7 +254,7 @@ let data_session_gc sitedata = Lwt_log.ign_info ~section "GC of session data"; (* private continuation tables: *) Eliom_common.SessionCookies.fold - (fun k (_sessname, + (fun k (sessname, exp, _, session_group_ref, session_group_node) thr -> diff --git a/src/lib/server/eliommod_pagegen.ml b/src/lib/server/eliommod_pagegen.ml index a30ce07fbd..592246fbf6 100644 --- a/src/lib/server/eliommod_pagegen.ml +++ b/src/lib/server/eliommod_pagegen.ml @@ -50,7 +50,7 @@ let update_cookie_table ?now sitedata (ci, sci) = (* Update service expiration date and value *) Eliom_common.Full_state_name_table.iter - (fun name (_oldvalue, newr) -> + (fun name (oldvalue, newr) -> (* catch fun () -> *) match !newr with | Eliom_common.SCData_session_expired @@ -82,7 +82,7 @@ let update_cookie_table ?now sitedata (ci, sci) = Keeping same duration is important for example for comet (which is using both service and volatile data sessions). *) - let (_oldvalue, newr) = Lazy.force v in + let (oldvalue, newr) = Lazy.force v in match !newr with | Eliom_common.SCData_session_expired | Eliom_common.SCNo_data -> () (* The cookie has been removed *) @@ -144,7 +144,7 @@ let update_cookie_table ?now sitedata (ci, sci) = oldgrp = !(newc.Eliom_common.pc_session_group) && oldv = newc.Eliom_common.pc_value) -> return_unit (* nothing to do *) - | Some (oldv, _oldti, _oldexp, _oldgrp) when + | Some (oldv, oldti, oldexp, oldgrp) when oldv = newc.Eliom_common.pc_value -> catch (fun () -> @@ -195,13 +195,13 @@ let update_cookie_table ?now sitedata (ci, sci) = let execute now generate_page - ((_ri, - _si, + ((ri, + si, ((service_cookies_info, data_cookies_info, pers_cookies_info), secure_ci), ((service_tab_cookies_info, data_tab_cookies_info, pers_tab_cookies_info), secure_ci_tab), - _user_tab_cookies) as info) + user_tab_cookies) as info) sitedata = catch @@ -225,10 +225,10 @@ let set_expired_sessions ri closedservsessions = then () else Polytables.set - ~table:(Ocsigen_extensions.Ocsigen_request_info.request_cache + (Ocsigen_extensions.Ocsigen_request_info.request_cache ri.Ocsigen_extensions.request_info) - ~key:Eliom_common.eliom_service_session_expired - ~value:closedservsessions + Eliom_common.eliom_service_session_expired + closedservsessions open Ocsigen_extensions @@ -280,8 +280,8 @@ let gen is_eliom_extension sitedata = function set_expired_sessions ri (closedsessions, closedsessions_tab); let rec gen_aux ((ri, si, all_cookie_info, - _all_tab_cookie_info, - _user_tab_cookies) as info) = + all_tab_cookie_info, + user_tab_cookies) as info) = match is_eliom_extension with | Some ext -> Eliom_extension.run_eliom_extension ext now info sitedata @@ -417,5 +417,5 @@ let gen is_eliom_extension sitedata = function | e -> fail e) in gen_aux (ri, si, all_cookie_info, all_tab_cookie_info, user_tab_cookies) - | Ocsigen_extensions.Req_not_found (_, _ri) -> + | Ocsigen_extensions.Req_not_found (_, ri) -> Lwt.return Ocsigen_extensions.Ext_do_nothing diff --git a/src/lib/server/eliommod_persess.ml b/src/lib/server/eliommod_persess.ml index 6669df9808..3398b461e9 100644 --- a/src/lib/server/eliommod_persess.ml +++ b/src/lib/server/eliommod_persess.ml @@ -77,7 +77,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 @@ -167,7 +167,7 @@ let rec find_or_create_persistent_cookie_ 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 @@ -177,7 +177,7 @@ let rec find_or_create_persistent_cookie_ (fun () -> Lazy.force (Eliom_common.Full_state_name_table.find full_st_name !cookie_info) - >>= fun (_old, ior) -> + >>= fun (old, ior) -> match !ior with | Eliom_common.SCData_session_expired (* We do not trust the value sent by the client, @@ -232,7 +232,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_sessadmin.ml b/src/lib/server/eliommod_sessadmin.ml index 38f763ab08..248c500a1e 100644 --- a/src/lib/server/eliommod_sessadmin.ml +++ b/src/lib/server/eliommod_sessadmin.ml @@ -39,8 +39,8 @@ let iter_persistent_sessions f = let close_all_service_states2 full_st_name sitedata = Eliom_common.SessionCookies.fold - (fun _k (full_st_name2, _table, _expref, timeoutref, - _sessgrpref, sessgrpnode) thr -> + (fun k (full_st_name2, table, expref, timeoutref, + sessgrpref, sessgrpnode) thr -> thr >>= fun () -> if full_st_name = full_st_name2 && !timeoutref = Eliom_common.TGlobal then Eliommod_sessiongroups.Serv.remove sessgrpnode; @@ -67,7 +67,7 @@ let close_all_service_states ~scope ~secure sitedata = let close_all_data_states2 full_st_name sitedata = Eliom_common.SessionCookies.fold - (fun _k (full_st_name2, _expref, timeoutref, _sessgrpref, sessgrpnode) thr -> + (fun k (full_st_name2, expref, timeoutref, sessgrpref, sessgrpnode) thr -> thr >>= fun () -> if full_st_name = full_st_name2 && !timeoutref = Eliom_common.TGlobal then Eliommod_sessiongroups.Data.remove sessgrpnode; @@ -96,7 +96,7 @@ let close_all_data_states ~scope ~secure sitedata = let close_all_persistent_states2 full_st_name sitedata = Lazy.force Eliommod_persess.persistent_cookies_table >>= Ocsipersist.iter_table - (fun k ((scope, _, _) as full_st_name2, _old_exp, old_t, sessiongrp) -> + (fun k ((scope, _, _) as full_st_name2, old_exp, old_t, sessiongrp) -> if full_st_name = full_st_name2 && old_t = Eliom_common.TGlobal then Eliommod_persess.close_persistent_state2 ~scope sitedata sessiongrp k >>= @@ -133,8 +133,8 @@ let update_serv_exp full_st_name sitedata old_glob_timeout new_glob_timeout = | _ -> let now = Unix.time () in Eliom_common.SessionCookies.fold - (fun _k (full_st_name2, _table, expref, timeoutref, - _sessgrpref, sessgrpnode) thr -> + (fun k (full_st_name2, table, expref, timeoutref, + sessgrpref, sessgrpnode) thr -> thr >>= fun () -> (if full_st_name = full_st_name2 && !timeoutref = Eliom_common.TGlobal @@ -165,7 +165,7 @@ let update_data_exp full_st_name sitedata old_glob_timeout new_glob_timeout = | _ -> let now = Unix.time () in Eliom_common.SessionCookies.fold - (fun _k (full_st_name2, expref, timeoutref, _sessgrpref, sessgrpnode) thr -> + (fun k (full_st_name2, expref, timeoutref, sessgrpref, sessgrpnode) thr -> thr >>= fun () -> (if full_st_name = full_st_name2 && !timeoutref = Eliom_common.TGlobal then diff --git a/src/lib/server/eliommod_sessiongroups.ml b/src/lib/server/eliommod_sessiongroups.ml index fd7b8fa87a..562d2bf27a 100644 --- a/src/lib/server/eliommod_sessiongroups.ml +++ b/src/lib/server/eliommod_sessiongroups.ml @@ -367,7 +367,7 @@ Besides, volatile sessions are (hopefully) going to disappear soon. | (_, `Client_process, Left sess_id) -> (try - let (_, tables, _, _, _sgr, sgn) = + let (_, tables, _, _, sgr, sgn) = Eliom_common.SessionCookies.find sitedata.Eliom_common.session_services sess_id in @@ -553,7 +553,7 @@ module Pers = struct | e -> Lwt.fail e) - and remove _sitedata sess_id sess_grp = + and remove sitedata sess_id sess_grp = match sess_grp with | Some sg0 -> let sg = Eliom_common.string_of_perssessgrp sg0 in diff --git a/src/lib/server/eliommod_timeouts.ml b/src/lib/server/eliommod_timeouts.ml index b4d85b44ae..c2a46284ac 100644 --- a/src/lib/server/eliommod_timeouts.ml +++ b/src/lib/server/eliommod_timeouts.ml @@ -27,7 +27,7 @@ open Eliom_lib open Lwt -let fst3 (a,_b,_c) = a +let fst3 (a,b,c) = a type kind = [ `Service | `Data | `Persistent ] From 0df6a8177643b16c4aec47bb41b55a3bc050dfb7 Mon Sep 17 00:00:00 2001 From: John Christopher McAlpine Date: Tue, 16 Apr 2019 14:51:49 +0200 Subject: [PATCH 09/10] purge unnecessary dune libs and unnecessary warning corrections --- src/tools/eliomc.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/tools/eliomc.ml b/src/tools/eliomc.ml index b4c067e6fe..23b5c9a36f 100644 --- a/src/tools/eliomc.ml +++ b/src/tools/eliomc.ml @@ -330,7 +330,7 @@ let process_eliom ~impl_intf file = | _ -> compile_eliom ~impl_intf file -let build_server ?name:_ () = +let build_server ?(name = "a.out") () = fail "Linking eliom server is not yet supported" (* TODO ? Build a staticaly linked ocsigenserver. *) From b71973947d0130de2f0d66699b730d669f6e4cf7 Mon Sep 17 00:00:00 2001 From: John Christopher McAlpine Date: Tue, 16 Apr 2019 15:00:49 +0200 Subject: [PATCH 10/10] purge pkg folder --- pkg/META | 138 ---- pkg/build.ml | 120 ---- pkg/distillery/basic.camlp4/.ocp-indent | 4 - pkg/distillery/basic.camlp4/Makefile | 240 ------- pkg/distillery/basic.camlp4/Makefile.options | 64 -- .../basic.camlp4/PROJECT_NAME.conf.in | 28 - .../basic.camlp4/PROJECT_NAME.eliom | 30 - pkg/distillery/basic.camlp4/README | 82 --- .../basic.camlp4/static!css!PROJECT_NAME.css | 3 - pkg/distillery/basic.ppx/.ocp-indent | 5 - pkg/distillery/basic.ppx/Makefile | 240 ------- pkg/distillery/basic.ppx/Makefile.options | 64 -- pkg/distillery/basic.ppx/PROJECT_NAME.conf.in | 28 - pkg/distillery/basic.ppx/PROJECT_NAME.eliom | 30 - pkg/distillery/basic.ppx/README | 82 --- .../basic.ppx/static!css!PROJECT_NAME.css | 3 - pkg/etc/mime.types | 592 ------------------ pkg/filelist.ml | 212 ------- pkg/man/eliom-distillery.1 | 51 -- pkg/man/eliomc.1 | 212 ------- pkg/topkg.ml | 358 ----------- 21 files changed, 2586 deletions(-) delete mode 100644 pkg/META delete mode 100755 pkg/build.ml delete mode 100644 pkg/distillery/basic.camlp4/.ocp-indent delete mode 100644 pkg/distillery/basic.camlp4/Makefile delete mode 100644 pkg/distillery/basic.camlp4/Makefile.options delete mode 100644 pkg/distillery/basic.camlp4/PROJECT_NAME.conf.in delete mode 100644 pkg/distillery/basic.camlp4/PROJECT_NAME.eliom delete mode 100644 pkg/distillery/basic.camlp4/README delete mode 100644 pkg/distillery/basic.camlp4/static!css!PROJECT_NAME.css delete mode 100644 pkg/distillery/basic.ppx/.ocp-indent delete mode 100644 pkg/distillery/basic.ppx/Makefile delete mode 100644 pkg/distillery/basic.ppx/Makefile.options delete mode 100644 pkg/distillery/basic.ppx/PROJECT_NAME.conf.in delete mode 100644 pkg/distillery/basic.ppx/PROJECT_NAME.eliom delete mode 100644 pkg/distillery/basic.ppx/README delete mode 100644 pkg/distillery/basic.ppx/static!css!PROJECT_NAME.css delete mode 100644 pkg/etc/mime.types delete mode 100644 pkg/filelist.ml delete mode 100644 pkg/man/eliom-distillery.1 delete mode 100644 pkg/man/eliomc.1 delete mode 100644 pkg/topkg.ml diff --git a/pkg/META b/pkg/META deleted file mode 100644 index ad1fa76e71..0000000000 --- a/pkg/META +++ /dev/null @@ -1,138 +0,0 @@ -description = "Eliom: client-server Web and mobile applications" -version = "6.3.0" - -package "server" ( - description = "Eliom: server-side" - version = "[distributed with Eliom]" - directory = "server" - - requires = "ocsigenserver, - ocsigenserver.ext, - ppx_deriving.runtime, - js_of_ocaml.deriving, - react, - reactiveData, - tyxml, - lwt_react, - cryptokit, - reactiveData" - archive(byte) = "server.cma" - archive(native) = "server.cmxa" - - package "monitor" ( - directory = "monitor" - description = "Eliom: monitoring" - version = "[distributed with Eliom]" - archive(byte) = "eliom_monitor.cma" - archive(native) = "eliom_monitor.cmxa" - package "start" ( - description = "Eliom: monitoring" - version = "[distributed with Eliom]" - require = "eliom.server.monitor" - archive(byte) = "eliom_monitor_main.cma" - archive(native) = "eliom_monitor_main.cmxa" - ) - ) -) - -package "client" ( - description = "Eliom: client-side" - version = "[distributed with Eliom]" - directory = "client" - - requires = "ocsigenserver.cookies, - ocsigenserver.polytables, - ocsigenserver.baselib.base, - ppx_deriving.runtime, - js_of_ocaml, - js_of_ocaml.deriving, - js_of_ocaml-tyxml, - js_of_ocaml-lwt, - js_of_ocaml-lwt.logger, - js_of_ocaml.weak, - lwt_react, - react, - reactiveData, - tyxml.functor" - archive(byte) = "client.cma eliom_client_main.cmo" - - linkopts(javascript) = "+eliom.client/eliom_client.js" -) - -package "syntax" ( - directory = "syntax" - package "common" ( - description = "Syntax extension: spliting client and server code (base)" - version = "[distributed with Eliom]" - requires = "camlp4, bytes" - requires(preprocessor, syntax, pkg_type_conv) = "type_conv" - archive(syntax, preprocessor) = "pa_eliom_seed.cmo" - ) - - package "client" ( - description = "Syntax extension: spliting client and server code (client side)" - version = "[distributed with Eliom]" - requires(syntax, preprocessor) = "eliom.syntax.common" - requires(syntax, toploop) = "eliom.syntax.common" - archive(syntax, preprocessor) = "pa_eliom_client_client.cmo" - archive(syntax, toploop) = "pa_eliom_client_client.cmo" - ) - - package "server" ( - description = "Syntax extension: spliting client and server code (server side)" - version = "[distributed with Eliom]" - requires(syntax, preprocessor) = "eliom.syntax.common" - requires(syntax, toploop) = "eliom.syntax.common" - archive(syntax, preprocessor) = "pa_eliom_client_server.cmo" - archive(syntax, toploop) = "pa_eliom_client_server.cmo" - ) - - package "type" ( - description = "Syntax extension: spliting client and server code (type inference)" - version = "[distributed with Eliom]" - requires(syntax, preprocessor) = "eliom.syntax.common" - archive(syntax, preprocessor) = "pa_eliom_type_filter.cmo" - ) - - package "predef" ( - description = "Syntax extension: predefined commonly use syntaxes" - version = "[distributed with Eliom]" - - requires(syntax, preprocessor) = "js_of_ocaml-camlp4,js_of_ocaml-camlp4.deriving,lwt_camlp4" - requires(syntax, toploop) = "js_of_ocaml-camlp4,js_of_ocaml-camlp4.deriving,lwt_camlp4" - archive(syntax, preprocessor) = "-ignore dummy" - ) - -) - -package "ppx" ( - directory = "ppx" - package "server" ( - description = "Ppx syntax extension: server side" - ppx = "ppx_eliom_server_standalone.exe" - ) - package "client" ( - description = "Ppx syntax extension: client side" - ppx = "ppx_eliom_client_standalone.exe" - ) - package "type" ( - description = "Ppx syntax extension: type inference" - ppx = "ppx_eliom_types_standalone.exe" - ) -) - - -package "templates" ( - directory = "templates" -) - -package "ocamlbuild" ( - description = "Eliom ocamlbuild plugin (js_of_ocaml part included)" - version = "[distributed with Eliom]" - directory = "ocamlbuild" - requires = "js_of_ocaml.ocamlbuild" - archive(byte) = "ocamlbuild_eliom.cma" - archive(byte, plugin) = "ocamlbuild_eliom.cma" - archive(native) = "ocamlbuild_eliom.cmxa" - archive(native, plugin) = "ocamlbuild_eliom.cmxs" -) diff --git a/pkg/build.ml b/pkg/build.ml deleted file mode 100755 index ba03dec607..0000000000 --- a/pkg/build.ml +++ /dev/null @@ -1,120 +0,0 @@ -#!/usr/bin/env ocaml -#directory "pkg";; -#use "topkg.ml";; -#use "filelist.ml" - -(* DEBUG ONLY *) -let nothing_should_be_rebuilt=false -let except = function - (* cmxs are regerated every time ( bug in ocamlbuild rule) *) - | ".cmxs" when nothing_should_be_rebuilt -> false - | _ -> true -(* END *) - -let exts_syntax = List.filter except [".cmo";".cmx";".cma";".cmxa";".cmxs";".a"] -let exts_modlib = List.filter except Exts.module_library -let exts_lib = List.filter except Exts.library - -let _ = - list_to_file "src/lib/client/client.mllib" client_mllib; - list_to_file "src/lib/client/api.odocl" client_api; - - list_to_file "src/lib/server/server.mllib" server_mllib; - list_to_file "src/lib/server/server.mldylib" server_mllib; - list_to_file "src/lib/server/api.odocl" server_api; - - list_to_file "src/ocamlbuild/ocamlbuild.mllib" ocamlbuild_mllib; - list_to_file "src/ocamlbuild/ocamlbuild.mldylib" ocamlbuild_mllib; - list_to_file "src/ocamlbuild/api.odocl" ocamlbuild_api; - - list_to_file "src/ppx/ppx.mllib" ppx_mllib; - list_to_file "src/ppx/ppx.mldylib" ppx_mllib; - list_to_file "src/ppx/api.odocl" ppx_api; - - list_to_file "src/ppx/ppx.mllib" ppx_mllib; - list_to_file "src/ppx/ppx.mldylib" ppx_mllib; - list_to_file "src/ppx/api.odocl" ppx_api - -let spf = Printf.sprintf - -let nothing = - if nothing_should_be_rebuilt - then "-nothing-should-be-rebuilt" - else "" - -let builder = `Other ("_build/build/build.native","_build") - -let with_man3 = Env.bool "manpage" - -let () = - Pkg.describe "eliom" ~builder ([ - (* META *) - Pkg.lib "pkg/META"; - - (* MANPAGE *) - Pkg.man ~dst:"man1/eliomc.1" "pkg/man/eliomc.1"; - Pkg.man ~dst:"man1/eliomcp.1" "pkg/man/eliomc.1"; - Pkg.man ~dst:"man1/eliomopt.1" "pkg/man/eliomc.1"; - Pkg.man ~dst:"man1/eliomdep.1" "pkg/man/eliomc.1"; - Pkg.man ~dst:"man1/js_of_eliom.1" "pkg/man/eliomc.1"; - Pkg.man ~dst:"man1/eliom-distillery.1" "pkg/man/eliom-distillery.1"; - - Pkg.man ~cond:with_man3 ~dst:"man3/%.3oc" ~target:"src/lib/client/api.mandocdir/man.3oc" "src/lib/client/api.mandocdir/%.3oc"; - Pkg.man ~cond:with_man3 ~dst:"man3/%.3os" ~target:"src/lib/server/api.mandocdir/man.3os" "src/lib/server/api.mandocdir/%.3os"; - Pkg.man ~cond:with_man3 ~dst:"man3/%.3o" ~target:"src/ocamlbuild/api.mandocdir/man.3o" "src/ocamlbuild/api.mandocdir/%.3o"; - Pkg.man ~cond:with_man3 ~dst:"man3/%.3o" ~target:"src/ppx/api.mandocdir/man.3o" "src/ppx/api.mandocdir/%.3o"; - - (* TOOLS *) - Pkg.bin ~auto:true "src/tools/eliomc"; - Pkg.bin ~auto:true "src/tools/eliomcp"; - Pkg.bin ~auto:true "src/tools/eliomdep"; - Pkg.bin ~auto:true "src/tools/eliomopt"; - Pkg.bin ~auto:true "src/tools/js_of_eliom"; - Pkg.bin ~auto:true "src/tools/eliomdoc"; - Pkg.bin ~auto:true "src/tools/eliompp"; - Pkg.bin ~auto:true ~dst:"eliom-distillery" "src/tools/distillery"; - Pkg.bin ~auto:true "src/ocamlbuild/eliombuild"; - - (* SYNTAXES *) - Pkg.lib ~exts:exts_syntax ~dst:"syntax/pa_eliom_seed" "src/syntax/pa_eliom_seed"; - Pkg.lib ~exts:exts_syntax ~dst:"syntax/pa_eliom_client_client" "src/syntax/pa_eliom_client_client"; - Pkg.lib ~exts:exts_syntax ~dst:"syntax/pa_eliom_client_server" "src/syntax/pa_eliom_client_server"; - Pkg.lib ~exts:exts_syntax ~dst:"syntax/pa_eliom_type_filter" "src/syntax/pa_eliom_type_filter"; - - Pkg.lib ~exts:exts_modlib ~dst:"ocamlbuild/ocamlbuild_eliom" "src/ocamlbuild/ocamlbuild_eliom"; - - (* PPX *) - Pkg.lib ~exts:Exts.module_library ~dst:"ppx/ppx_eliom" "src/ppx/ppx_eliom"; - Pkg.lib ~exts:Exts.module_library ~dst:"ppx/ppx_eliom_client" "src/ppx/ppx_eliom_client"; - Pkg.lib ~exts:Exts.module_library ~dst:"ppx/ppx_eliom_type" "src/ppx/ppx_eliom_type"; - Pkg.lib ~exts:Exts.module_library ~dst:"ppx/ppx_eliom_server" "src/ppx/ppx_eliom_server"; - - Pkg.bin ~auto:true ~dst:"ppx_eliom_client" "src/ppx/ppx_eliom_client_ex" ; - Pkg.bin ~auto:true ~dst:"ppx_eliom_server" "src/ppx/ppx_eliom_server_ex" ; - Pkg.bin ~auto:true ~dst:"ppx_eliom_types" "src/ppx/ppx_eliom_types_ex" - - ] @ ( - (* CLIENT LIBS *) - Pkg.lib ~dst:"client/client" ~exts:[".cma"] "src/lib/client/client" :: - Pkg.lib ~dst:"client/eliom_client_main.cmo" "src/lib/client/eliom_client_main.cmo" :: - Pkg.lib ~dst:"client/eliom_client.js" "src/lib/client/eliom_client.js" :: - List.map (fun x -> Pkg.lib ~dst:(spf "client/%s" x) (spf "src/lib/client/%s" x)) client_extra - ) @ ( - (* SERVER LIBS *) - Pkg.lib ~dst:"server/monitor/eliom_monitor" ~exts:Exts.module_library "src/lib/server/monitor/eliom_monitor" :: - Pkg.lib ~dst:"server/monitor/eliom_monitor_main" ~exts:Exts.module_library "src/lib/server/monitor/eliom_monitor_main" :: - Pkg.lib ~dst:"server/server" ~exts:exts_lib "src/lib/server/server" :: - List.map (fun x -> Pkg.lib ~dst:(spf "server/%s" x) (spf "src/lib/server/%s" x)) server_extra - ) @ [ - (* MISC *) - - Pkg.doc "README.md"; - Pkg.doc "CHANGES"; - Pkg.etc "pkg/etc/mime.types" - ] @ ( - List.flatten ( - List.map (fun (name,files) -> - List.map (fun file -> - Pkg.lib ~dst:(spf "templates/%s/%s" name file) (spf "%s/%s/%s" templates_dir name file) - ) files) templates_files ) - )) diff --git a/pkg/distillery/basic.camlp4/.ocp-indent b/pkg/distillery/basic.camlp4/.ocp-indent deleted file mode 100644 index e98972dec4..0000000000 --- a/pkg/distillery/basic.camlp4/.ocp-indent +++ /dev/null @@ -1,4 +0,0 @@ -normal -with=0 -syntax=lwt mll -max_indent=2 diff --git a/pkg/distillery/basic.camlp4/Makefile b/pkg/distillery/basic.camlp4/Makefile deleted file mode 100644 index adfeb11620..0000000000 --- a/pkg/distillery/basic.camlp4/Makefile +++ /dev/null @@ -1,240 +0,0 @@ - -##---------------------------------------------------------------------- -## DISCLAIMER -## -## This file contains the rules to make an Eliom project. The project is -## configured through the variables in the file Makefile.options. -##---------------------------------------------------------------------- - -include Makefile.options - -##---------------------------------------------------------------------- -## Internals - -## Required binaries -ELIOMC := eliomc -ELIOMOPT := eliomopt -JS_OF_ELIOM := js_of_eliom -ELIOMDEP := eliomdep -OCSIGENSERVER := ocsigenserver -OCSIGENSERVER.OPT := ocsigenserver.opt - -## Where to put intermediate object files. -## - ELIOM_{SERVER,CLIENT}_DIR must be distinct -## - ELIOM_CLIENT_DIR must not be the local dir. -## - ELIOM_SERVER_DIR could be ".", but you need to -## remove it from the "clean" rules... -export ELIOM_SERVER_DIR := _server -export ELIOM_CLIENT_DIR := _client -export ELIOM_TYPE_DIR := _server -DEPSDIR := _deps - -ifeq ($(DEBUG),yes) - GENERATE_DEBUG ?= -g - RUN_DEBUG ?= "-v" - DEBUG_JS ?= -jsopt -pretty -jsopt -noinline -jsopt -debuginfo -endif - -##---------------------------------------------------------------------- -## General - -.PHONY: all byte opt -all: byte opt -byte opt:: $(TEST_PREFIX)$(ELIOMSTATICDIR)/${PROJECT_NAME}.js -byte opt:: $(TEST_PREFIX)$(ETCDIR)/$(PROJECT_NAME).conf -byte opt:: $(TEST_PREFIX)$(ETCDIR)/$(PROJECT_NAME)-test.conf -byte:: $(TEST_PREFIX)$(LIBDIR)/${PROJECT_NAME}.cma -opt:: $(TEST_PREFIX)$(LIBDIR)/${PROJECT_NAME}.cmxs - -DIST_DIRS = $(ETCDIR) $(DATADIR) $(LIBDIR) $(LOGDIR) $(STATICDIR) $(ELIOMSTATICDIR) $(shell dirname $(CMDPIPE)) - -##---------------------------------------------------------------------- -## Testing - -DIST_FILES = $(ELIOMSTATICDIR)/$(PROJECT_NAME).js $(LIBDIR)/$(PROJECT_NAME).cma - -.PHONY: test.byte test.opt -test.byte: $(addprefix $(TEST_PREFIX),$(ETCDIR)/$(PROJECT_NAME)-test.conf $(DIST_DIRS) $(DIST_FILES)) - $(OCSIGENSERVER) $(RUN_DEBUG) -c $< -test.opt: $(addprefix $(TEST_PREFIX),$(ETCDIR)/$(PROJECT_NAME)-test.conf $(DIST_DIRS) $(patsubst %.cma,%.cmxs, $(DIST_FILES))) - $(OCSIGENSERVER.OPT) $(RUN_DEBUG) -c $< - -$(addprefix $(TEST_PREFIX), $(DIST_DIRS)): - mkdir -p $@ - -##---------------------------------------------------------------------- -## Installing & Running - -.PHONY: install install.byte install.byte install.opt install.static install.etc install.lib install.lib.byte install.lib.opt run.byte run.opt -install: install.byte install.opt -install.byte: install.lib.byte install.etc install.static | $(addprefix $(PREFIX),$(DATADIR) $(LOGDIR) $(shell dirname $(CMDPIPE))) -install.opt: install.lib.opt install.etc install.static | $(addprefix $(PREFIX),$(DATADIR) $(LOGDIR) $(shell dirname $(CMDPIPE))) -install.lib: install.lib.byte install.lib.opt -install.lib.byte: $(TEST_PREFIX)$(LIBDIR)/$(PROJECT_NAME).cma | $(PREFIX)$(LIBDIR) - install $< $(PREFIX)$(LIBDIR) -install.lib.opt: $(TEST_PREFIX)$(LIBDIR)/$(PROJECT_NAME).cmxs | $(PREFIX)$(LIBDIR) - install $< $(PREFIX)$(LIBDIR) -install.static: $(TEST_PREFIX)$(ELIOMSTATICDIR)/$(PROJECT_NAME).js | $(PREFIX)$(STATICDIR) $(PREFIX)$(ELIOMSTATICDIR) - cp -r $(LOCAL_STATIC)/* $(PREFIX)$(STATICDIR) - [ -z $(WWWUSER) ] || chown -R $(WWWUSER) $(PREFIX)$(STATICDIR) - install $(addprefix -o ,$(WWWUSER)) $< $(PREFIX)$(ELIOMSTATICDIR) -install.etc: $(TEST_PREFIX)$(ETCDIR)/$(PROJECT_NAME).conf | $(PREFIX)$(ETCDIR) - install $< $(PREFIX)$(ETCDIR)/$(PROJECT_NAME).conf - -.PHONY: -print-install-files: - @echo $(PREFIX)$(LIBDIR) - @echo $(PREFIX)$(STATICDIR) - @echo $(PREFIX)$(ELIOMSTATICDIR) - @echo $(PREFIX)$(ETCDIR) - -$(addprefix $(PREFIX),$(ETCDIR) $(LIBDIR)): - install -d $@ -$(addprefix $(PREFIX),$(DATADIR) $(LOGDIR) $(STATICDIR) $(ELIOMSTATICDIR) $(shell dirname $(CMDPIPE))): - install $(addprefix -o ,$(WWWUSER)) -d $@ - -run.byte: - $(OCSIGENSERVER) $(RUN_DEBUG) -c ${PREFIX}${ETCDIR}/${PROJECT_NAME}.conf -run.opt: - $(OCSIGENSERVER.OPT) $(RUN_DEBUG) -c ${PREFIX}${ETCDIR}/${PROJECT_NAME}.conf - -##---------------------------------------------------------------------- -## Aux - -# Use `eliomdep -sort' only in OCaml>4 -ifeq ($(shell ocamlc -version|cut -c1),4) -eliomdep=$(shell $(ELIOMDEP) $(1) -sort $(2) $(filter %.eliom %.ml,$(3)))) -else -eliomdep=$(3) -endif -objs=$(patsubst %.ml,$(1)/%.$(2),$(patsubst %.eliom,$(1)/%.$(2),$(filter %.eliom %.ml,$(3)))) -depsort=$(call objs,$(1),$(2),$(call eliomdep,$(3),$(4),$(5))) - -##---------------------------------------------------------------------- -## Config files - -FINDLIB_PACKAGES=$(patsubst %,\,$(SERVER_PACKAGES)) -EDIT_WARNING=DON\'T EDIT THIS FILE! It is generated from $(PROJECT_NAME).conf.in, edit that one, or the variables in Makefile.options -SED_ARGS := -e "/^ *%%%/d" -SED_ARGS += -e "s|%%PROJECT_NAME%%|$(PROJECT_NAME)|g" -SED_ARGS += -e "s|%%DATABASE_NAME%%|$(DATABASE_NAME)|g" -SED_ARGS += -e "s|%%DATABASE_USER%%|$(DATABASE_USER)|g" -SED_ARGS += -e "s|%%CMDPIPE%%|%%PREFIX%%$(CMDPIPE)|g" -SED_ARGS += -e "s|%%LOGDIR%%|%%PREFIX%%$(LOGDIR)|g" -SED_ARGS += -e "s|%%DATADIR%%|%%PREFIX%%$(DATADIR)|g" -SED_ARGS += -e "s|%%PERSISTENT_DATA_BACKEND%%|$(PERSISTENT_DATA_BACKEND)|g" -SED_ARGS += -e "s|%%LIBDIR%%|%%PREFIX%%$(LIBDIR)|g" -SED_ARGS += -e "s|%%WARNING%%|$(EDIT_WARNING)|g" -SED_ARGS += -e "s|%%PACKAGES%%|$(FINDLIB_PACKAGES)|g" -SED_ARGS += -e "s|%%ELIOMSTATICDIR%%|%%PREFIX%%$(ELIOMSTATICDIR)|g" -ifeq ($(DEBUG),yes) - SED_ARGS += -e "s|%%DEBUGMODE%%|\|g" -else - SED_ARGS += -e "s|%%DEBUGMODE%%||g" -endif - -LOCAL_SED_ARGS := -e "s|%%PORT%%|$(TEST_PORT)|g" -LOCAL_SED_ARGS += -e "s|%%STATICDIR%%|$(LOCAL_STATIC)|g" -LOCAL_SED_ARGS += -e "s|%%USERGROUP%%||g" -GLOBAL_SED_ARGS := -e "s|%%PORT%%|$(PORT)|g" -GLOBAL_SED_ARGS += -e "s|%%STATICDIR%%|%%PREFIX%%$(STATICDIR)|g" -ifeq ($(WWWUSER)$(WWWGROUP),) - GLOBAL_SED_ARGS += -e "s|%%USERGROUP%%||g" -else - GLOBAL_SED_ARGS += -e "s|%%USERGROUP%%|$(WWWUSER)$(WWWGROUP)|g" -endif - -$(TEST_PREFIX)${ETCDIR}/${PROJECT_NAME}.conf: ${PROJECT_NAME}.conf.in Makefile.options | $(TEST_PREFIX)$(ETCDIR) - sed $(SED_ARGS) $(GLOBAL_SED_ARGS) $< | sed -e "s|%%PREFIX%%|$(PREFIX)|g" > $@ -$(TEST_PREFIX)${ETCDIR}/${PROJECT_NAME}-test.conf: ${PROJECT_NAME}.conf.in Makefile.options | $(TEST_PREFIX)$(ETCDIR) - sed $(SED_ARGS) $(LOCAL_SED_ARGS) $< | sed -e "s|%%PREFIX%%|$(TEST_PREFIX)|g" > $@ - -##---------------------------------------------------------------------- -## Server side compilation - -SERVER_INC := ${addprefix -package ,${SERVER_PACKAGES}} - -${ELIOM_TYPE_DIR}/%.type_mli: %.eliom - ${ELIOMC} -infer ${SERVER_INC} $< - -$(TEST_PREFIX)$(LIBDIR)/$(PROJECT_NAME).cma: $(call objs,$(ELIOM_SERVER_DIR),cmo,$(SERVER_FILES)) | $(TEST_PREFIX)$(LIBDIR) - ${ELIOMC} -a -o $@ $(GENERATE_DEBUG) \ - $(call depsort,$(ELIOM_SERVER_DIR),cmo,-server,$(SERVER_INC),$(SERVER_FILES)) - -$(TEST_PREFIX)$(LIBDIR)/$(PROJECT_NAME).cmxa: $(call objs,$(ELIOM_SERVER_DIR),cmx,$(SERVER_FILES)) | $(TEST_PREFIX)$(LIBDIR) - ${ELIOMOPT} -a -o $@ $(GENERATE_DEBUG) \ - $(call depsort,$(ELIOM_SERVER_DIR),cmx,-server,$(SERVER_INC),$(SERVER_FILES)) - -%.cmxs: %.cmxa - $(ELIOMOPT) -shared -linkall -o $@ $(GENERATE_DEBUG) $< - -${ELIOM_SERVER_DIR}/%.cmi: %.mli - ${ELIOMC} -c ${SERVER_INC} $(GENERATE_DEBUG) $< - -${ELIOM_SERVER_DIR}/%.cmi: %.eliomi - ${ELIOMC} -c ${SERVER_INC} $(GENERATE_DEBUG) $< - -${ELIOM_SERVER_DIR}/%.cmo: %.ml - ${ELIOMC} -c ${SERVER_INC} $(GENERATE_DEBUG) $< -${ELIOM_SERVER_DIR}/%.cmo: %.eliom - ${ELIOMC} -c ${SERVER_INC} $(GENERATE_DEBUG) $< - -${ELIOM_SERVER_DIR}/%.cmx: %.ml - ${ELIOMOPT} -c ${SERVER_INC} $(GENERATE_DEBUG) $< -${ELIOM_SERVER_DIR}/%.cmx: %.eliom - ${ELIOMOPT} -c ${SERVER_INC} $(GENERATE_DEBUG) $< - - -##---------------------------------------------------------------------- -## Client side compilation - -CLIENT_LIBS := ${addprefix -package ,${CLIENT_PACKAGES}} -CLIENT_INC := ${addprefix -package ,${CLIENT_PACKAGES}} - -CLIENT_OBJS := $(filter %.eliom %.ml, $(CLIENT_FILES)) -CLIENT_OBJS := $(patsubst %.eliom,${ELIOM_CLIENT_DIR}/%.cmo, ${CLIENT_OBJS}) -CLIENT_OBJS := $(patsubst %.ml,${ELIOM_CLIENT_DIR}/%.cmo, ${CLIENT_OBJS}) - -$(TEST_PREFIX)$(ELIOMSTATICDIR)/$(PROJECT_NAME).js: $(call objs,$(ELIOM_CLIENT_DIR),cmo,$(CLIENT_FILES)) | $(TEST_PREFIX)$(ELIOMSTATICDIR) - ${JS_OF_ELIOM} -o $@ $(GENERATE_DEBUG) $(CLIENT_INC) $(DEBUG_JS) \ - $(call depsort,$(ELIOM_CLIENT_DIR),cmo,-client,$(CLIENT_INC),$(CLIENT_FILES)) - -${ELIOM_CLIENT_DIR}/%.cmi: %.mli - ${JS_OF_ELIOM} -c ${CLIENT_INC} $(GENERATE_DEBUG) $< - -${ELIOM_CLIENT_DIR}/%.cmo: %.eliom - ${JS_OF_ELIOM} -c ${CLIENT_INC} $(GENERATE_DEBUG) $< -${ELIOM_CLIENT_DIR}/%.cmo: %.ml - ${JS_OF_ELIOM} -c ${CLIENT_INC} $(GENERATE_DEBUG) $< - -${ELIOM_CLIENT_DIR}/%.cmi: %.eliomi - ${JS_OF_ELIOM} -c ${CLIENT_INC} $(GENERATE_DEBUG) $< - -##---------------------------------------------------------------------- -## Dependencies - -include .depend - -.depend: $(patsubst %,$(DEPSDIR)/%.server,$(SERVER_FILES)) $(patsubst %,$(DEPSDIR)/%.client,$(CLIENT_FILES)) - cat $^ > $@ - -$(DEPSDIR)/%.server: % | $(DEPSDIR) - $(ELIOMDEP) -server $(SERVER_INC) $< > $@ - -$(DEPSDIR)/%.client: % | $(DEPSDIR) - $(ELIOMDEP) -client $(CLIENT_INC) $< > $@ - -$(DEPSDIR): - mkdir $@ - -##---------------------------------------------------------------------- -## Clean up - -clean: - -rm -f *.cm[ioax] *.cmxa *.cmxs *.o *.a *.annot - -rm -f *.type_mli - -rm -f ${PROJECT_NAME}.js - -rm -rf ${ELIOM_CLIENT_DIR} ${ELIOM_SERVER_DIR} - -distclean: clean - -rm -rf $(TEST_PREFIX) $(DEPSDIR) .depend diff --git a/pkg/distillery/basic.camlp4/Makefile.options b/pkg/distillery/basic.camlp4/Makefile.options deleted file mode 100644 index 3a451650b1..0000000000 --- a/pkg/distillery/basic.camlp4/Makefile.options +++ /dev/null @@ -1,64 +0,0 @@ - -#---------------------------------------------------------------------- -# SETTINGS FOR THE ELIOM PROJECT %%%PROJECT_NAME%%% -#---------------------------------------------------------------------- - -PROJECT_NAME := %%%PROJECT_NAME%%% - -# Source files for the server -SERVER_FILES := $(wildcard *.eliomi *.eliom) -# Source files for the client -CLIENT_FILES := $(wildcard *.eliomi *.eliom) - -# OCamlfind packages for the server -SERVER_PACKAGES := -# OCamlfind packages for the client -CLIENT_PACKAGES := - -# Directory with files to be statically served -LOCAL_STATIC = static - -# The backend for persistent data. Can be dbm or sqlite. -# Make sure you have the following packages installed: -# - *dbm* if you use dbm --> opam install dbm. -# - *sqlite3* if you use sqlite --> opam install sqlite3. -PERSISTENT_DATA_BACKEND = %%%PROJECT_DB%%% - -# Debug application (yes/no): Debugging info in compilation, -# JavaScript, ocsigenserver -DEBUG := no - -# User to run server with (make run.*) -WWWUSER := www-data -WWWGROUP := www-data - -# Port for running the server (make run.*) -PORT := 80 - -# Port for testing (make test.*) -TEST_PORT := 8080 - -# Root of installation (must end with /) -PREFIX := /usr/local/ - -# Local folder for make test.* (must end with /) -# Do not add files manually in this directory. -# It is just here to test your installation before installing in / -TEST_PREFIX := local/ - -# The installation tree (relative to $(PREFIX) when -# installing/running or $(TEST_PREFIX) when testing). -# Configuration file $(PROJECT_NAME).conf -ETCDIR := etc/${PROJECT_NAME} -# Project's library $(PROJECT_NAME).cma (cmxs) -LIBDIR := lib/${PROJECT_NAME} -# Command pipe, eg. $ echo reload > $(INSTALL_PREFIX)$(CMDPIPE) -CMDPIPE := var/run/${PROJECT_NAME}-cmd -# Ocsigenserver's logging files -LOGDIR := var/log/${PROJECT_NAME} -# Ocsigenserver's persistent data files -DATADIR := var/data/${PROJECT_NAME} -# Copy of $(LOCAL_STATIC) -STATICDIR := var/www/${PROJECT_NAME}/static -# Project's JavaScript file -ELIOMSTATICDIR := var/www/${PROJECT_NAME}/eliom diff --git a/pkg/distillery/basic.camlp4/PROJECT_NAME.conf.in b/pkg/distillery/basic.camlp4/PROJECT_NAME.conf.in deleted file mode 100644 index 13a8a1fdbb..0000000000 --- a/pkg/distillery/basic.camlp4/PROJECT_NAME.conf.in +++ /dev/null @@ -1,28 +0,0 @@ -%%% This is the template for your configuration file. The %%VALUES%% below are -%%% taken from the Makefile to generate the actual configuration files. -%%% This comment will disappear. - - - - %%PORT%% - %%% Only set for running, not for testing - %%USERGROUP%% - %%LOGDIR%% - %%DATADIR%% - utf-8 - %%% Only set when debugging - %%DEBUGMODE%% - %%CMDPIPE%% - - - - %%% This will include the packages defined as SERVER_PACKAGES in your Makefile: - %%PACKAGES%% - - - - - - - - diff --git a/pkg/distillery/basic.camlp4/PROJECT_NAME.eliom b/pkg/distillery/basic.camlp4/PROJECT_NAME.eliom deleted file mode 100644 index 0f7eec755e..0000000000 --- a/pkg/distillery/basic.camlp4/PROJECT_NAME.eliom +++ /dev/null @@ -1,30 +0,0 @@ -{shared{ - open Eliom_lib - open Eliom_content - open Html.D -}} - -module %%%MODULE_NAME%%%_app = - Eliom_registration.App ( - struct - let application_name = "%%%PROJECT_NAME%%%" - let global_data_path = None - end) - -let main_service = - Eliom_service.create - ~path:(Eliom_service.Path []) - ~meth:(Eliom_service.Get Eliom_parameter.unit) - () - -let () = - %%%MODULE_NAME%%%_app.register - ~service:main_service - (fun () () -> - Lwt.return - (Eliom_tools.F.html - ~title:"%%%PROJECT_NAME%%%" - ~css:[["css";"%%%PROJECT_NAME%%%.css"]] - Html.F.(body [ - h1 [pcdata "Welcome from Eliom's distillery!"]; - ]))) diff --git a/pkg/distillery/basic.camlp4/README b/pkg/distillery/basic.camlp4/README deleted file mode 100644 index 6c48aa8af2..0000000000 --- a/pkg/distillery/basic.camlp4/README +++ /dev/null @@ -1,82 +0,0 @@ - -Instructions -============ - -This project is (initially) generated by eliom-distillery as the basic -project "%%%PROJECT_NAME%%%". - -Generally, you can compile it and run ocsigenserver on it by - $ make test.byte (or test.opt) -See below for other useful targets for make. - -Generated files ---------------- - -The following files in this directory have been generated by -eliom-distillery: - - - %%%PROJECT_NAME%%%.eliom - This is your initial source file. -%%%ifdef OCAML4%%% - All Eliom files (*.eliom, *.eliomi) in this directory are - automatically considered. To add a .ml/.mli file to your project, - append it to the variable SERVER_FILES or CLIENT_FILES. -%%%endif%%% -%%%ifdef OCAML3%%% - To add more source files (.ml,.mli,.eliom,.eliomi) to your project, - add it to the variables SERVER_FILES and/or CLIENT_FILES. -%%%endif%%% - - - static/ - The content of this folder is statically served. Put your CSS or - additional JavaScript files here! - - - Makefile.options - Configure your project here! - - - %%%PROJECT_NAME%%%.conf.in - This file is a template for the configuration file for - ocsigenserver. You will rarely have to edit itself - it takes its - variables from the Makefile.options. This way, the installation - rules and the configuration files are synchronized with respect to - the different folders. - - - Makefile - This contains all rules necessary to build, test, and run your - Eliom application. You better don't touch it ;) See below for the - relevant targets. - - - local/ - This directory is the target of the temporary installation of - your application, to test locally before doing a system-wide - installation in /. Do not put anything manually here. - - - README - Not completely describable here. - - -Makefile targets ----------------- - -Here's some help on how to work with this basic distillery project: - - - Test your application by compiling it and running ocsigenserver locally - $ make test.byte (or test.opt) - - - Compile it only - $ make all (or byte or opt) - - - Deploy your project on your system - $ sudo make install (or install.byte or install.opt) - - - Run the server on the deployed project - $ sudo make run.byte (or run.opt) - - If WWWUSER in the Makefile.options is you, you don't need the - `sudo'. If Eliom isn't installed globally, however, you need to - re-export some environment variables to make this work: - $ sudo PATH=$PATH OCAMLPATH=$OCAMLPATH LD_LIBRARY_PATH=$LD_LIBRARY_PATH make run.byte/run.opt - - - If you need a findlib package in your project, add it to the - variables SERVER_PACKAGES and/or CLIENT_PACKAGES. The configuration - file will be automatically updated. diff --git a/pkg/distillery/basic.camlp4/static!css!PROJECT_NAME.css b/pkg/distillery/basic.camlp4/static!css!PROJECT_NAME.css deleted file mode 100644 index b71fa50add..0000000000 --- a/pkg/distillery/basic.camlp4/static!css!PROJECT_NAME.css +++ /dev/null @@ -1,3 +0,0 @@ -* { - font-family: sans-serif; -} diff --git a/pkg/distillery/basic.ppx/.ocp-indent b/pkg/distillery/basic.ppx/.ocp-indent deleted file mode 100644 index ea41aa5457..0000000000 --- a/pkg/distillery/basic.ppx/.ocp-indent +++ /dev/null @@ -1,5 +0,0 @@ -normal -with=0 -syntax=lwt mll -max_indent=2 -ppx_stritem_ext=0 diff --git a/pkg/distillery/basic.ppx/Makefile b/pkg/distillery/basic.ppx/Makefile deleted file mode 100644 index 8c47d3983d..0000000000 --- a/pkg/distillery/basic.ppx/Makefile +++ /dev/null @@ -1,240 +0,0 @@ - -##---------------------------------------------------------------------- -## DISCLAIMER -## -## This file contains the rules to make an Eliom project. The project is -## configured through the variables in the file Makefile.options. -##---------------------------------------------------------------------- - -include Makefile.options - -##---------------------------------------------------------------------- -## Internals - -## Required binaries -ELIOMC := eliomc -ppx -ELIOMOPT := eliomopt -ppx -JS_OF_ELIOM := js_of_eliom -ppx -ELIOMDEP := eliomdep -OCSIGENSERVER := ocsigenserver -OCSIGENSERVER.OPT := ocsigenserver.opt - -## Where to put intermediate object files. -## - ELIOM_{SERVER,CLIENT}_DIR must be distinct -## - ELIOM_CLIENT_DIR must not be the local dir. -## - ELIOM_SERVER_DIR could be ".", but you need to -## remove it from the "clean" rules... -export ELIOM_SERVER_DIR := _server -export ELIOM_CLIENT_DIR := _client -export ELIOM_TYPE_DIR := _server -DEPSDIR := _deps - -ifeq ($(DEBUG),yes) - GENERATE_DEBUG ?= -g - RUN_DEBUG ?= "-v" - DEBUG_JS ?= -jsopt -pretty -jsopt -noinline -jsopt -debuginfo -endif - -##---------------------------------------------------------------------- -## General - -.PHONY: all byte opt -all: byte opt -byte opt:: $(TEST_PREFIX)$(ELIOMSTATICDIR)/${PROJECT_NAME}.js -byte opt:: $(TEST_PREFIX)$(ETCDIR)/$(PROJECT_NAME).conf -byte opt:: $(TEST_PREFIX)$(ETCDIR)/$(PROJECT_NAME)-test.conf -byte:: $(TEST_PREFIX)$(LIBDIR)/${PROJECT_NAME}.cma -opt:: $(TEST_PREFIX)$(LIBDIR)/${PROJECT_NAME}.cmxs - -DIST_DIRS = $(ETCDIR) $(DATADIR) $(LIBDIR) $(LOGDIR) $(STATICDIR) $(ELIOMSTATICDIR) $(shell dirname $(CMDPIPE)) - -##---------------------------------------------------------------------- -## Testing - -DIST_FILES = $(ELIOMSTATICDIR)/$(PROJECT_NAME).js $(LIBDIR)/$(PROJECT_NAME).cma - -.PHONY: test.byte test.opt -test.byte: $(addprefix $(TEST_PREFIX),$(ETCDIR)/$(PROJECT_NAME)-test.conf $(DIST_DIRS) $(DIST_FILES)) - $(OCSIGENSERVER) $(RUN_DEBUG) -c $< -test.opt: $(addprefix $(TEST_PREFIX),$(ETCDIR)/$(PROJECT_NAME)-test.conf $(DIST_DIRS) $(patsubst %.cma,%.cmxs, $(DIST_FILES))) - $(OCSIGENSERVER.OPT) $(RUN_DEBUG) -c $< - -$(addprefix $(TEST_PREFIX), $(DIST_DIRS)): - mkdir -p $@ - -##---------------------------------------------------------------------- -## Installing & Running - -.PHONY: install install.byte install.byte install.opt install.static install.etc install.lib install.lib.byte install.lib.opt run.byte run.opt -install: install.byte install.opt -install.byte: install.lib.byte install.etc install.static | $(addprefix $(PREFIX),$(DATADIR) $(LOGDIR) $(shell dirname $(CMDPIPE))) -install.opt: install.lib.opt install.etc install.static | $(addprefix $(PREFIX),$(DATADIR) $(LOGDIR) $(shell dirname $(CMDPIPE))) -install.lib: install.lib.byte install.lib.opt -install.lib.byte: $(TEST_PREFIX)$(LIBDIR)/$(PROJECT_NAME).cma | $(PREFIX)$(LIBDIR) - install $< $(PREFIX)$(LIBDIR) -install.lib.opt: $(TEST_PREFIX)$(LIBDIR)/$(PROJECT_NAME).cmxs | $(PREFIX)$(LIBDIR) - install $< $(PREFIX)$(LIBDIR) -install.static: $(TEST_PREFIX)$(ELIOMSTATICDIR)/$(PROJECT_NAME).js | $(PREFIX)$(STATICDIR) $(PREFIX)$(ELIOMSTATICDIR) - cp -r $(LOCAL_STATIC)/* $(PREFIX)$(STATICDIR) - [ -z $(WWWUSER) ] || chown -R $(WWWUSER) $(PREFIX)$(STATICDIR) - install $(addprefix -o ,$(WWWUSER)) $< $(PREFIX)$(ELIOMSTATICDIR) -install.etc: $(TEST_PREFIX)$(ETCDIR)/$(PROJECT_NAME).conf | $(PREFIX)$(ETCDIR) - install $< $(PREFIX)$(ETCDIR)/$(PROJECT_NAME).conf - -.PHONY: -print-install-files: - @echo $(PREFIX)$(LIBDIR) - @echo $(PREFIX)$(STATICDIR) - @echo $(PREFIX)$(ELIOMSTATICDIR) - @echo $(PREFIX)$(ETCDIR) - -$(addprefix $(PREFIX),$(ETCDIR) $(LIBDIR)): - install -d $@ -$(addprefix $(PREFIX),$(DATADIR) $(LOGDIR) $(STATICDIR) $(ELIOMSTATICDIR) $(shell dirname $(CMDPIPE))): - install $(addprefix -o ,$(WWWUSER)) -d $@ - -run.byte: - $(OCSIGENSERVER) $(RUN_DEBUG) -c ${PREFIX}${ETCDIR}/${PROJECT_NAME}.conf -run.opt: - $(OCSIGENSERVER.OPT) $(RUN_DEBUG) -c ${PREFIX}${ETCDIR}/${PROJECT_NAME}.conf - -##---------------------------------------------------------------------- -## Aux - -# Use `eliomdep -sort' only in OCaml>4 -ifeq ($(shell ocamlc -version|cut -c1),4) -eliomdep=$(shell $(ELIOMDEP) $(1) -ppx -sort $(2) $(filter %.eliom %.ml,$(3)))) -else -eliomdep=$(3) -endif -objs=$(patsubst %.ml,$(1)/%.$(2),$(patsubst %.eliom,$(1)/%.$(2),$(filter %.eliom %.ml,$(3)))) -depsort=$(call objs,$(1),$(2),$(call eliomdep,$(3),$(4),$(5))) - -##---------------------------------------------------------------------- -## Config files - -FINDLIB_PACKAGES=$(patsubst %,\,$(SERVER_PACKAGES)) -EDIT_WARNING=DON\'T EDIT THIS FILE! It is generated from $(PROJECT_NAME).conf.in, edit that one, or the variables in Makefile.options -SED_ARGS := -e "/^ *%%%/d" -SED_ARGS += -e "s|%%PROJECT_NAME%%|$(PROJECT_NAME)|g" -SED_ARGS += -e "s|%%DATABASE_NAME%%|$(DATABASE_NAME)|g" -SED_ARGS += -e "s|%%DATABASE_USER%%|$(DATABASE_USER)|g" -SED_ARGS += -e "s|%%CMDPIPE%%|%%PREFIX%%$(CMDPIPE)|g" -SED_ARGS += -e "s|%%LOGDIR%%|%%PREFIX%%$(LOGDIR)|g" -SED_ARGS += -e "s|%%DATADIR%%|%%PREFIX%%$(DATADIR)|g" -SED_ARGS += -e "s|%%PERSISTENT_DATA_BACKEND%%|$(PERSISTENT_DATA_BACKEND)|g" -SED_ARGS += -e "s|%%LIBDIR%%|%%PREFIX%%$(LIBDIR)|g" -SED_ARGS += -e "s|%%WARNING%%|$(EDIT_WARNING)|g" -SED_ARGS += -e "s|%%PACKAGES%%|$(FINDLIB_PACKAGES)|g" -SED_ARGS += -e "s|%%ELIOMSTATICDIR%%|%%PREFIX%%$(ELIOMSTATICDIR)|g" -ifeq ($(DEBUG),yes) - SED_ARGS += -e "s|%%DEBUGMODE%%|\|g" -else - SED_ARGS += -e "s|%%DEBUGMODE%%||g" -endif - -LOCAL_SED_ARGS := -e "s|%%PORT%%|$(TEST_PORT)|g" -LOCAL_SED_ARGS += -e "s|%%STATICDIR%%|$(LOCAL_STATIC)|g" -LOCAL_SED_ARGS += -e "s|%%USERGROUP%%||g" -GLOBAL_SED_ARGS := -e "s|%%PORT%%|$(PORT)|g" -GLOBAL_SED_ARGS += -e "s|%%STATICDIR%%|%%PREFIX%%$(STATICDIR)|g" -ifeq ($(WWWUSER)$(WWWGROUP),) - GLOBAL_SED_ARGS += -e "s|%%USERGROUP%%||g" -else - GLOBAL_SED_ARGS += -e "s|%%USERGROUP%%|$(WWWUSER)$(WWWGROUP)|g" -endif - -$(TEST_PREFIX)${ETCDIR}/${PROJECT_NAME}.conf: ${PROJECT_NAME}.conf.in Makefile.options | $(TEST_PREFIX)$(ETCDIR) - sed $(SED_ARGS) $(GLOBAL_SED_ARGS) $< | sed -e "s|%%PREFIX%%|$(PREFIX)|g" > $@ -$(TEST_PREFIX)${ETCDIR}/${PROJECT_NAME}-test.conf: ${PROJECT_NAME}.conf.in Makefile.options | $(TEST_PREFIX)$(ETCDIR) - sed $(SED_ARGS) $(LOCAL_SED_ARGS) $< | sed -e "s|%%PREFIX%%|$(TEST_PREFIX)|g" > $@ - -##---------------------------------------------------------------------- -## Server side compilation - -SERVER_INC := ${addprefix -package ,${SERVER_PACKAGES}} - -${ELIOM_TYPE_DIR}/%.type_mli: %.eliom - ${ELIOMC} -infer ${SERVER_INC} $< - -$(TEST_PREFIX)$(LIBDIR)/$(PROJECT_NAME).cma: $(call objs,$(ELIOM_SERVER_DIR),cmo,$(SERVER_FILES)) | $(TEST_PREFIX)$(LIBDIR) - ${ELIOMC} -a -o $@ $(GENERATE_DEBUG) \ - $(call depsort,$(ELIOM_SERVER_DIR),cmo,-server,$(SERVER_INC),$(SERVER_FILES)) - -$(TEST_PREFIX)$(LIBDIR)/$(PROJECT_NAME).cmxa: $(call objs,$(ELIOM_SERVER_DIR),cmx,$(SERVER_FILES)) | $(TEST_PREFIX)$(LIBDIR) - ${ELIOMOPT} -a -o $@ $(GENERATE_DEBUG) \ - $(call depsort,$(ELIOM_SERVER_DIR),cmx,-server,$(SERVER_INC),$(SERVER_FILES)) - -%.cmxs: %.cmxa - $(ELIOMOPT) -shared -linkall -o $@ $(GENERATE_DEBUG) $< - -${ELIOM_SERVER_DIR}/%.cmi: %.mli - ${ELIOMC} -c ${SERVER_INC} $(GENERATE_DEBUG) $< - -${ELIOM_SERVER_DIR}/%.cmi: %.eliomi - ${ELIOMC} -c ${SERVER_INC} $(GENERATE_DEBUG) $< - -${ELIOM_SERVER_DIR}/%.cmo: %.ml - ${ELIOMC} -c ${SERVER_INC} $(GENERATE_DEBUG) $< -${ELIOM_SERVER_DIR}/%.cmo: %.eliom - ${ELIOMC} -c ${SERVER_INC} $(GENERATE_DEBUG) $< - -${ELIOM_SERVER_DIR}/%.cmx: %.ml - ${ELIOMOPT} -c ${SERVER_INC} $(GENERATE_DEBUG) $< -${ELIOM_SERVER_DIR}/%.cmx: %.eliom - ${ELIOMOPT} -c ${SERVER_INC} $(GENERATE_DEBUG) $< - - -##---------------------------------------------------------------------- -## Client side compilation - -CLIENT_LIBS := ${addprefix -package ,${CLIENT_PACKAGES}} -CLIENT_INC := ${addprefix -package ,${CLIENT_PACKAGES}} - -CLIENT_OBJS := $(filter %.eliom %.ml, $(CLIENT_FILES)) -CLIENT_OBJS := $(patsubst %.eliom,${ELIOM_CLIENT_DIR}/%.cmo, ${CLIENT_OBJS}) -CLIENT_OBJS := $(patsubst %.ml,${ELIOM_CLIENT_DIR}/%.cmo, ${CLIENT_OBJS}) - -$(TEST_PREFIX)$(ELIOMSTATICDIR)/$(PROJECT_NAME).js: $(call objs,$(ELIOM_CLIENT_DIR),cmo,$(CLIENT_FILES)) | $(TEST_PREFIX)$(ELIOMSTATICDIR) - ${JS_OF_ELIOM} -o $@ $(GENERATE_DEBUG) $(CLIENT_INC) $(DEBUG_JS) \ - $(call depsort,$(ELIOM_CLIENT_DIR),cmo,-client,$(CLIENT_INC),$(CLIENT_FILES)) - -${ELIOM_CLIENT_DIR}/%.cmi: %.mli - ${JS_OF_ELIOM} -c ${CLIENT_INC} $(GENERATE_DEBUG) $< - -${ELIOM_CLIENT_DIR}/%.cmo: %.eliom - ${JS_OF_ELIOM} -c ${CLIENT_INC} $(GENERATE_DEBUG) $< -${ELIOM_CLIENT_DIR}/%.cmo: %.ml - ${JS_OF_ELIOM} -c ${CLIENT_INC} $(GENERATE_DEBUG) $< - -${ELIOM_CLIENT_DIR}/%.cmi: %.eliomi - ${JS_OF_ELIOM} -c ${CLIENT_INC} $(GENERATE_DEBUG) $< - -##---------------------------------------------------------------------- -## Dependencies - -include .depend - -.depend: $(patsubst %,$(DEPSDIR)/%.server,$(SERVER_FILES)) $(patsubst %,$(DEPSDIR)/%.client,$(CLIENT_FILES)) - cat $^ > $@ - -$(DEPSDIR)/%.server: % | $(DEPSDIR) - $(ELIOMDEP) -server -ppx $(SERVER_INC) $< > $@ - -$(DEPSDIR)/%.client: % | $(DEPSDIR) - $(ELIOMDEP) -client -ppx $(CLIENT_INC) $< > $@ - -$(DEPSDIR): - mkdir $@ - -##---------------------------------------------------------------------- -## Clean up - -clean: - -rm -f *.cm[ioax] *.cmxa *.cmxs *.o *.a *.annot - -rm -f *.type_mli - -rm -f ${PROJECT_NAME}.js - -rm -rf ${ELIOM_CLIENT_DIR} ${ELIOM_SERVER_DIR} - -distclean: clean - -rm -rf $(TEST_PREFIX) $(DEPSDIR) .depend diff --git a/pkg/distillery/basic.ppx/Makefile.options b/pkg/distillery/basic.ppx/Makefile.options deleted file mode 100644 index 791a4a6fe0..0000000000 --- a/pkg/distillery/basic.ppx/Makefile.options +++ /dev/null @@ -1,64 +0,0 @@ - -#---------------------------------------------------------------------- -# SETTINGS FOR THE ELIOM PROJECT %%%PROJECT_NAME%%% -#---------------------------------------------------------------------- - -PROJECT_NAME := %%%PROJECT_NAME%%% - -# Source files for the server -SERVER_FILES := $(wildcard *.eliomi *.eliom) -# Source files for the client -CLIENT_FILES := $(wildcard *.eliomi *.eliom) - -# OCamlfind packages for the server -SERVER_PACKAGES := lwt_ppx js_of_ocaml-ppx.deriving -# OCamlfind packages for the client -CLIENT_PACKAGES := lwt_ppx js_of_ocaml-ppx js_of_ocaml-ppx.deriving - -# Directory with files to be statically served -LOCAL_STATIC = static - -# The backend for persistent data. Can be dbm or sqlite. -# Make sure you have the following packages installed -# - *dbm* if you use dbm --> opam install dbm. -# - *sqlite3* if you use sqlite --> opam install sqlite3. -PERSISTENT_DATA_BACKEND = %%%PROJECT_DB%%% - -# Debug application (yes/no): Debugging info in compilation, -# JavaScript, ocsigenserver -DEBUG := no - -# User to run server with (make run.*) -WWWUSER := www-data -WWWGROUP := www-data - -# Port for running the server (make run.*) -PORT := 80 - -# Port for testing (make test.*) -TEST_PORT := 8080 - -# Root of installation (must end with /) -PREFIX := /usr/local/ - -# Local folder for make test.* (must end with /) -# Do not add files manually in this directory. -# It is just here to test your installation before installing in / -TEST_PREFIX := local/ - -# The installation tree (relative to $(PREFIX) when -# installing/running or $(TEST_PREFIX) when testing). -# Configuration file $(PROJECT_NAME).conf -ETCDIR := etc/${PROJECT_NAME} -# Project's library $(PROJECT_NAME).cma (cmxs) -LIBDIR := lib/${PROJECT_NAME} -# Command pipe, eg. $ echo reload > $(INSTALL_PREFIX)$(CMDPIPE) -CMDPIPE := var/run/${PROJECT_NAME}-cmd -# Ocsigenserver's logging files -LOGDIR := var/log/${PROJECT_NAME} -# Ocsigenserver's persistent data files -DATADIR := var/data/${PROJECT_NAME} -# Copy of $(LOCAL_STATIC) -STATICDIR := var/www/${PROJECT_NAME}/static -# Project's JavaScript file -ELIOMSTATICDIR := var/www/${PROJECT_NAME}/eliom diff --git a/pkg/distillery/basic.ppx/PROJECT_NAME.conf.in b/pkg/distillery/basic.ppx/PROJECT_NAME.conf.in deleted file mode 100644 index 13a8a1fdbb..0000000000 --- a/pkg/distillery/basic.ppx/PROJECT_NAME.conf.in +++ /dev/null @@ -1,28 +0,0 @@ -%%% This is the template for your configuration file. The %%VALUES%% below are -%%% taken from the Makefile to generate the actual configuration files. -%%% This comment will disappear. - - - - %%PORT%% - %%% Only set for running, not for testing - %%USERGROUP%% - %%LOGDIR%% - %%DATADIR%% - utf-8 - %%% Only set when debugging - %%DEBUGMODE%% - %%CMDPIPE%% - - - - %%% This will include the packages defined as SERVER_PACKAGES in your Makefile: - %%PACKAGES%% - - - - - - - - diff --git a/pkg/distillery/basic.ppx/PROJECT_NAME.eliom b/pkg/distillery/basic.ppx/PROJECT_NAME.eliom deleted file mode 100644 index 77ec3706a7..0000000000 --- a/pkg/distillery/basic.ppx/PROJECT_NAME.eliom +++ /dev/null @@ -1,30 +0,0 @@ -[%%shared - open Eliom_lib - open Eliom_content - open Html.D -] - -module %%%MODULE_NAME%%%_app = - Eliom_registration.App ( - struct - let application_name = "%%%PROJECT_NAME%%%" - let global_data_path = None - end) - -let main_service = - Eliom_service.create - ~path:(Eliom_service.Path []) - ~meth:(Eliom_service.Get Eliom_parameter.unit) - () - -let () = - %%%MODULE_NAME%%%_app.register - ~service:main_service - (fun () () -> - Lwt.return - (Eliom_tools.F.html - ~title:"%%%PROJECT_NAME%%%" - ~css:[["css";"%%%PROJECT_NAME%%%.css"]] - Html.F.(body [ - h1 [pcdata "Welcome from Eliom's distillery!"]; - ]))) diff --git a/pkg/distillery/basic.ppx/README b/pkg/distillery/basic.ppx/README deleted file mode 100644 index 6c48aa8af2..0000000000 --- a/pkg/distillery/basic.ppx/README +++ /dev/null @@ -1,82 +0,0 @@ - -Instructions -============ - -This project is (initially) generated by eliom-distillery as the basic -project "%%%PROJECT_NAME%%%". - -Generally, you can compile it and run ocsigenserver on it by - $ make test.byte (or test.opt) -See below for other useful targets for make. - -Generated files ---------------- - -The following files in this directory have been generated by -eliom-distillery: - - - %%%PROJECT_NAME%%%.eliom - This is your initial source file. -%%%ifdef OCAML4%%% - All Eliom files (*.eliom, *.eliomi) in this directory are - automatically considered. To add a .ml/.mli file to your project, - append it to the variable SERVER_FILES or CLIENT_FILES. -%%%endif%%% -%%%ifdef OCAML3%%% - To add more source files (.ml,.mli,.eliom,.eliomi) to your project, - add it to the variables SERVER_FILES and/or CLIENT_FILES. -%%%endif%%% - - - static/ - The content of this folder is statically served. Put your CSS or - additional JavaScript files here! - - - Makefile.options - Configure your project here! - - - %%%PROJECT_NAME%%%.conf.in - This file is a template for the configuration file for - ocsigenserver. You will rarely have to edit itself - it takes its - variables from the Makefile.options. This way, the installation - rules and the configuration files are synchronized with respect to - the different folders. - - - Makefile - This contains all rules necessary to build, test, and run your - Eliom application. You better don't touch it ;) See below for the - relevant targets. - - - local/ - This directory is the target of the temporary installation of - your application, to test locally before doing a system-wide - installation in /. Do not put anything manually here. - - - README - Not completely describable here. - - -Makefile targets ----------------- - -Here's some help on how to work with this basic distillery project: - - - Test your application by compiling it and running ocsigenserver locally - $ make test.byte (or test.opt) - - - Compile it only - $ make all (or byte or opt) - - - Deploy your project on your system - $ sudo make install (or install.byte or install.opt) - - - Run the server on the deployed project - $ sudo make run.byte (or run.opt) - - If WWWUSER in the Makefile.options is you, you don't need the - `sudo'. If Eliom isn't installed globally, however, you need to - re-export some environment variables to make this work: - $ sudo PATH=$PATH OCAMLPATH=$OCAMLPATH LD_LIBRARY_PATH=$LD_LIBRARY_PATH make run.byte/run.opt - - - If you need a findlib package in your project, add it to the - variables SERVER_PACKAGES and/or CLIENT_PACKAGES. The configuration - file will be automatically updated. diff --git a/pkg/distillery/basic.ppx/static!css!PROJECT_NAME.css b/pkg/distillery/basic.ppx/static!css!PROJECT_NAME.css deleted file mode 100644 index b71fa50add..0000000000 --- a/pkg/distillery/basic.ppx/static!css!PROJECT_NAME.css +++ /dev/null @@ -1,3 +0,0 @@ -* { - font-family: sans-serif; -} diff --git a/pkg/etc/mime.types b/pkg/etc/mime.types deleted file mode 100644 index 3485692d11..0000000000 --- a/pkg/etc/mime.types +++ /dev/null @@ -1,592 +0,0 @@ -# This is a comment. I love comments. - -# This file controls what Internet media types are sent to the client for -# given file extension(s). Sending the correct media type to the client -# is important so they know how to handle the content of the file. -# Extra types can either be added here or by using an AddType directive -# in your config files. For more information about Internet media types, -# please read RFC 2045, 2046, 2047, 2048, and 2077. The Internet media type -# registry is at . - -# MIME type Extensions -application/activemessage -application/andrew-inset ez -application/applefile -application/atom+xml atom -application/atomicmail -application/batch-smtp -application/beep+xml -application/cals-1840 -application/cnrp+xml -application/commonground -application/cpl+xml -application/cybercash -application/dca-rft -application/dec-dx -application/dvcs -application/edi-consent -application/edifact -application/edi-x12 -application/eshop -application/font-tdpfr -application/http -application/hyperstudio -application/iges -application/index -application/index.cmd -application/index.obj -application/index.response -application/index.vnd -application/iotp -application/ipp -application/isup -application/mac-binhex40 hqx -application/mac-compactpro cpt -application/macwriteii -application/marc -application/mathematica -application/mathml+xml mathml -application/msword doc -application/news-message-id -application/news-transmission -application/ocsp-request -application/ocsp-response -application/octet-stream bin dms lha lzh exe class so dll dmg -application/oda oda -application/ogg ogg -application/parityfec -application/pdf pdf -application/pgp-encrypted -application/pgp-keys -application/pgp-signature -application/pkcs10 -application/pkcs7-mime -application/pkcs7-signature -application/pkix-cert -application/pkix-crl -application/pkixcmp -application/postscript ai eps ps -application/prs.alvestrand.titrax-sheet -application/prs.cww -application/prs.nprend -application/prs.plucker -application/qsig -application/rdf+xml rdf -application/reginfo+xml -application/remote-printing -application/riscos -application/rtf -application/sdp -application/set-payment -application/set-payment-initiation -application/set-registration -application/set-registration-initiation -application/sgml -application/sgml-open-catalog -application/sieve -application/slate -application/smil smi smil -application/srgs gram -application/srgs+xml grxml -application/timestamp-query -application/timestamp-reply -application/tve-trigger -application/vemmi -application/vnd.3gpp.pic-bw-large -application/vnd.3gpp.pic-bw-small -application/vnd.3gpp.pic-bw-var -application/vnd.3gpp.sms -application/vnd.3m.post-it-notes -application/vnd.accpac.simply.aso -application/vnd.accpac.simply.imp -application/vnd.acucobol -application/vnd.acucorp -application/vnd.adobe.xfdf -application/vnd.aether.imp -application/vnd.amiga.ami -application/vnd.anser-web-certificate-issue-initiation -application/vnd.anser-web-funds-transfer-initiation -application/vnd.audiograph -application/vnd.blueice.multipass -application/vnd.bmi -application/vnd.businessobjects -application/vnd.canon-cpdl -application/vnd.canon-lips -application/vnd.cinderella -application/vnd.claymore -application/vnd.commerce-battelle -application/vnd.commonspace -application/vnd.contact.cmsg -application/vnd.cosmocaller -application/vnd.criticaltools.wbs+xml -application/vnd.ctc-posml -application/vnd.cups-postscript -application/vnd.cups-raster -application/vnd.cups-raw -application/vnd.curl -application/vnd.cybank -application/vnd.data-vision.rdz -application/vnd.dna -application/vnd.dpgraph -application/vnd.dreamfactory -application/vnd.dxr -application/vnd.ecdis-update -application/vnd.ecowin.chart -application/vnd.ecowin.filerequest -application/vnd.ecowin.fileupdate -application/vnd.ecowin.series -application/vnd.ecowin.seriesrequest -application/vnd.ecowin.seriesupdate -application/vnd.enliven -application/vnd.epson.esf -application/vnd.epson.msf -application/vnd.epson.quickanime -application/vnd.epson.salt -application/vnd.epson.ssf -application/vnd.ericsson.quickcall -application/vnd.eudora.data -application/vnd.fdf -application/vnd.ffsns -application/vnd.fints -application/vnd.flographit -application/vnd.framemaker -application/vnd.fsc.weblaunch -application/vnd.fujitsu.oasys -application/vnd.fujitsu.oasys2 -application/vnd.fujitsu.oasys3 -application/vnd.fujitsu.oasysgp -application/vnd.fujitsu.oasysprs -application/vnd.fujixerox.ddd -application/vnd.fujixerox.docuworks -application/vnd.fujixerox.docuworks.binder -application/vnd.fut-misnet -application/vnd.grafeq -application/vnd.groove-account -application/vnd.groove-help -application/vnd.groove-identity-message -application/vnd.groove-injector -application/vnd.groove-tool-message -application/vnd.groove-tool-template -application/vnd.groove-vcard -application/vnd.hbci -application/vnd.hhe.lesson-player -application/vnd.hp-hpgl -application/vnd.hp-hpid -application/vnd.hp-hps -application/vnd.hp-pcl -application/vnd.hp-pclxl -application/vnd.httphone -application/vnd.hzn-3d-crossword -application/vnd.ibm.afplinedata -application/vnd.ibm.electronic-media -application/vnd.ibm.minipay -application/vnd.ibm.modcap -application/vnd.ibm.rights-management -application/vnd.ibm.secure-container -application/vnd.informix-visionary -application/vnd.intercon.formnet -application/vnd.intertrust.digibox -application/vnd.intertrust.nncp -application/vnd.intu.qbo -application/vnd.intu.qfx -application/vnd.irepository.package+xml -application/vnd.is-xpr -application/vnd.japannet-directory-service -application/vnd.japannet-jpnstore-wakeup -application/vnd.japannet-payment-wakeup -application/vnd.japannet-registration -application/vnd.japannet-registration-wakeup -application/vnd.japannet-setstore-wakeup -application/vnd.japannet-verification -application/vnd.japannet-verification-wakeup -application/vnd.jisp -application/vnd.kde.karbon -application/vnd.kde.kchart -application/vnd.kde.kformula -application/vnd.kde.kivio -application/vnd.kde.kontour -application/vnd.kde.kpresenter -application/vnd.kde.kspread -application/vnd.kde.kword -application/vnd.kenameaapp -application/vnd.koan -application/vnd.liberty-request+xml -application/vnd.llamagraphics.life-balance.desktop -application/vnd.llamagraphics.life-balance.exchange+xml -application/vnd.lotus-1-2-3 -application/vnd.lotus-approach -application/vnd.lotus-freelance -application/vnd.lotus-notes -application/vnd.lotus-organizer -application/vnd.lotus-screencam -application/vnd.lotus-wordpro -application/vnd.mcd -application/vnd.mediastation.cdkey -application/vnd.meridian-slingshot -application/vnd.micrografx.flo -application/vnd.micrografx.igx -application/vnd.mif mif -application/vnd.minisoft-hp3000-save -application/vnd.mitsubishi.misty-guard.trustweb -application/vnd.mobius.daf -application/vnd.mobius.dis -application/vnd.mobius.mbk -application/vnd.mobius.mqy -application/vnd.mobius.msl -application/vnd.mobius.plc -application/vnd.mobius.txf -application/vnd.mophun.application -application/vnd.mophun.certificate -application/vnd.motorola.flexsuite -application/vnd.motorola.flexsuite.adsi -application/vnd.motorola.flexsuite.fis -application/vnd.motorola.flexsuite.gotap -application/vnd.motorola.flexsuite.kmr -application/vnd.motorola.flexsuite.ttc -application/vnd.motorola.flexsuite.wem -application/vnd.mozilla.xul+xml xul -application/vnd.ms-artgalry -application/vnd.ms-asf -application/vnd.ms-excel xls -application/vnd.ms-lrm -application/vnd.ms-powerpoint ppt -application/vnd.ms-project -application/vnd.ms-tnef -application/vnd.ms-works -application/vnd.ms-wpl -application/vnd.mseq -application/vnd.msign -application/vnd.music-niff -application/vnd.musician -application/vnd.netfpx -application/vnd.noblenet-directory -application/vnd.noblenet-sealer -application/vnd.noblenet-web -application/vnd.novadigm.edm -application/vnd.novadigm.edx -application/vnd.novadigm.ext -application/vnd.obn -application/vnd.osa.netdeploy -application/vnd.palm -application/vnd.pg.format -application/vnd.pg.osasli -application/vnd.powerbuilder6 -application/vnd.powerbuilder6-s -application/vnd.powerbuilder7 -application/vnd.powerbuilder7-s -application/vnd.powerbuilder75 -application/vnd.powerbuilder75-s -application/vnd.previewsystems.box -application/vnd.publishare-delta-tree -application/vnd.pvi.ptid1 -application/vnd.pwg-multiplexed -application/vnd.pwg-xhtml-print+xml -application/vnd.quark.quarkxpress -application/vnd.rapid -application/vnd.s3sms -application/vnd.sealed.net -application/vnd.seemail -application/vnd.shana.informed.formdata -application/vnd.shana.informed.formtemplate -application/vnd.shana.informed.interchange -application/vnd.shana.informed.package -application/vnd.smaf -application/vnd.sss-cod -application/vnd.sss-dtf -application/vnd.sss-ntf -application/vnd.street-stream -application/vnd.svd -application/vnd.swiftview-ics -application/vnd.triscape.mxs -application/vnd.trueapp -application/vnd.truedoc -application/vnd.ufdl -application/vnd.uplanet.alert -application/vnd.uplanet.alert-wbxml -application/vnd.uplanet.bearer-choice -application/vnd.uplanet.bearer-choice-wbxml -application/vnd.uplanet.cacheop -application/vnd.uplanet.cacheop-wbxml -application/vnd.uplanet.channel -application/vnd.uplanet.channel-wbxml -application/vnd.uplanet.list -application/vnd.uplanet.list-wbxml -application/vnd.uplanet.listcmd -application/vnd.uplanet.listcmd-wbxml -application/vnd.uplanet.signal -application/vnd.vcx -application/vnd.vectorworks -application/vnd.vidsoft.vidconference -application/vnd.visio -application/vnd.visionary -application/vnd.vividence.scriptfile -application/vnd.vsf -application/vnd.wap.sic -application/vnd.wap.slc -application/vnd.wap.wbxml wbxml -application/vnd.wap.wmlc wmlc -application/vnd.wap.wmlscriptc wmlsc -application/vnd.webturbo -application/vnd.wrq-hp3000-labelled -application/vnd.wt.stf -application/vnd.wv.csp+wbxml -application/vnd.xara -application/vnd.xfdl -application/vnd.yamaha.hv-dic -application/vnd.yamaha.hv-script -application/vnd.yamaha.hv-voice -application/vnd.yellowriver-custom-menu -application/voicexml+xml vxml -application/watcherinfo+xml -application/whoispp-query -application/whoispp-response -application/wita -application/wordperfect5.1 -application/x-bcpio bcpio -application/x-cdlink vcd -application/x-chess-pgn pgn -application/x-compress -application/x-cpio cpio -application/x-csh csh -application/x-director dcr dir dxr -application/x-dvi dvi -application/x-futuresplash spl -application/x-gtar gtar -application/x-gzip -application/x-hdf hdf -application/x-javascript js -application/x-koan skp skd skt skm -application/x-latex latex -application/x-netcdf nc cdf -application/x-sh sh -application/x-shar shar -application/x-shockwave-flash swf -application/x-stuffit sit -application/x-sv4cpio sv4cpio -application/x-sv4crc sv4crc -application/x-tar tar -application/x-tcl tcl -application/x-tex tex -application/x-texinfo texinfo texi -application/x-troff t tr roff -application/x-troff-man man -application/x-troff-me me -application/x-troff-ms ms -application/x-ustar ustar -application/x-wais-source src -application/x400-bp -application/xhtml+xml xhtml xht -application/xslt+xml xslt -application/xml xml xsl -application/xml-dtd dtd -application/xml-external-parsed-entity -application/zip zip -audio/32kadpcm -audio/amr -audio/amr-wb -audio/basic au snd -audio/cn -audio/dat12 -audio/dsr-es201108 -audio/dvi4 -audio/evrc -audio/evrc0 -audio/g722 -audio/g.722.1 -audio/g723 -audio/g726-16 -audio/g726-24 -audio/g726-32 -audio/g726-40 -audio/g728 -audio/g729 -audio/g729D -audio/g729E -audio/gsm -audio/gsm-efr -audio/l8 -audio/l16 -audio/l20 -audio/l24 -audio/lpc -audio/midi mid midi kar -audio/mpa -audio/mpa-robust -audio/mp4a-latm -audio/mpeg mpga mp2 mp3 -audio/parityfec -audio/pcma -audio/pcmu -audio/prs.sid -audio/qcelp -audio/red -audio/smv -audio/smv0 -audio/telephone-event -audio/tone -audio/vdvi -audio/vnd.3gpp.iufp -audio/vnd.cisco.nse -audio/vnd.cns.anp1 -audio/vnd.cns.inf1 -audio/vnd.digital-winds -audio/vnd.everad.plj -audio/vnd.lucent.voice -audio/vnd.nortel.vbk -audio/vnd.nuera.ecelp4800 -audio/vnd.nuera.ecelp7470 -audio/vnd.nuera.ecelp9600 -audio/vnd.octel.sbc -audio/vnd.qcelp -audio/vnd.rhetorex.32kadpcm -audio/vnd.vmx.cvsd -audio/x-aiff aif aiff aifc -audio/x-alaw-basic -audio/x-mpegurl m3u -audio/x-pn-realaudio ram ra -audio/x-pn-realaudio-plugin -application/vnd.rn-realmedia rm -audio/x-wav wav -chemical/x-pdb pdb -chemical/x-xyz xyz -image/bmp bmp -image/cgm cgm -image/g3fax -image/gif gif -image/ief ief -image/jpeg jpeg jpg jpe -image/naplps -image/png png -image/prs.btif -image/prs.pti -image/svg+xml svg -image/t38 -image/tiff tiff tif -image/tiff-fx -image/vnd.cns.inf2 -image/vnd.djvu djvu djv -image/vnd.dwg -image/vnd.dxf -image/vnd.fastbidsheet -image/vnd.fpx -image/vnd.fst -image/vnd.fujixerox.edmics-mmr -image/vnd.fujixerox.edmics-rlc -image/vnd.globalgraphics.pgb -image/vnd.mix -image/vnd.ms-modi -image/vnd.net-fpx -image/vnd.svf -image/vnd.wap.wbmp wbmp -image/vnd.xiff -image/x-cmu-raster ras -image/x-icon ico -image/x-portable-anymap pnm -image/x-portable-bitmap pbm -image/x-portable-graymap pgm -image/x-portable-pixmap ppm -image/x-rgb rgb -image/x-xbitmap xbm -image/x-xpixmap xpm -image/x-xwindowdump xwd -message/delivery-status -message/disposition-notification -message/external-body -message/http -message/news -message/partial -message/rfc822 -message/s-http -message/sip -message/sipfrag -model/iges igs iges -model/mesh msh mesh silo -model/vnd.dwf -model/vnd.flatland.3dml -model/vnd.gdl -model/vnd.gs-gdl -model/vnd.gtw -model/vnd.mts -model/vnd.parasolid.transmit.binary -model/vnd.parasolid.transmit.text -model/vnd.vtu -model/vrml wrl vrml -multipart/alternative -multipart/appledouble -multipart/byteranges -multipart/digest -multipart/encrypted -multipart/form-data -multipart/header-set -multipart/mixed -multipart/parallel -multipart/related -multipart/report -multipart/signed -multipart/voice-message -text/calendar ics ifb -text/css css -text/directory -text/enriched -text/html html htm -text/parityfec -text/plain asc txt -text/prs.lines.tag -text/rfc822-headers -text/richtext rtx -text/rtf rtf -text/sgml sgml sgm -text/t140 -text/tab-separated-values tsv -text/uri-list -text/vnd.abc -text/vnd.curl -text/vnd.dmclientscript -text/vnd.fly -text/vnd.fmi.flexstor -text/vnd.in3d.3dml -text/vnd.in3d.spot -text/vnd.iptc.nitf -text/vnd.iptc.newsml -text/vnd.latex-z -text/vnd.motorola.reflex -text/vnd.ms-mediapackage -text/vnd.net2phone.commcenter.command -text/vnd.sun.j2me.app-descriptor -text/vnd.wap.si -text/vnd.wap.sl -text/vnd.wap.wml wml -text/vnd.wap.wmlscript wmls -text/x-setext etx -text/xml -text/xml-external-parsed-entity -video/bmpeg -video/bt656 -video/celb -video/dv -video/h261 -video/h263 -video/h263-1998 -video/h263-2000 -video/jpeg -video/mp1s -video/mp2p -video/mp2t -video/mp4v-es -video/mpv -video/mpeg mpeg mpg mpe -video/nv -video/parityfec -video/pointer -video/quicktime qt mov -video/smpte292m -video/vnd.fvt -video/vnd.motorola.video -video/vnd.motorola.videop -video/vnd.mpegurl mxu m4u -video/vnd.nokia.interleaved-multimedia -video/vnd.objectvideo -video/vnd.vivo -video/x-msvideo avi -video/x-sgi-movie movie -x-conference/x-cooltalk ice diff --git a/pkg/filelist.ml b/pkg/filelist.ml deleted file mode 100644 index 9023b484f1..0000000000 --- a/pkg/filelist.ml +++ /dev/null @@ -1,212 +0,0 @@ -type descr = { - interface_only : string list; - interface : string list; - internal : string list; -} - -let server = { - interface_only = [ - "eliom_content_sigs"; - "eliom_form_sigs"; - "eliom_parameter_sigs"; - "eliom_registration_sigs"; - "eliom_service_sigs"; - "eliom_shared_sigs"; - ]; - interface = [ - "eliom_bus"; - "eliom_client_value"; - "eliom_syntax"; - "eliom_client"; - "eliom_comet"; - "eliom_common"; - "eliom_config"; - "eliom_content"; - "eliom_cookie"; - "eliom_extension"; - "eliom_lib"; - "eliom_mkreg"; - "eliom_notif"; - "eliom_parameter"; - "eliom_react"; - "eliom_shared"; - "eliom_cscache"; - "eliom_reference"; - "eliom_registration"; - "eliom_request_info"; - "eliom_service"; - "eliom_state"; - "eliom_tools"; - "eliom_types"; - "eliom_uri"; - "eliom_wrap"; - ]; - internal = [ - "eliom_comet_base"; - "eliom_common_base"; - "eliom_runtime"; - "eliom_content_"; - "eliom_content_core"; - "eliom_cookies_base"; - "eliom_error_pages"; - "eliom_form"; - "eliom_lazy"; - "eliom_lib_base"; - "eliom_parameter_base"; - "eliom_process"; - "eliom_service_base"; - "eliom_route"; - "eliom_route_base"; - "eliom_shared_content"; - "eliom_types_base"; - "eliommod"; - "eliommod_cli"; - "eliommod_cookies"; - "eliommod_datasess"; - "eliommod_gc"; - "eliommod_pagegen"; - "eliommod_parameters"; - "eliommod_persess"; - "eliommod_sersess"; - "eliommod_sessadmin"; - "eliommod_sessexpl"; - "eliommod_sessiongroups"; - "eliommod_timeouts"; - ] -} -let client = { - interface_only = [ - "eliom_content_sigs"; - "eliom_form_sigs"; - "eliom_parameter_sigs"; - "eliom_registration_sigs"; - "eliom_service_sigs"; - "eliom_shared_sigs"; - ]; - interface = [ - "eliom_bus"; - "eliom_client_value"; - "eliom_client_core"; - "eliom_client"; - "eliom_comet"; - "eliom_config"; - "eliom_content"; - "eliom_content_core"; - "eliom_lazy"; - "eliom_lib"; - "eliom_parameter"; - "eliom_react"; - "eliom_shared"; - "eliom_cscache"; - "eliom_registration"; - "eliom_service"; - "eliom_tools"; - "eliom_types"; - "eliom_unwrap"; - "eliom_uri"; - ]; - internal = [ - "eliom_comet_base"; - "eliom_common"; - "eliom_common_base"; - "eliom_runtime"; - "eliom_content_"; - "eliom_cookies_base"; - "eliom_form"; - "eliom_lib_base"; - "eliom_parameter_base"; - "eliom_process"; - "eliom_request"; - "eliom_request_info"; - "eliom_service_base"; - "eliom_route"; - "eliom_route_base"; - "eliom_shared_content"; - "eliom_types_base"; - "eliommod_cookies"; - "eliommod_dom"; - "eliommod_parameters"; - ]; -} - -let server_ext = { - interface_only = []; - interface = [ - "atom_feed"; - "eliom_atom"; - "eliom_openid"; - "eliom_s2s"]; - internal = [] -} - -let ocamlbuild = { - interface_only = []; - interface = [ "ocamlbuild_eliom" ]; - internal = [] - -} - -let ppx = { - interface_only = []; - interface = [ "ppx_eliom" ; "ppx_eliom_client" ; "ppx_eliom_type" ; "ppx_eliom_server" ]; - internal = [ "ppx_eliom_utils" ]; -} - - -let (-.-) name ext = name ^ "." ^ ext -let exts el sl = - List.flatten ( - List.map (fun ext -> - List.map (fun name -> - name -.- ext) sl) el) - -let list_to_file filename list = - let oc = open_out filename in - List.iter (fun s -> - output_string oc s; - output_char oc '\n'; - ) list; - close_out oc;; - -let client_mllib = - client.interface @ client.internal - -let client_extra = - exts ["cmi"] (client.interface_only @ client.interface) - -let client_api = - client.interface_only @ client.interface - -let server_mllib = - server.interface @ server.internal - -let server_extra = - exts ["cmi"] (server.interface_only @ server.interface) @ - exts ["cmx"] (server.interface @ server.internal) - -let server_api = - server.interface_only @ server.interface - -let server_ext_mllib = server_ext.interface @ server_ext.internal -let server_ext_extra = - exts ["cmi"] (server_ext.interface_only @ server_ext.interface) @ - exts ["cmx"] (server_ext.interface @ server_ext.internal) - -let ocamlbuild_mllib = ocamlbuild.interface @ ocamlbuild.internal -let ocamlbuild_extra = - exts ["cmi"] (ocamlbuild.interface_only @ ocamlbuild.interface) @ - exts ["cmx"] (ocamlbuild.interface @ ocamlbuild.internal) -let ocamlbuild_api = ocamlbuild.interface_only @ ocamlbuild.interface - -let ppx_mllib = ppx.interface @ ppx.internal -let ppx_extra = - exts ["cmi"] ppx.interface @ - exts ["cmx"] (ppx.interface @ ppx.internal) -let ppx_api = ppx.interface - - -let templates_dir = "pkg/distillery" -let templates = Array.to_list (Sys.readdir templates_dir) -let templates_files = - List.map (fun name -> - name, Array.to_list (Sys.readdir (templates_dir^"/"^name))) templates diff --git a/pkg/man/eliom-distillery.1 b/pkg/man/eliom-distillery.1 deleted file mode 100644 index 8a542e1b3c..0000000000 --- a/pkg/man/eliom-distillery.1 +++ /dev/null @@ -1,51 +0,0 @@ -.TH eliom-distillery 1 2012-12-17 -.SH NAME -eliom-distillery \- Scaffolding for your Eliom-projects. -.SH SYNOPSIS -.B eliom-distillery -.BI \-dir - -.B eliom-distillery -.BI \-name \ name -[ -.BI \-template \