Compare commits

...

4 commits

Author SHA1 Message Date
Simon Cruanes
0f917ddf72
format
Some checks failed
github pages / deploy (push) Has been cancelled
build / build (4.08.x, ubuntu-latest) (push) Has been cancelled
build / build (4.14.x, ubuntu-latest) (push) Has been cancelled
build / build (5.03.x, ubuntu-latest) (push) Has been cancelled
2025-06-06 22:25:48 -04:00
Simon Cruanes
03c3e09f12
feat route: add to_url, to produce a URL path from a route
provide arguments and get the corresponding path, which makes
it easy to build a full URL if needed.
2025-06-06 22:25:01 -04:00
Simon Cruanes
023805232f
fix warnings in C stubs 2025-06-06 22:24:52 -04:00
Simon Cruanes
022a495de3
fix warnings 2025-06-06 22:24:39 -04:00
7 changed files with 53 additions and 27 deletions

View file

@ -1,4 +1,4 @@
version = 0.26.2 version = 0.27.0
profile=conventional profile=conventional
margin=80 margin=80
if-then-else=k-r if-then-else=k-r

View file

@ -26,11 +26,6 @@ let atomic_before_412 =
let atomic_after_412 = {|include Atomic|} let atomic_after_412 = {|include Atomic|}
let write_file file s =
let oc = open_out file in
output_string oc s;
close_out oc
let () = let () =
let version = Scanf.sscanf Sys.ocaml_version "%d.%d.%s" (fun x y _ -> x, y) in let version = Scanf.sscanf Sys.ocaml_version "%d.%d.%s" (fun x y _ -> x, y) in
print_endline print_endline

View file

