add nested routes

example/main.ml

@@ -19,7 +19,8 @@ let respond_with_text reqd status text =
 
 module Handlers = struct
   (* The first parameter  *)
-  let greeter (req : Request.t) name city =
+  let greeter router_state name city =
+    let (req : Request.t) = Routes.RouterState.get_request router_state in
     Log.Global.printf "Woohoo! I have access to the Httpaf request here: %s\n" req.target;
     `String ("Hello, " ^ name ^ ". How was your trip to " ^ city ^ "?")
   ;;
@@ -29,6 +30,20 @@ module Handlers = struct
   let return_bigstring _ =
     `Bigstring (Bigstringaf.of_string "Hello world" ~off:0 ~len:11)
   ;;
+
+  let retrieve_user state name id =
+    let req : Request.t = Routes.RouterState.get_request state in
+    Log.Global.printf "Fetching user with name %s and id %d." name id;
+    `String req.target
+  ;;
+
+  let user_routes state =
+    let open Routes in
+    let routes = [ str </> int </> empty ==> retrieve_user ] in
+    match match_with_state ~state routes with
+    | None -> `String "user not found"
+    | Some s -> s
+  ;;
 end
 
 let routes =
@@ -37,6 +52,7 @@ let routes =
   [ empty ==> return_bigstring
   ; method' `GET </> s "greet" </> str </> str </> empty ==> greeter
   ; method' `GET </> s "sum" </> int </> int </> empty ==> sum
+  ; method' `GET </> s "user" ==> user_routes
   ]
 ;;
 

src/routes.ml

@@ -5,11 +5,17 @@ module Fn = struct
   let compose f g x = f (g x)
 end
 
-type ('req, 'meth) state =
-  { req : 'req
-  ; unvisited : String.Sub.t list
-  ; meth : 'meth
-  }
+module RouterState = struct
+  type ('req, 'meth) state =
+    { req : 'req
+    ; unvisited : String.Sub.t list
+    ; meth : 'meth
+    }
+
+  let get_request t = t.req
+end
+
+open RouterState
 
 let split_paths target =
   let is_slash x = x = '/' in
@@ -87,17 +93,21 @@ let ( </> ) m1 m2 state =
 let ( ==> ) mat handle state =
   match mat state with
   | None -> None
-  | Some ({ req; _ }, k) -> Some (k (handle req))
+  | Some (state', k) -> Some (k (handle state'))
 ;;
 
-let match' ~req ~target ~meth paths =
-  let req' = init req target meth in
+let match_with_state ~state paths =
   let rec route' r = function
     | [] -> None
     | x :: xs ->
       (match x r with
       | None -> route' r xs
       | Some resp -> Some resp)
   in
-  route' req' paths
+  route' state paths
+;;
+
+let match' ~req ~target ~meth paths =
+  let req' = init req target meth in
+  match_with_state ~state:req' paths
 ;;

src/routes.mli

@@ -9,7 +9,13 @@
 *)
 
 (** [state] is the state that is threaded through the router during parsing. *)
-type ('req, 'meth) state
+module RouterState : sig
+  type ('req, 'meth) state
+
+  val get_request : ('req, 'meth) state -> 'req
+end
+
+open RouterState
 
 type ('req, 'res, 'meth) route = ('req, 'meth) state -> 'res option
 
@@ -51,7 +57,7 @@ val ( </> )
     were extracted while parsing the route. *)
 val ( ==> )
   :  (('req, 'meth) state -> (('req, 'meth) state * ('k -> 'res)) option)
-  -> ('req -> 'k)
+  -> (('req, 'meth) state -> 'k)
   -> ('req, 'meth) state
   -> 'res option
 
@@ -63,3 +69,8 @@ val match'
   -> meth:'meth
   -> ('req, 'res, 'meth) route list
   -> 'res option
+
+val match_with_state
+  :  state:('req, 'meth) state
+  -> ('req, 'res, 'meth) route list
+  -> 'res option

test/routing_test.ml

@@ -82,12 +82,29 @@ let test_route_order () =
     (match' ~req:Request ~target:"/12/11" ~meth:`GET routes')
 ;;
 
+let test_nested_routes () =
+  let open Routes in
+  let user_handler _ name age = Printf.sprintf "%s %d" name age in
+  let users state =
+    let routes = [ str </> int </> empty ==> user_handler ] in
+    match match_with_state ~state routes with
+    | None -> "Match not found"
+    | Some s -> s
+  in
+  let user_path = [ s "user" ==> users ] in
+  Alcotest.(check (option string))
+    "Can match nested route"
+    (Some "Mark 11")
+    (match' ~req:Request ~target:"/user/Mark/11" ~meth:`GET user_path)
+;;
+
 let tests =
   [ "Empty routes will have no matches", `Quick, test_no_match
   ; "Test method matches", `Quick, test_method_match
   ; "Test route extractors", `Quick, test_extractors
   ; "Test strict match", `Quick, test_strict_match
   ; "Test route orders", `Quick, test_route_order
+  ; "Test nested match", `Quick, test_nested_routes
   ]
 ;;