From f22bdc35a3555e1a09f33b1ebbcb01f537a9b292 Mon Sep 17 00:00:00 2001
From: polwex <polwex@sortug.com>
Date: Wed, 16 Jul 2025 22:21:11 +0700
Subject: not bad not bad

---
 lib/router.ml         | 24 +++++++++++++++---------
 test/test_wildcard.ml | 28 ++++++++++++++++++++++++++++
 2 files changed, 43 insertions(+), 9 deletions(-)
 create mode 100644 test/test_wildcard.ml

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
-- 
cgit v1.2.3