summaryrefslogtreecommitdiff
path: root/litedb
diff options
context:
space:
mode:
Diffstat (limited to 'litedb')
-rw-r--r--litedb/handler.ml159
-rw-r--r--litedb/query.ml45
-rw-r--r--litedb/router.ml73
3 files changed, 270 insertions, 7 deletions
diff --git a/litedb/handler.ml b/litedb/handler.ml
new file mode 100644
index 0000000..dd9251f
--- /dev/null
+++ b/litedb/handler.ml
@@ -0,0 +1,159 @@
+open Piaf
+
+type pool = ((module Rapper_helper.CONNECTION), Caqti_error.t) Caqti_eio.Pool.t
+
+(* This is the main handler function for the GET /posts endpoint. *)
+(* It takes a database connection pool and a Piaf request as input. *)
+let get_posts (db_pool : pool) (_request : Request.t) =
+ (* Use a connection from the pool. Caqti_eio.Pool.use handles acquiring and releasing the connection. *)
+ Caqti_eio.Pool.use
+ (fun conn ->
+ (* Call the get_poasts function from the Query module to fetch posts from the database. *)
+ let posts_or_error = Query.get_poasts () conn in
+ (* Pattern match on the result of the database query. *)
+ match posts_or_error with
+ (* If the query is successful, the result is a list of posts. *)
+ | Ok posts ->
+ (* Map the list of post tuples to a Yojson list. *)
+ let json =
+ `List
+ ((* For each post tuple, create a JSON object. *)
+ List.map
+ (fun (post : Query.post_summary) -> `Assoc [ "title", `String post.title ])
+ posts)
+ in
+ (* Return a 200 OK response with the JSON body. *)
+ Ok (Response.of_string ~body:(Yojson.Safe.to_string json) `OK)
+ (* If the query fails, log the error and return a 500 Internal Server Error response. *)
+ | Error err ->
+ Logs.err (fun m -> m "Database error: %a" Caqti_error.pp err);
+ Ok (Response.create `Internal_server_error))
+ db_pool
+;;
+
+(* Handler for GET /posts/:id - gets a single post by ID *)
+let get_post (db_pool : pool) post_id (_request : Request.t) =
+ Caqti_eio.Pool.use
+ (fun conn ->
+ let post_or_error = Query.get_poast post_id conn in
+ match post_or_error with
+ | Ok (Some post) ->
+ let json =
+ `Assoc [
+ "id", `Int post.id;
+ "title", `String post.title;
+ "content", `String post.content;
+ "date", `String post.date;
+ "tags", `String post.tags;
+ "url", `String post.url
+ ]
+ in
+ Ok (Response.of_string ~body:(Yojson.Safe.to_string json) `OK)
+ | Ok None ->
+ Ok (Response.create `Not_found)
+ | Error err ->
+ Logs.err (fun m -> m "Database error: %a" Caqti_error.pp err);
+ Ok (Response.create `Internal_server_error))
+ db_pool
+;;
+
+(* Handler for GET /comments/:id - gets a single comment by ID *)
+let get_comment (db_pool : pool) comment_id (_request : Request.t) =
+ Caqti_eio.Pool.use
+ (fun conn ->
+ let comment_or_error = Query.Query.comment ~id:comment_id conn in
+ match comment_or_error with
+ | Ok (Some comment) ->
+ let json =
+ `Assoc [
+ "id", `Int comment.id;
+ "content", `String comment.content;
+ "date", `String comment.date;
+ "tags", `String comment.tags;
+ "url", `String comment.url
+ ]
+ in
+ Ok (Response.of_string ~body:(Yojson.Safe.to_string json) `OK)
+ | Ok None ->
+ Ok (Response.create `Not_found)
+ | Error err ->
+ Logs.err (fun m -> m "Database error: %a" Caqti_error.pp err);
+ Ok (Response.create `Internal_server_error))
+ db_pool
+;;
+
+(* Handler for GET /users/:username/comments - gets comments by a user *)
+let get_user_comments (db_pool : pool) username (_request : Request.t) =
+ Caqti_eio.Pool.use
+ (fun conn ->
+ let comments_or_error = Query.Query.user_comments ~username conn in
+ match comments_or_error with
+ | Ok (Some comment) ->
+ let json =
+ `Assoc [
+ "id", `Int comment.id;
+ "content", `String comment.content;
+ "date", `String comment.date;
+ "tags", `String comment.tags;
+ "url", `String comment.url
+ ]
+ in
+ Ok (Response.of_string ~body:(Yojson.Safe.to_string json) `OK)
+ | Ok None ->
+ (* Return empty array if no comments found *)
+ Ok (Response.of_string ~body:"[]" `OK)
+ | Error err ->
+ Logs.err (fun m -> m "Database error: %a" Caqti_error.pp err);
+ Ok (Response.create `Internal_server_error))
+ db_pool
+;;
+
+(* Handler for GET /posts/:id/comments - gets comments for a post *)
+let get_post_comments (db_pool : pool) post_id (_request : Request.t) =
+ Caqti_eio.Pool.use
+ (fun conn ->
+ let comments_or_error = Query.Query.post_comments ~post_id conn in
+ match comments_or_error with
+ | Ok (Some comment) ->
+ let json =
+ `Assoc [
+ "id", `Int comment.id;
+ "content", `String comment.content;
+ "date", `String comment.date;
+ "tags", `String comment.tags;
+ "url", `String comment.url
+ ]
+ in
+ Ok (Response.of_string ~body:(Yojson.Safe.to_string json) `OK)
+ | Ok None ->
+ Ok (Response.of_string ~body:"[]" `OK)
+ | Error err ->
+ Logs.err (fun m -> m "Database error: %a" Caqti_error.pp err);
+ Ok (Response.create `Internal_server_error))
+ db_pool
+;;
+
+(* Handler for GET /comments/:id/children - gets child comments *)
+let get_comment_children (db_pool : pool) parent_id (_request : Request.t) =
+ Caqti_eio.Pool.use
+ (fun conn ->
+ let comments_or_error = Query.Query.comment_children ~post_id:parent_id conn in
+ match comments_or_error with
+ | Ok (Some comment) ->
+ let json =
+ `Assoc [
+ "id", `Int comment.id;
+ "content", `String comment.content;
+ "date", `String comment.date;
+ "tags", `String comment.tags;
+ "url", `String comment.url
+ ]
+ in
+ Ok (Response.of_string ~body:(Yojson.Safe.to_string json) `OK)
+ | Ok None ->
+ Ok (Response.of_string ~body:"[]" `OK)
+ | Error err ->
+ Logs.err (fun m -> m "Database error: %a" Caqti_error.pp err);
+ Ok (Response.create `Internal_server_error))
+ db_pool
+;;
diff --git a/litedb/query.ml b/litedb/query.ml
index 4929fdf..536347c 100644
--- a/litedb/query.ml
+++ b/litedb/query.ml
@@ -1,3 +1,28 @@
+(* Define record types for the query outputs *)
+type post_summary = {
+ id: int;
+ title: string;
+ content: string;
+ date: string;
+}
+
+type post = {
+ id: int;
+ title: string;
+ content: string;
+ date: string;
+ tags: string;
+ url: string;
+}
+
+type comment = {
+ id: int;
+ content: string;
+ date: string;
+ tags: string;
+ url: string;
+}
+
module Query = struct
let poasts =
[%rapper
@@ -6,7 +31,8 @@ module Query = struct
SELECT @int{id}, @string{title}, @string{content}, @string{date}
FROM Posts
ORDER BY id DESC LIMIT 100
- |sql}]
+ |sql}
+ record_out]
;;
let poast =
@@ -16,7 +42,8 @@ module Query = struct
SELECT @int{id}, @string{title}, @string{content}, @string{date}, @string{tags}, @string{url}
FROM Posts
WHERE id = %int{post_id}
- |sql}]
+ |sql}
+ record_out]
;;
let comment =
@@ -26,7 +53,8 @@ module Query = struct
SELECT @int{id}, @string{content}, @string{date}, @string{tags}, @string{url}
FROM Comments
WHERE id = %int{id}
- |sql}]
+ |sql}
+ record_out]
;;
let user_comments =
@@ -36,7 +64,8 @@ module Query = struct
SELECT @int{id}, @string{content}, @string{date}, @string{tags}, @string{url}
FROM Comments
WHERE author = %string{username}
- |sql}]
+ |sql}
+ record_out]
;;
let post_comments =
@@ -46,7 +75,8 @@ module Query = struct
SELECT @int{id}, @string{content}, @string{date}, @string{tags}, @string{url}
FROM Comments
WHERE post_id = %int{post_id}
- |sql}]
+ |sql}
+ record_out]
;;
let comment_children =
@@ -56,11 +86,12 @@ module Query = struct
SELECT @int{id}, @string{content}, @string{date}, @string{tags}, @string{url}
FROM Comments
WHERE parent= %int{post_id}
- |sql}]
+ |sql}
+ record_out]
;;
end
-let get_poasts conn = Query.poast conn
+let get_poasts conn = Query.poasts conn
let get_poast post_id conn = Query.poast ~post_id conn
(* db.exec("PRAGMA journal_mode = WAL"); *)
diff --git a/litedb/router.ml b/litedb/router.ml
new file mode 100644
index 0000000..ef9d5c5
--- /dev/null
+++ b/litedb/router.ml
@@ -0,0 +1,73 @@
+(* 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.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 =
+ (* 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)
+
+(* Define all routes in the application *)
+let routes =
+ (* 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 "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 *)
+ ]
+;;
+
+(* 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
+
+(* Function to match an incoming request against our routes *)
+let match_route verb path =
+ (* 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
+;;
generated by cgit v1.2.3 (git 2.25.1) at 2025-08-15 16:13:00 +0000