feat: get a human readable pattern for a route

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)

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 -> ("<int>", K.PCapture) :: acc
+    | Int32 -> ("<int32>", K.PCapture) :: acc
+    | Int64 -> ("<int64>", K.PCapture) :: acc
+    | Bool -> ("<bool>", K.PCapture) :: acc
+    | Str -> ("<string>", K.PCapture) :: acc
+    | Match w -> (w, K.PMatch w) :: acc
     | SkipLeft (l, r) ->
       let l = aux l acc in
       let r' = aux r [] in

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

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

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/<int>/<bool>/baz/<int32>" ]
+    (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/<int>/<string>/admin/<bool>/<int64>/age/<int32>"
+    (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
   ]
 ;;