port old router to new router

Signed-off-by: Rudi Grinberg <me@rgrinberg.com>

Author: rgrinberg

opium/src/app.ml

@@ -2,6 +2,7 @@ open Import
 module Server = Httpaf_lwt_unix.Server
 module Reqd = Httpaf.Reqd
 open Lwt.Syntax
+module Route = Router.Route
 
 let err_invalid_host host =
   Lwt.fail_invalid_arg ("Could not get host info for `" ^ host ^ "`")

opium/src/middlewares/middleware_router.ml

@@ -10,54 +10,48 @@ module Method_map = Map.Make (struct
   ;;
 end)
 
-type t = (Route.t * Rock.Handler.t) list Method_map.t
+type t = Rock.Handler.t Method_map.t Router.t
 
-let empty = Method_map.empty
+let empty = Router.empty
 
-let get t meth =
-  match Method_map.find_opt meth t with
-  | None -> []
-  | Some xs -> List.rev xs
-;;
-
-let add t ~route ~meth ~action =
-  Method_map.update
-    meth
-    (function
-      | None -> Some [ route, action ]
-      | Some xs -> Some ((route, action) :: xs))
-    t
+let add (t : t) ~route ~meth ~action =
+  Router.update t route ~f:(function
+      | None -> Method_map.singleton meth action
+      | Some m -> Method_map.add meth action m)
 ;;
 
 (** finds matching endpoint and returns it with the parsed list of parameters *)
-let matching_endpoint endpoints meth uri =
-  let endpoints = get endpoints meth in
-  List.find_map endpoints ~f:(fun ep ->
-      uri |> Route.match_url (fst ep) |> Option.map (fun p -> ep, p))
+let matching_endpoint (endpoints : t) meth uri =
+  match Router.match_url endpoints uri with
+  | None -> None
+  | Some (a, params) ->
+    (match Method_map.find_opt meth a with
+    | None -> None
+    | Some h -> Some (h, params))
 ;;
 
 module Env = struct
-  let key : Route.matches Context.key =
-    Context.Key.create ("path_params", Route.sexp_of_matches)
+  let key : Router.Params.t Context.key =
+    Context.Key.create ("path_params", Router.Params.sexp_of_t)
   ;;
 end
 
-let splat req = Context.find_exn Env.key req.Request.env |> fun route -> route.Route.splat
+let splat req = Context.find_exn Env.key req.Request.env |> Router.Params.unnamed
 
 (* not param_exn since if the endpoint was selected it's likely that the parameter is
    already there *)
 let param req param =
-  let { Route.params; _ } = Context.find_exn Env.key req.Request.env in
-  List.assoc param params
+  let params = Context.find_exn Env.key req.Request.env in
+  Router.Params.named params param
 ;;
 
 let m endpoints =
   let filter default req =
     match matching_endpoint endpoints req.Request.meth req.Request.target with
     | None -> default req
-    | Some (endpoint, params) ->
+    | Some (handler, params) ->
       let env_with_params = Context.add Env.key params req.Request.env in
-      (snd endpoint) { req with Request.env = env_with_params }
+      handler { req with Request.env = env_with_params }
   in
   Rock.Middleware.create ~name:"Router" ~filter
 ;;

opium/src/middlewares/middleware_router.mli

@@ -2,6 +2,6 @@ type t
 
 val m : t -> Rock.Middleware.t
 val empty : t
-val add : t -> route:Route.t -> meth:Method.t -> action:Rock.Handler.t -> t
+val add : t -> route:Router.Route.t -> meth:Method.t -> action:Rock.Handler.t -> t
 val param : Request.t -> string -> string
 val splat : Request.t -> string list

opium/src/opium.ml

@@ -12,7 +12,7 @@ module Body = Body
 module Request = Request
 module Response = Response
 module App = App
-module Route = Route
+module Route = Router.Route
 module Router = Middleware_router
 
 module Handler = struct

opium/src/opium.mli

@@ -14,7 +14,7 @@ module Body = Body
 module Request = Request
 module Response = Response
 module App = App
-module Route = Route
+module Route = Router.Route
 
 module Router : sig
   type t

opium/src/route.ml

@@ -11,6 +11,18 @@ module Route = struct
 
   let equal = ( = )
 
+  let to_string t =
+    let rec loop acc = function
+      | Nil -> acc
+      | Full_splat -> "**" :: acc
+      | Literal (s, rest) -> loop (s :: acc) rest
+      | Param (s, rest) ->
+        let s = Option.value s ~default:"*" in
+        loop (s :: acc) rest
+    in
+    loop [] t |> List.rev |> String.concat ~sep:"/"
+  ;;
+
   let rec sexp_of_t (t : t) : Sexp.t =
     match t with
     | Nil -> Atom "Nil"
@@ -55,15 +67,15 @@ module Route = struct
       else Literal (token, parse_tokens params tokens)
   ;;
 
-  let of_string_exn s =
+  let of_string s =
     let tokens = String.split_on_char ~sep:'/' s in
     match tokens with
     | "" :: tokens -> parse_tokens [] tokens
     | _ -> raise (E "route must start with /")
   ;;
 
-  let of_string s =
-    match of_string_exn s with
+  let of_string_result s =
+    match of_string s with
     | exception E s -> Error s
     | s -> Ok s
   ;;

opium/src/route.mli

@@ -3,9 +3,10 @@ open Import
 module Route : sig
   type t
 
-  val of_string : string -> (t, string) result
-  val of_string_exn : string -> t
+  val of_string_result : string -> (t, string) result
+  val of_string : string -> t
   val sexp_of_t : t -> Sexp.t
+  val to_string : t -> string
 end
 
 module Params : sig

opium/src/router.ml

@@ -3,7 +3,7 @@ module Router = Opium.Private.Router
 open Router
 
 let valid_route s =
-  match Route.of_string s with
+  match Route.of_string_result s with
   | Error err -> print_endline ("[FAIL] invalid route " ^ err)
   | Ok r -> Format.printf "[PASS] valid route:%a@." Sexp.pp_hum (Route.sexp_of_t r)
 ;;
@@ -71,15 +71,15 @@ let%expect_test "dummy router matches nothing" =
 
 let%expect_test "we can add & match literal routes" =
   let url = "/foo/bar" in
-  let route = Route.of_string_exn url in
+  let route = Route.of_string url in
   let router = add empty route () in
   test_match_url router url;
   [%expect {|
     matched with params: ((named ()) (unnamed ())) |}]
 ;;
 
 let%expect_test "we can extract parameter after match" =
-  let route = Route.of_string_exn "/foo/*/:bar" in
+  let route = Route.of_string "/foo/*/:bar" in
   let router = add empty route () in
   test_match_url router "/foo/100/baz";
   test_match_url router "/foo/100";
@@ -93,7 +93,7 @@ let%expect_test "we can extract parameter after match" =
 
 let of_routes routes =
   List.fold_left
-    (fun router (route, data) -> add router (Route.of_string_exn route) data)
+    (fun router (route, data) -> add router (Route.of_string route) data)
     empty
     routes
 ;;