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
margin=80
if-then-else=k-r

View file

@ -26,11 +26,6 @@ let atomic_before_412 =
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 version = Scanf.sscanf Sys.ocaml_version "%d.%d.%s" (fun x y _ -> x, y) in
print_endline

View file

@ -73,9 +73,9 @@ let rec pp_ : type a b. Buffer.t -> (a, b) t -> unit =
| Rest { url_encoded } ->
bpf out "<rest_of_url%s>"
(if url_encoded then
"_urlencoded"
else
"")
"_urlencoded"
else
"")
| Compose (Exact s, tl) -> bpf out "%s/%a" s pp_ tl
| Compose (Int, tl) -> bpf out "<int>/%a" pp_ tl
| Compose (String, tl) -> bpf out "<str>/%a" pp_ tl
@ -91,3 +91,34 @@ module Private_ = struct
end
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
Basic type-safe routing of handlers based on URL paths. This is optional,
it is possible to only define the root handler with something like
{{: https://github.com/anuragsoni/routes/} Routes}.
Basic type-safe routing of handlers based on URL paths. This is optional, it
is possible to only define the root handler with something like
{{:https://github.com/anuragsoni/routes/} Routes}.
@since 0.6 *)
type ('a, 'b) comp
@ -27,31 +27,33 @@ val return : ('a, 'a) t
(** Matches the empty path. *)
val rest_of_path : (string -> 'a, 'a) t
(** Matches a string, even containing ['/']. This will match
the entirety of the remaining route.
@since 0.7 *)
(** Matches a string, even containing ['/']. This will match the entirety of the
remaining route.
@since 0.7 *)
val rest_of_path_urlencoded : (string -> 'a, 'a) t
(** Matches a string, even containing ['/'], and URL-decode it (piecewise).
This will match the entirety of the remaining route.
@since 0.7 *)
(** Matches a string, even containing ['/'], and URL-decode it (piecewise). This
will match the entirety of the remaining route.
@since 0.7 *)
val ( @/ ) : ('a, 'b) comp -> ('b, 'c) t -> ('a, 'c) t
(** [comp / route] matches ["foo/bar/…"] iff [comp] matches ["foo"],
and [route] matches ["bar/…"]. *)
(** [comp / route] matches ["foo/bar/…"] iff [comp] matches ["foo"], and [route]
matches ["bar/…"]. *)
val exact_path : string -> ('a, 'b) t -> ('a, 'b) t
(** [exact_path "foo/bar/..." r] is equivalent to
[exact "foo" @/ exact "bar" @/ ... @/ r]
@since 0.11 **)
[exact "foo" @/ exact "bar" @/ ... @/ r]
@since 0.11 **)
val pp : Format.formatter -> _ t -> unit
(** Print the route.
@since 0.7 *)
@since 0.7 *)
val to_string : _ t -> string
(** Print the route.
@since 0.7 *)
@since 0.7 *)
val to_url : ('a, string) t -> 'a
module Private_ : sig
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 }
let trivial = { handle = Fun.id }
let[@inline] apply (self : t) req = self.handle req
let[@inline] apply' req (self : t) = self.handle req
let to_middleware (self : t) : Middleware.t =

View file

@ -1,7 +1,6 @@
(* adapted from https://github.com/sindresorhus/html-tags (MIT licensed) *)
let pf = Printf.printf
let spf = Printf.sprintf
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);
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 offset = Int_val(_offset);
intnat len = Int_val(_len);