summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--bin/mainlite.ml13
-rw-r--r--litedb/handler.ml113
-rw-r--r--litedb/query.ml21
-rw-r--r--litedb/router.ml9
4 files changed, 88 insertions, 68 deletions
diff --git a/bin/mainlite.ml b/bin/mainlite.ml
index 42b0009..f288891 100644
--- a/bin/mainlite.ml
+++ b/bin/mainlite.ml
@@ -31,6 +31,19 @@ let () =
let db_uri =
Uri.make ~scheme:"sqlite3" ~path:"/home/y/code/ocaml/combattant/bulkdata/blog.db" ()
in
+ (* Create connection pool with initialization function *)
+ (* let connect_pool ~sw ~stdenv uri =
+ Caqti_eio_unix.connect_pool
+ ~sw
+ ~stdenv
+ ~post_connect:(fun conn ->
+ (* Initialize each connection with SQLite performance pragmas *)
+ match Query.init_connection conn with
+ | Ok () -> Ok ()
+ | Error err -> Error err)
+ uri
+ in
+ match connect_pool ~sw ~stdenv:(env :> Caqti_eio.stdenv) db_uri with *)
match Caqti_eio_unix.connect_pool ~sw ~stdenv:(env :> Caqti_eio.stdenv) db_uri with
| Ok pool ->
let server = Server.create ~config (request_handler ~db_pool:pool) in
diff --git a/litedb/handler.ml b/litedb/handler.ml
index dd9251f..3408184 100644
--- a/litedb/handler.ml
+++ b/litedb/handler.ml
@@ -32,25 +32,24 @@ let get_posts (db_pool : pool) (_request : Request.t) =
;;
(* Handler for GET /posts/:id - gets a single post by ID *)
-let get_post (db_pool : pool) post_id (_request : Request.t) =
+let get_post post_id (db_pool : pool) (_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
- ]
+ `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)
+ | 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))
@@ -58,24 +57,23 @@ let get_post (db_pool : pool) post_id (_request : Request.t) =
;;
(* Handler for GET /comments/:id - gets a single comment by ID *)
-let get_comment (db_pool : pool) comment_id (_request : Request.t) =
+let get_comment comment_id (db_pool : pool) (_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
- ]
+ `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)
+ | 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))
@@ -83,25 +81,26 @@ let get_comment (db_pool : pool) comment_id (_request : Request.t) =
;;
(* Handler for GET /users/:username/comments - gets comments by a user *)
-let get_user_comments (db_pool : pool) username (_request : Request.t) =
+let get_user_comments username (db_pool : pool) (_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) ->
+ | Ok comments ->
let json =
- `Assoc [
- "id", `Int comment.id;
- "content", `String comment.content;
- "date", `String comment.date;
- "tags", `String comment.tags;
- "url", `String comment.url
- ]
+ `List
+ (List.map
+ (fun (comment : Query.comment) ->
+ `Assoc
+ [ "id", `Int comment.id
+ ; "content", `String comment.content
+ ; "date", `String comment.date
+ ; "tags", `String comment.tags
+ ; "url", `String comment.url
+ ])
+ comments)
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))
@@ -109,24 +108,26 @@ let get_user_comments (db_pool : pool) username (_request : Request.t) =
;;
(* Handler for GET /posts/:id/comments - gets comments for a post *)
-let get_post_comments (db_pool : pool) post_id (_request : Request.t) =
+let get_post_comments post_id (db_pool : pool) (_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) ->
+ | Ok comments ->
let json =
- `Assoc [
- "id", `Int comment.id;
- "content", `String comment.content;
- "date", `String comment.date;
- "tags", `String comment.tags;
- "url", `String comment.url
- ]
+ `List
+ (List.map
+ (fun (comment : Query.comment) ->
+ `Assoc
+ [ "id", `Int comment.id
+ ; "content", `String comment.content
+ ; "date", `String comment.date
+ ; "tags", `String comment.tags
+ ; "url", `String comment.url
+ ])
+ comments)
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))
@@ -134,24 +135,26 @@ let get_post_comments (db_pool : pool) post_id (_request : Request.t) =
;;
(* Handler for GET /comments/:id/children - gets child comments *)
-let get_comment_children (db_pool : pool) parent_id (_request : Request.t) =
+let get_comment_children parent_id (db_pool : pool) (_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) ->
+ | Ok comments ->
let json =
- `Assoc [
- "id", `Int comment.id;
- "content", `String comment.content;
- "date", `String comment.date;
- "tags", `String comment.tags;
- "url", `String comment.url
- ]
+ `List
+ (List.map
+ (fun (comment : Query.comment) ->
+ `Assoc
+ [ "id", `Int comment.id
+ ; "content", `String comment.content
+ ; "date", `String comment.date
+ ; "tags", `String comment.tags
+ ; "url", `String comment.url
+ ])
+ comments)
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))
diff --git a/litedb/query.ml b/litedb/query.ml
index 536347c..61616b4 100644
--- a/litedb/query.ml
+++ b/litedb/query.ml
@@ -59,7 +59,7 @@ module Query = struct
let user_comments =
[%rapper
- get_opt
+ get_many
{sql|
SELECT @int{id}, @string{content}, @string{date}, @string{tags}, @string{url}
FROM Comments
@@ -70,7 +70,7 @@ module Query = struct
let post_comments =
[%rapper
- get_opt
+ get_many
{sql|
SELECT @int{id}, @string{content}, @string{date}, @string{tags}, @string{url}
FROM Comments
@@ -81,7 +81,7 @@ module Query = struct
let comment_children =
[%rapper
- get_opt
+ get_many
{sql|
SELECT @int{id}, @string{content}, @string{date}, @string{tags}, @string{url}
FROM Comments
@@ -94,9 +94,12 @@ end
let get_poasts conn = Query.poasts conn
let get_poast post_id conn = Query.poast ~post_id conn
-(* db.exec("PRAGMA journal_mode = WAL"); *)
-(* db.exec("PRAGMA foreign_keys = ON"); *)
-(* db.exec("PRAGMA cache_size = -8000"); // 8MB cache *)
-(* db.exec("PRAGMA temp_store = MEMORY"); *)
-(* db.exec("PRAGMA synchronous = NORMAL"); *)
-(* db.exec("PRAGMA mmap_size = 30000000000"); // 30GB memory map *)
+(* SQLite performance pragmas - to be implemented *)
+let sqlite_pragmas = [
+ "PRAGMA journal_mode = WAL";
+ "PRAGMA foreign_keys = ON";
+ "PRAGMA cache_size = -8000";
+ "PRAGMA temp_store = MEMORY";
+ "PRAGMA synchronous = NORMAL";
+ "PRAGMA mmap_size = 30000000000";
+]
diff --git a/litedb/router.ml b/litedb/router.ml
index ef9d5c5..06dec3c 100644
--- a/litedb/router.ml
+++ b/litedb/router.ml
@@ -1,7 +1,9 @@
(* 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
@@ -25,9 +27,8 @@ module R = Map.Make (struct
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 *)
+ (* 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
@@ -41,7 +42,7 @@ let routes =
(* / 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
+ ; `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 *)
generated by cgit v1.2.3 (git 2.25.1) at 2025-08-15 12:54:50 +0000