From b02ee314032749f1eddc2b4af4cdd74ba286c2c7 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sat, 14 Nov 2020 22:18:33 -0800 Subject: [PATCH] port old router to new router Signed-off-by: Rudi Grinberg --- opium/src/app.ml | 1 + opium/src/middlewares/middleware_router.ml | 46 ++++----- opium/src/middlewares/middleware_router.mli | 2 +- opium/src/opium.ml | 2 +- opium/src/opium.mli | 2 +- opium/src/route.ml | 107 -------------------- opium/src/route.mli | 21 ---- opium/src/router.ml | 18 +++- opium/src/router.mli | 5 +- opium/test/opium_router_tests.ml | 8 +- 10 files changed, 46 insertions(+), 166 deletions(-) delete mode 100644 opium/src/route.ml delete mode 100644 opium/src/route.mli diff --git a/opium/src/app.ml b/opium/src/app.ml index 606420e2..2ed4ad11 100644 --- a/opium/src/app.ml +++ b/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 ^ "`") diff --git a/opium/src/middlewares/middleware_router.ml b/opium/src/middlewares/middleware_router.ml index 827f26d0..d4ef402b 100644 --- a/opium/src/middlewares/middleware_router.ml +++ b/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 ;; diff --git a/opium/src/middlewares/middleware_router.mli b/opium/src/middlewares/middleware_router.mli index c81c5f9d..951ba88d 100644 --- a/opium/src/middlewares/middleware_router.mli +++ b/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 diff --git a/opium/src/opium.ml b/opium/src/opium.ml index 9b646e56..7a85f806 100644 --- a/opium/src/opium.ml +++ b/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 diff --git a/opium/src/opium.mli b/opium/src/opium.mli index a8009e43..31f3fbb1 100644 --- a/opium/src/opium.mli +++ b/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 diff --git a/opium/src/route.ml b/opium/src/route.ml deleted file mode 100644 index 2b53bd43..00000000 --- a/opium/src/route.ml +++ /dev/null @@ -1,107 +0,0 @@ -open Import - -type path_segment = - | Match of string - | Param of string - | Splat - | FullSplat - | Slash - -type matches = - { params : (string * string) list - ; splat : string list - } - -let sexp_of_matches { params; splat } = - let splat' = Sexp_conv.sexp_of_list Sexp_conv.sexp_of_string splat in - let sexp_of_param (a, b) = Sexp_conv.sexp_of_list Sexp_conv.sexp_of_string [ a; b ] in - Sexp.List - [ List [ Atom "params"; Sexp_conv.sexp_of_list sexp_of_param params ] - ; List [ Atom "splat"; splat' ] - ] -;; - -type t = path_segment list - -let parse_param s = - if s = "/" - then Slash - else if s = "*" - then Splat - else if s = "**" - then FullSplat - else ( - try Scanf.sscanf s ":%s" (fun s -> Param s) with - | Scanf.Scan_failure _ -> Match s) -;; - -let of_list l = - let last_i = List.length l - 1 in - l - |> List.mapi ~f:(fun i s -> - match parse_param s with - | FullSplat when i <> last_i -> invalid_arg "** is only allowed at the end" - | x -> x) -;; - -let split_slash_delim = - let re = '/' |> Re.char |> Re.compile in - fun path -> - path - |> Re.split_full re - |> List.map ~f:(function - | `Text s -> `Text s - | `Delim _ -> `Delim) -;; - -let split_slash path = - path - |> split_slash_delim - |> List.map ~f:(function - | `Text s -> s - | `Delim -> "/") -;; - -let of_string path = path |> split_slash |> of_list - -let to_string l = - let r = - l - |> List.filter_map ~f:(function - | Match s -> Some s - | Param s -> Some (":" ^ s) - | Splat -> Some "*" - | FullSplat -> Some "**" - | Slash -> None) - |> String.concat ~sep:"/" - in - "/" ^ r -;; - -let rec match_url t url ({ params; splat } as matches) = - match t, url with - | [], [] | [ FullSplat ], _ -> Some matches - | FullSplat :: _, _ -> assert false (* splat can't be last *) - | Match x :: t, `Text y :: url when x = y -> match_url t url matches - | Slash :: t, `Delim :: url -> match_url t url matches - | Splat :: t, `Text s :: url -> - match_url t url { matches with splat = Uri.pct_decode s :: splat } - | Param name :: t, `Text p :: url -> - match_url t url { matches with params = (name, Uri.pct_decode p) :: params } - | Splat :: _, `Delim :: _ - | Param _ :: _, `Delim :: _ - | Match _ :: _, _ - | Slash :: _, _ - | _ :: _, [] - | [], _ :: _ -> None -;; - -let match_url t url = - let path = - match String.index_opt url '?' with - | None -> url - | Some i -> String.sub url ~pos:0 ~len:i - in - let path = path |> split_slash_delim in - match_url t path { params = []; splat = [] } -;; diff --git a/opium/src/route.mli b/opium/src/route.mli deleted file mode 100644 index f282e972..00000000 --- a/opium/src/route.mli +++ /dev/null @@ -1,21 +0,0 @@ -(** Expression that represent a target or multiple *) - -type t - -type matches = - { params : (string * string) list - ; splat : string list - } - -(** [sexp_of_t matches] converts the matches [matches] to an s-expression *) -val sexp_of_matches : matches -> Sexplib0.Sexp.t - -(** [of_string s] returns a route from its string representation [s]. *) -val of_string : string -> t - -(** [to_string t] returns a string representation of the route [t]. *) -val to_string : t -> string - -(** [match_url t url] return the matches of the url [url] for the route [t], or [None] if - the url does not match. *) -val match_url : t -> string -> matches option diff --git a/opium/src/router.ml b/opium/src/router.ml index b137a918..6a6de9b9 100644 --- a/opium/src/router.ml +++ b/opium/src/router.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 ;; diff --git a/opium/src/router.mli b/opium/src/router.mli index 96cb7874..e02da0d8 100644 --- a/opium/src/router.mli +++ b/opium/src/router.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 diff --git a/opium/test/opium_router_tests.ml b/opium/test/opium_router_tests.ml index 747bf551..9bd61190 100644 --- a/opium/test/opium_router_tests.ml +++ b/opium/test/opium_router_tests.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,7 +71,7 @@ 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 {| @@ -79,7 +79,7 @@ let%expect_test "we can add & match literal routes" = ;; 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 ;;