1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
|
(* Import the StdLabels module which provides labeled versions of standard library functions *)
open StdLabels
(* Import the Routes library for type-safe HTTP routing *)
open Routes
(* Import Piaf for HTTP types like Method.t *)
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.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 : 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
(* Use standard string comparison *)
String.compare a_str b_str
;;
end)
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 _ -> Ok (Response.create `Not_found)
| Ok body ->
(match Body.to_string body with
| Error _ -> Ok (Response.create `Internal_server_error)
| Ok str -> Ok (Response.of_string ~body:str `Accepted))
;;
(* match Parts.wildcard_match path with *)
(* | "styles.css" -> Ok (Response.of_string ~body:"" Status.(`Accepted)) *)
(* | _ -> Ok (Response.of_string ~body:"" Status.(`Accepted)) *)
(* Define all routes in the application *)
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 *)
~f:(fun acc (v, r) -> R.add_to_list v r acc) (* Start with an empty map *)
~init:R.empty
(* List of (HTTP method, route pattern -> handler) tuples *)
[ `GET, (s "posts" /? nil) @--> Handler.get_posts
(* `GET - HTTP GET method *)
(* s "posts" - matches the literal string "posts" *)
(* /? - path concatenation operator *)
(* 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 "posts" / int /? nil) @--> Handler.get_post
(* / int - captures an integer parameter (post ID) *)
; `GET, (s "comments" / int /? nil) @--> Handler.get_comment
(* Get a single comment by ID *)
; `GET, (s "users" / str / s "comments" /? nil) @--> Handler.get_user_comments
(* / str - captures a string parameter (username) *)
; `GET, (s "posts" / int / s "comments" /? nil) @--> Handler.get_post_comments
(* Get all comments for a specific post *)
; `GET, (s "comments" / int / s "children" /? nil) @--> Handler.get_comment_children
(* Get child comments (replies) for a comment *)
; `POST, (s "posts" /? nil) @--> Post_handlers.create_post (* Create a new post *)
; `POST, (s "comments" /? nil) @--> Post_handlers.create_comment
(* Create a new comment *)
; `POST, (s "votes" /? nil) @--> Post_handlers.create_vote
(* Create a new vote *)
(* bs5 routes *)
(* root *)
(* ; `GET, nil @--> Html.render @@ Pages.BlogIndex.make () *)
; `GET, nil @--> Html.render_conn @@ Pages.BlogIndex.make
; `GET, (s "l" /? nil) @--> Html.get_root
]
;;
(* 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 : (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 : 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 *)
| Some router ->
(* Use the Routes library's match' function to find a matching route *)
(match match' router ~target:path with
(* Exact match - the path matches completely *)
| FullMatch r -> Some r
(* Match with trailing slash - e.g., "/posts" matches "/posts/" *)
| MatchWithTrailingSlash r -> Some r
(* No routes matched the path *)
| NoMatch -> None)
(* We don't have any routes for this HTTP verb *)
| None -> None
;;
|
