diff --git a/CHANGES.md b/CHANGES.md index d1b1e24..dae98aa 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,3 +1,9 @@ +# 0.5.3 + +* Improve mdx test tules (#73, @NathanReb) +* Use github actions instead of travis ci (#70, #72) +* Get human readable route pattern from a route (#64, #74) + # 0.5.2 * Support custom HTTP methods via `Other of string` (#58 , @sazarkin) diff --git a/src/parser.ml b/src/parser.ml index dc7801c..be7f929 100644 --- a/src/parser.ml +++ b/src/parser.ml @@ -15,17 +15,17 @@ module R = Router module K = R.Key let get_patterns route = - let rec aux : type a. a t -> R.Key.t list -> R.Key.t list = + let rec aux : type a. a t -> (string * R.Key.t) list -> (string * R.Key.t) list = fun t acc -> match t with | Return _ -> acc | Empty -> acc - | Int -> K.PCapture :: acc - | Int32 -> K.PCapture :: acc - | Int64 -> K.PCapture :: acc - | Bool -> K.PCapture :: acc - | Str -> K.PCapture :: acc - | Match w -> K.PMatch w :: acc + | Int -> ("", K.PCapture) :: acc + | Int32 -> ("", K.PCapture) :: acc + | Int64 -> ("", K.PCapture) :: acc + | Bool -> ("", K.PCapture) :: acc + | Str -> ("", K.PCapture) :: acc + | Match w -> (w, K.PMatch w) :: acc | SkipLeft (l, r) -> let l = aux l acc in let r' = aux r [] in diff --git a/src/routes.ml b/src/routes.ml index 35328b2..4fc13ad 100644 --- a/src/routes.ml +++ b/src/routes.ml @@ -34,6 +34,10 @@ module Method = struct ;; let compare m1 m2 = String.compare (to_string m1) (to_string m2) + + let pp fmt m = Format.fprintf fmt "%s" (to_string m) + + let equal m1 m2 = (compare m1 m2) = 0 end module MethodMap = Map.Make (Method) @@ -44,11 +48,28 @@ module R = struct type 'a t = { routes : 'a Parser.t Router.t MethodMap.t ; url_split : string -> string list + ; route_patterns : (Method.t * string) list } - let create url_split routes = { routes; url_split } + let create url_split routes route_patterns = { routes; url_split; route_patterns } end +let get_route_patterns { R.route_patterns; _ } = route_patterns + +let pattern_of_route r = + let xs, _ = Parser.get_patterns r |> List.split in + String.concat "/" xs +;; + +let pp_router fmt r = + let patterns = get_route_patterns r in + Format.fprintf fmt "Routes:\n"; + List.iter (fun (meth, route) -> + Format.fprintf fmt "> %s %s\n" (Method.to_string meth) route + ) patterns + +let pp_route fmt r = Format.fprintf fmt "Route: %s" (pattern_of_route r) + type 'a router = 'a R.t let empty = Parser.empty @@ -67,17 +88,21 @@ end let with_method ?(ignore_trailing_slash = true) routes = let routes = List.rev routes in - let f acc (m, r) = + let f (xs, acc) (m, r) = let current_routes = match MethodMap.find_opt m acc with | None -> Router.empty | Some v -> v in - let patterns = Parser.get_patterns r in - MethodMap.add m (Router.add patterns (Parser.strip_route r) current_routes) acc + let segment_patterns, patterns = Parser.get_patterns r |> List.split in + let readable_pattern = String.concat "/" segment_patterns in + let acc = + MethodMap.add m (Router.add patterns (Parser.strip_route r) current_routes) acc + in + (m, readable_pattern) :: xs, acc in - let map = List.fold_left f MethodMap.empty routes in - R.create (Util.split_path ignore_trailing_slash) map + let route_patterns, map = List.fold_left f ([], MethodMap.empty) routes in + R.create (Util.split_path ignore_trailing_slash) map route_patterns ;; let one_of ?(ignore_trailing_slash = true) routes = @@ -102,7 +127,7 @@ let run_router t params = run_route routes params' ;; -let match_with_method { R.routes; url_split } ~target ~meth = +let match_with_method { R.routes; url_split; _ } ~target ~meth = let routes = match MethodMap.find_opt meth routes with | None -> Router.empty diff --git a/src/routes.mli b/src/routes.mli index 02fb17d..726481a 100644 --- a/src/routes.mli +++ b/src/routes.mli @@ -22,6 +22,15 @@ module Method : sig ] (** HTTP methods. This is an optional input for route matching. The current types are chosen to be compatible with what Httpaf uses - {{:https://github.com/inhabitedtype/httpaf/blob/c2ee924eaccd2adb2e6aea0b9bc6a0ffe6132723/lib/method.ml} link}. *) + + val pp : Format.formatter -> t -> unit + (** @since 0.5.3 *) + + val equal : t -> t -> bool + (** @since 0.5.3 *) + + val compare : t -> t -> int + (** @since 0.5.3 *) end type 'a t @@ -85,6 +94,25 @@ val match_with_method : 'a router -> target:string -> meth:Method.t -> 'a option If a route matches it runs the attached handler and returns the result. *) +val get_route_patterns : 'a router -> (Method.t * string) list +(** [get_route_patterns] returns a list of human readable route patterns + that will be matched by a router. + + @since 0.5.3 *) + +val pattern_of_route : 'a t -> string +(** [pattern_of_route] convert a route to a human readable string pattern. + + @since 0.5.3 *) + +val pp_route : Format.formatter -> 'a t -> unit + [@@ocaml.toplevel_printer] +(** @since 0.5.3 *) + +val pp_router : Format.formatter -> 'a router -> unit + [@@ocaml.toplevel_printer] +(** @since 0.5.3 *) + module Infix : sig val ( <*> ) : ('a -> 'b) t -> 'a t -> 'b t (** [<*>] takes a function wrapped inside our parser diff --git a/test/routing_test.ml b/test/routing_test.ml index b8fd6e0..5f06f69 100644 --- a/test/routing_test.ml +++ b/test/routing_test.ml @@ -175,6 +175,43 @@ let test_leading_slash_is_discarded () = (match' routes "") ;; +let convert_router_to_string_pattern_list () = + let open Routes in + let open Infix in + let r1 = one_of [ "foo" <$ s "foo"; "empty" <$ empty ] in + let meth = Alcotest.testable Method.pp Method.equal in + let h a b c = Printf.sprintf "%d%b%ld" a b c in + Alcotest.(check (list (pair meth string))) + "convert r1 to list of patterns" + [ `GET, "foo"; `GET, "" ] + (get_route_patterns r1); + let routes = + with_method + [ `GET, "foo" <$ s "foo" <* s "bar" <* s "baz" + ; `POST, h <$> s "user" *> int bool s "baz" *> int32 + ] + in + Alcotest.(check (list (pair meth string))) + "convert router to list of patterns" + [ `GET, "foo/bar/baz"; `POST, "user///baz/" ] + (get_route_patterns routes) +;; + +let convert_route_to_pattern () = + let open Routes in + let open Infix in + let r1 = s "foo" *> s "bar" *> s "baz" in + let h (_ : int) (_ : string) (_ : bool) (_ : int64) (_ : int32) = () in + let r2 = h <$ s "user" int str s "admin" *> bool int64 s "age" *> int32 in + Alcotest.(check string) + "convert r1 to pattern" + "foo/bar/baz" + (pattern_of_route r1); + Alcotest.(check string) + "convert r2 to pattern" + "user///admin///age/" + (pattern_of_route r2) + let tests = [ "Empty routes will have no matches", `Quick, test_no_match ; "Method matches", `Quick, test_method_match @@ -187,6 +224,8 @@ let tests = , `Quick , test_verify_first_parsed_route_matches ) ; "Leading slash is discarded", `Quick, test_leading_slash_is_discarded + ; "Convert router to list of patterns", `Quick, convert_router_to_string_pattern_list + ; "Convert route to pattern", `Quick, convert_route_to_pattern ] ;;