diff options
| -rw-r--r-- | lib/router.ml | 24 | ||||
| -rw-r--r-- | test/test_wildcard.ml | 28 |
2 files changed, 43 insertions, 9 deletions
diff --git a/lib/router.ml b/lib/router.ml index 03e11f3..56a297c 100644 --- a/lib/router.ml +++ b/lib/router.ml @@ -9,12 +9,12 @@ open Piaf (* Create a custom Map module keyed by HTTP methods (GET, POST, etc.) *) (* This allows us to organize routes by their HTTP verb *) -module R = Map.Make (struct +module R : Map.S with type key = Method.t = Map.Make (struct (* The key type is Piaf's Method.t (represents HTTP methods) *) type t = Method.t (* Define how to compare two HTTP methods for ordering in the map *) - let compare a b = + let compare (a : t) (b : t) : int = (* Convert methods to strings (e.g., "GET", "POST") *) let a_str = Method.to_string a in let b_str = Method.to_string b in @@ -23,13 +23,15 @@ module R = Map.Make (struct ;; end) -let static path _db _req = +let static (path : Parts.t) (_db : Handler.pool) (_req : Request.t) + : (Response.t, Caqti_error.t) result + = let pat = Parts.wildcard_match path in match Body.sendfile pat with - | Error err -> Error err + | Error _ -> Ok (Response.create `Not_found) | Ok body -> (match Body.to_string body with - | Error e -> Error e + | Error _ -> Ok (Response.create `Internal_server_error) | Ok str -> Ok (Response.of_string ~body:str Status.(`Accepted))) ;; @@ -38,7 +40,7 @@ let static path _db _req = (* | _ -> Ok (Response.of_string ~body:"" Status.(`Accepted)) *) (* Define all routes in the application *) -let routes = +let routes : (Handler.pool -> Request.t -> (Response.t, Caqti_error.t) result) route list R.t = (* Use fold_left to build up a map of routes *) List.fold_left (* For each (verb, route) pair, add the route to the map under that verb *) @@ -52,7 +54,7 @@ let routes = (* nil - end of path (no more segments) *) (* @--> - binds the route pattern to the handler function *) (* Handler.get_posts - the function that handles this route *) - (* ; `GET, s "assets" wildcard @--> static *) + (* ; `GET, (s "assets" / wildcard) @--> static *) ; `GET, (s "posts" / int /? nil) @--> Handler.get_post (* / int - captures an integer parameter (post ID) *) ; `GET, (s "comments" / int /? nil) @--> Handler.get_comment @@ -79,10 +81,14 @@ let routes = (* Transform the routes map by applying 'one_of' to each list of routes *) (* 'one_of' combines multiple routes into a single router that tries each in order *) -let router = R.map one_of routes +let router : (Handler.pool -> Request.t -> (Response.t, Caqti_error.t) result) router R.t = + R.map one_of routes +;; (* Function to match an incoming request against our routes *) -let match_route verb path = +let match_route (verb : Method.t) (path : string) + : (Handler.pool -> Request.t -> (Response.t, Caqti_error.t) result) option + = (* Try to find routes for the given HTTP verb in our map *) match R.find_opt verb router with (* If we have routes for this verb, try to match the path *) diff --git a/test/test_wildcard.ml b/test/test_wildcard.ml new file mode 100644 index 0000000..b595d76 --- /dev/null +++ b/test/test_wildcard.ml @@ -0,0 +1,28 @@ +open OUnit2 +open Piaf +open Routes + +let static path_parts _db_pool _req = + let path = Routes.Parts.wildcard_match path_parts in + let full_path = "assets/" ^ path in + Ok (Response.of_string ~body:full_path `OK) + +let routes = + [ `GET, (s "assets" / wildcard) @--> static + ] + +let test_wildcard _ = + let router = one_of routes in + let target = "/assets/foo/bar" +in + match match' router ~target with + | FullMatch f -> + let res = f () () in + let body = Piaf.Body.to_string res.body in + assert_equal "assets/foo/bar" body + | _ -> assert_failure "No match" + +let suite = "wildcard" >::: [ "test_wildcard" >:: test_wildcard ] + +let () + = run_test_tt_main suite |