diff --git a/src/Tiny_httpd_server.ml b/src/Tiny_httpd_server.ml index 4094fba5..e7e5e818 100644 --- a/src/Tiny_httpd_server.ml +++ b/src/Tiny_httpd_server.ml @@ -56,6 +56,7 @@ let unwrap_resp_result = function module Meth = struct type t = [ `GET | `PUT | `POST | `HEAD | `DELETE | `OPTIONS ] + let to_string = function | `GET -> "GET" | `PUT -> "PUT" @@ -74,6 +75,11 @@ module Meth = struct | "DELETE" -> `DELETE | "OPTIONS" -> `OPTIONS | 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 module Headers = struct @@ -585,6 +591,8 @@ module Route = struct | [], Compose (String_urlencoded, Fire) -> Some (f "") (* trailing *) | [], Compose _ -> None + type any = Any : (_, _) t -> any + let bpf = Printf.bprintf 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 +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 val init_addr : unit -> string val init_port : unit -> int @@ -1026,6 +1048,23 @@ module Unix_tcp_server_ = struct } 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 ?(get_time_s = Unix.gettimeofday) ?(new_thread = fun f -> ignore (Thread.create f () : Thread.t)) diff --git a/src/Tiny_httpd_server.mli b/src/Tiny_httpd_server.mli index b91022d2..dda5e7d2 100644 --- a/src/Tiny_httpd_server.mli +++ b/src/Tiny_httpd_server.mli @@ -361,6 +361,10 @@ module Route : sig [exact "foo" @/ exact "bar" @/ ... @/ r] @since 0.11 **) + (** A type-erased route. + @since NEXT_RELEASE *) + type any = Any : (_, _) t -> any + val pp : Format.formatter -> _ t -> unit (** Print the route. @since 0.7 *) @@ -684,6 +688,23 @@ val add_upgrade_handler : 'a -> 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} *) val running : t -> bool