This commit is contained in:
Simon Cruanes 2024-02-23 14:59:19 -05:00
parent 13bfbfa759
commit edad99ffb5
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4
2 changed files with 60 additions and 0 deletions

View file

@ -56,6 +56,7 @@ let unwrap_resp_result = function
module Meth = struct module Meth = struct
type t = [ `GET | `PUT | `POST | `HEAD | `DELETE | `OPTIONS ] type t = [ `GET | `PUT | `POST | `HEAD | `DELETE | `OPTIONS ]
let to_string = function let to_string = function
| `GET -> "GET" | `GET -> "GET"
| `PUT -> "PUT" | `PUT -> "PUT"
@ -74,6 +75,11 @@ module Meth = struct
| "DELETE" -> `DELETE | "DELETE" -> `DELETE
| "OPTIONS" -> `OPTIONS | "OPTIONS" -> `OPTIONS
| s -> bad_reqf 400 "unknown method %S" s | s -> bad_reqf 400 "unknown method %S" s
module Map = Map.Make(struct
type nonrec t = t
let compare : t -> t -> int = Stdlib.compare
end)
end end
module Headers = struct module Headers = struct
@ -585,6 +591,8 @@ module Route = struct
| [], Compose (String_urlencoded, Fire) -> Some (f "") (* trailing *) | [], Compose (String_urlencoded, Fire) -> Some (f "") (* trailing *)
| [], Compose _ -> None | [], Compose _ -> None
type any = Any : (_, _) t -> any
let bpf = Printf.bprintf let bpf = Printf.bprintf
let rec pp_ : type a b. Buffer.t -> (a, b) t -> unit = let rec pp_ : type a b. Buffer.t -> (a, b) t -> unit =
@ -655,6 +663,20 @@ type upgrade_handler = (module UPGRADE_HANDLER)
exception Upgrade of unit Request.t * upgrade_handler exception Upgrade of unit Request.t * upgrade_handler
module Route_tree = struct
type leaf = {
regular: (unit Req.t Meth.Map.t;
}
type endpoint =
| Regular of Meth
type (_, _) t =
| Fire : ('b, 'b) t *
| Rest : { url_encoded: bool } -> (string -> 'b, 'b) t
| Node
end
module type IO_BACKEND = sig module type IO_BACKEND = sig
val init_addr : unit -> string val init_addr : unit -> string
val init_port : unit -> int val init_port : unit -> int
@ -1026,6 +1048,23 @@ module Unix_tcp_server_ = struct
} }
end end
module Inspect = struct
type endpoint =
| Regular of { meth: Meth.t }
| SSE
| Upgrade of { name: string }
let string_of_endpoint = function
| Regular { meth } -> Meth.to_string meth
| SSE -> "SSE"
| Upgrade { name } -> Printf.sprintf "upgrade-to-%s" name
let pp_endpoint out e = Format.pp_print_string out (string_of_endpoint e)
let endpoints (self:t) yield : unit =
self.path_handlers
end
let create ?(masksigpipe = true) ?max_connections ?(timeout = 0.0) ?buf_size let create ?(masksigpipe = true) ?max_connections ?(timeout = 0.0) ?buf_size
?(get_time_s = Unix.gettimeofday) ?(get_time_s = Unix.gettimeofday)
?(new_thread = fun f -> ignore (Thread.create f () : Thread.t)) ?(new_thread = fun f -> ignore (Thread.create f () : Thread.t))

View file

@ -361,6 +361,10 @@ module Route : sig
[exact "foo" @/ exact "bar" @/ ... @/ r] [exact "foo" @/ exact "bar" @/ ... @/ r]
@since 0.11 **) @since 0.11 **)
(** A type-erased route.
@since NEXT_RELEASE *)
type any = Any : (_, _) t -> any
val pp : Format.formatter -> _ t -> unit val pp : Format.formatter -> _ t -> unit
(** Print the route. (** Print the route.
@since 0.7 *) @since 0.7 *)
@ -684,6 +688,23 @@ val add_upgrade_handler :
'a -> 'a ->
unit unit
(** {2 Inspect the server} *)
(** Inspect the server.
@since NEXT_RELEASE *)
module Inspect : sig
type endpoint =
| Regular of { meth: Meth.t }
| SSE
| Upgrade of { name: string }
val pp_endpoint : Format.formatter -> endpoint -> unit
val string_of_endpoint : endpoint -> string
val endpoints : t -> (Route.any * endpoint -> unit) -> unit
(** Iterate on all endpoints of the server *)
end
(** {2 Run the server} *) (** {2 Run the server} *)
val running : t -> bool val running : t -> bool