@ -73,9 +73,9 @@ let rec pp_ : type a b. Buffer.t -> (a, b) t -> unit =
| Rest { url_encoded } -> | Rest { url_encoded } ->
bpf out "<rest_of_url%s>" bpf out "<rest_of_url%s>"
(if url_encoded then (if url_encoded then
"_urlencoded" "_urlencoded"
else else
"") "")
| Compose (Exact s, tl) -> bpf out "%s/%a" s pp_ tl | Compose (Exact s, tl) -> bpf out "%s/%a" s pp_ tl
| Compose (Int, tl) -> bpf out "<int>/%a" pp_ tl | Compose (Int, tl) -> bpf out "<int>/%a" pp_ tl
| Compose (String, tl) -> bpf out "<str>/%a" pp_ tl | Compose (String, tl) -> bpf out "<str>/%a" pp_ tl
@ -91,3 +91,34 @@ module Private_ = struct
end end
let pp out x = Format.pp_print_string out (to_string x) let pp out x = Format.pp_print_string out (to_string x)
let rec to_url_rec : type b. Buffer.t -> (b, string) t -> b =
fun buf route ->
match route with
| Fire -> Buffer.contents buf
| Rest { url_encoded = _ } ->
fun str ->
Buffer.add_string buf str;
Buffer.contents buf
| Compose (comp, rest) ->
(match comp with
| Exact s ->
Buffer.add_string buf s;
Buffer.add_char buf '/';
to_url_rec buf rest
| Int ->
fun i ->
Printf.bprintf buf "%d/" i;
to_url_rec buf rest
| String ->
fun s ->
Printf.bprintf buf "%s/" s;
to_url_rec buf rest
| String_urlencoded ->
fun s ->
Printf.bprintf buf "%s/" (Util.percent_encode s);
to_url_rec buf rest)
let to_url (h : ('a, string) t) : 'a =
let buf = Buffer.create 16 in
to_url_rec buf h

View file

@ -1,8 +1,8 @@
(** Routing (** Routing
Basic type-safe routing of handlers based on URL paths. This is optional, Basic type-safe routing of handlers based on URL paths. This is optional, it
it is possible to only define the root handler with something like is possible to only define the root handler with something like
{{: https://github.com/anuragsoni/routes/} Routes}. {{:https://github.com/anuragsoni/routes/} Routes}.
@since 0.6 *) @since 0.6 *)
type ('a, 'b) comp type ('a, 'b) comp
@ -27,31 +27,33 @@ val return : ('a, 'a) t
(** Matches the empty path. *) (** Matches the empty path. *)
val rest_of_path : (string -> 'a, 'a) t val rest_of_path : (string -> 'a, 'a) t
(** Matches a string, even containing ['/']. This will match (** Matches a string, even containing ['/']. This will match the entirety of the
the entirety of the remaining route. remaining route.
@since 0.7 *) @since 0.7 *)
val rest_of_path_urlencoded : (string -> 'a, 'a) t val rest_of_path_urlencoded : (string -> 'a, 'a) t
(** Matches a string, even containing ['/'], and URL-decode it (piecewise). (** Matches a string, even containing ['/'], and URL-decode it (piecewise). This
This will match the entirety of the remaining route. will match the entirety of the remaining route.
@since 0.7 *) @since 0.7 *)
val ( @/ ) : ('a, 'b) comp -> ('b, 'c) t -> ('a, 'c) t val ( @/ ) : ('a, 'b) comp -> ('b, 'c) t -> ('a, 'c) t
(** [comp / route] matches ["foo/bar/…"] iff [comp] matches ["foo"], (** [comp / route] matches ["foo/bar/…"] iff [comp] matches ["foo"], and [route]
and [route] matches ["bar/…"]. *) matches ["bar/…"]. *)
val exact_path : string -> ('a, 'b) t -> ('a, 'b) t val exact_path : string -> ('a, 'b) t -> ('a, 'b) t
(** [exact_path "foo/bar/..." r] is equivalent to (** [exact_path "foo/bar/..." r] is equivalent to
[exact "foo" @/ exact "bar" @/ ... @/ r] [exact "foo" @/ exact "bar" @/ ... @/ r]
@since 0.11 **) @since 0.11 **)
val pp : Format.formatter -> _ t -> unit val pp : Format.formatter -> _ t -> unit
(** Print the route. (** Print the route.
@since 0.7 *) @since 0.7 *)
val to_string : _ t -> string val to_string : _ t -> string
(** Print the route. (** Print the route.
@since 0.7 *) @since 0.7 *)
val to_url : ('a, string) t -> 'a
module Private_ : sig module Private_ : sig
val eval : string list -> ('a, 'b) t -> 'a -> 'b option val eval : string list -> ('a, 'b) t -> 'a -> 'b option

View file

@ -15,7 +15,6 @@ module Head_middleware = struct
type t = { handle: 'a. 'a Request.t -> 'a Request.t } type t = { handle: 'a. 'a Request.t -> 'a Request.t }
let trivial = { handle = Fun.id } let trivial = { handle = Fun.id }
let[@inline] apply (self : t) req = self.handle req
let[@inline] apply' req (self : t) = self.handle req let[@inline] apply' req (self : t) = self.handle req
let to_middleware (self : t) : Middleware.t = let to_middleware (self : t) : Middleware.t =

View file

@ -1,7 +1,6 @@
(* adapted from https://github.com/sindresorhus/html-tags (MIT licensed) *) (* adapted from https://github.com/sindresorhus/html-tags (MIT licensed) *)
let pf = Printf.printf let pf = Printf.printf
let spf = Printf.sprintf
let void = let void =
[ [

View file

@ -8,7 +8,7 @@ CAMLprim value tiny_httpd_ws_apply_masking(value _mask_key, value _mask_offset,
CAMLparam5(_mask_key, _mask_offset, _buf, _offset, _len); CAMLparam5(_mask_key, _mask_offset, _buf, _offset, _len);
char const *mask_key = String_val(_mask_key); char const *mask_key = String_val(_mask_key);
char *buf = Bytes_val(_buf); unsigned char *buf = Bytes_val(_buf);
intnat mask_offset = Int_val(_mask_offset); intnat mask_offset = Int_val(_mask_offset);
intnat offset = Int_val(_offset); intnat offset = Int_val(_offset);
intnat len = Int_val(_len); intnat len = Int_val(_len);