From 645e815ebe11dbb86781c3eb645d3d67cd62cf7c Mon Sep 17 00:00:00 2001 From: polwex Date: Fri, 27 Jun 2025 16:34:09 +0700 Subject: nice nice. lsp still doesnt work tho --- lib/dune | 1 + lib/handler.ml | 232 +++++++++++++++++++------------------ lib/html.ml | 13 ++- lib/pages/BlogIndex.mlx | 76 ++++++++++++ lib/pages/BlogIndex.re | 11 -- lib/pages/components/Navbar.mlx | 34 ++++++ lib/pages/components/SiteTitle.mlx | 10 ++ lib/pages/dune | 4 + lib/pages/lmao.re | 40 +++++++ lib/post_handlers.ml | 185 +++++++++++++++++------------ lib/query.ml | 171 --------------------------- lib/router.ml | 4 +- lib/shared/dune | 8 ++ lib/shared/query.ml | 186 +++++++++++++++++++++++++++++ 14 files changed, 598 insertions(+), 377 deletions(-) create mode 100644 lib/pages/BlogIndex.mlx delete mode 100644 lib/pages/BlogIndex.re create mode 100644 lib/pages/components/Navbar.mlx create mode 100644 lib/pages/components/SiteTitle.mlx create mode 100644 lib/pages/lmao.re delete mode 100644 lib/query.ml create mode 100644 lib/shared/dune create mode 100644 lib/shared/query.ml (limited to 'lib') diff --git a/lib/dune b/lib/dune index a50de52..33e494f 100644 --- a/lib/dune +++ b/lib/dune @@ -2,6 +2,7 @@ (name lib) (libraries ; local + shared pages ; piaf diff --git a/lib/handler.ml b/lib/handler.ml index 3408184..16ada90 100644 --- a/lib/handler.ml +++ b/lib/handler.ml @@ -1,3 +1,4 @@ +open Shared open Piaf type pool = ((module Rapper_helper.CONNECTION), Caqti_error.t) Caqti_eio.Pool.t @@ -8,26 +9,27 @@ 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)) + (* 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 ;; @@ -35,24 +37,24 @@ let get_posts (db_pool : pool) (_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 - ] - 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)) + 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 ;; @@ -60,23 +62,23 @@ let get_post post_id (db_pool : pool) (_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 - ] - 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)) + 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 ;; @@ -84,26 +86,26 @@ let get_comment comment_id (db_pool : pool) (_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 comments -> - let json = - `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) - | Error err -> - Logs.err (fun m -> m "Database error: %a" Caqti_error.pp err); - Ok (Response.create `Internal_server_error)) + let comments_or_error = Query.Query.user_comments ~username conn in + match comments_or_error with + | Ok comments -> + let json = + `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) + | Error err -> + Logs.err (fun m -> m "Database error: %a" Caqti_error.pp err); + Ok (Response.create `Internal_server_error)) db_pool ;; @@ -111,26 +113,26 @@ let get_user_comments username (db_pool : pool) (_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 comments -> - let json = - `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) - | Error err -> - Logs.err (fun m -> m "Database error: %a" Caqti_error.pp err); - Ok (Response.create `Internal_server_error)) + let comments_or_error = Query.Query.post_comments ~post_id conn in + match comments_or_error with + | Ok comments -> + let json = + `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) + | Error err -> + Logs.err (fun m -> m "Database error: %a" Caqti_error.pp err); + Ok (Response.create `Internal_server_error)) db_pool ;; @@ -138,25 +140,25 @@ let get_post_comments post_id (db_pool : pool) (_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 comments -> - let json = - `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) - | Error err -> - Logs.err (fun m -> m "Database error: %a" Caqti_error.pp err); - Ok (Response.create `Internal_server_error)) + let comments_or_error = Query.Query.comment_children ~post_id:parent_id conn in + match comments_or_error with + | Ok comments -> + let json = + `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) + | 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/lib/html.ml b/lib/html.ml index db5ad51..35c7b42 100644 --- a/lib/html.ml +++ b/lib/html.ml @@ -1,6 +1,7 @@ open Piaf +open Shared -type pool = ((module Rapper_helper.CONNECTION), Caqti_error.t) Caqti_eio.Pool.t +type pool = (Query.conn, 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. *) @@ -33,7 +34,9 @@ let get_root (db_pool : pool) (request : Request.t) = db_pool ;; -let render page (db_pool : pool) (_request : Request.t) = +type paget = ?key:string -> Query.conn -> unit -> React.element + +let render_conn (page : paget) (db_pool : pool) (_request : Request.t) = (* Caqti_eio.Pool.use *) (* (fun conn -> *) (* let posts_or = Query.get_poasts () conn in *) @@ -44,6 +47,10 @@ let render page (db_pool : pool) (_request : Request.t) = (* | Ok _posts -> Ok (page |> ReactDOM.renderToString |> Http.send_raw_html)) *) (* db_pool *) Caqti_eio.Pool.use - (fun conn -> Ok (conn |> page |> ReactDOM.renderToString |> Http.send_raw_html)) + (fun conn -> Ok (page conn () |> ReactDOM.renderToString |> Http.send_raw_html)) db_pool ;; + +let render page (_db_pool : pool) (_request : Request.t) = + Ok (page |> ReactDOM.renderToString |> Http.send_raw_html) +;; diff --git a/lib/pages/BlogIndex.mlx b/lib/pages/BlogIndex.mlx new file mode 100644 index 0000000..3e036aa --- /dev/null +++ b/lib/pages/BlogIndex.mlx @@ -0,0 +1,76 @@ +open Shared + +let header ~title () =

title

+ +let page = + + +
(React.string "Some content goes here")
+ + +;; + +module Layout = struct + let[@react.component] make ~children = + + + (React.string "Bloody Shovel 5") + + + + children + + ;; +end + +module PostPreviews = struct + let[@react.component] make ~(conn : Query.conn) = + let posts = + match Query.get_poasts () conn with + | Error _err -> [] + | Ok posts -> posts + in + let tests = "This is 'a 'weird " in +
+ (match posts with + | [] -> React.string "No posts" + | posts -> + let ps = + posts + |> List.map (fun (p : Query.post_summary) -> + Logs.info (fun d -> d "poast %s\n" p.title); +

(React.string p.title)

) + in + let pp = React.string tests :: ps in + pp |> Array.of_list |> React.array) +
+ ;; +end + +let[@react.component] make (conn : Query.conn) = + +
+ +
+ +
+
+
+ +;; + +(* let[@react.component] make (conn : Query.conn) = *) +(* let posts = *) +(* match Query.get_poasts () conn with *) +(* | Error _err -> [] *) +(* | Ok posts -> posts *) +(* in *) +(*
*) +(* (match posts with *) +(* | [] -> React.string "No posts" *) +(* | hd :: _tl -> React.string hd.title) *) +(*
*) +(* ;; *) + +(* # formatter = {command = "ocamlformat-mlx", args = ["-", "--impl"]} *) +(* List.map (fun _p ->

(React.string "wtf")

) posts |> React.list *) diff --git a/lib/pages/BlogIndex.re b/lib/pages/BlogIndex.re deleted file mode 100644 index 50beaed..0000000 --- a/lib/pages/BlogIndex.re +++ /dev/null @@ -1,11 +0,0 @@ -[@react.component] -let make = () => { - - - - {React.string("Bloody Shovel 5")} - - // -

{React.string("Oh hai")}

- ; -}; diff --git a/lib/pages/components/Navbar.mlx b/lib/pages/components/Navbar.mlx new file mode 100644 index 0000000..68003fe --- /dev/null +++ b/lib/pages/components/Navbar.mlx @@ -0,0 +1,34 @@ +module Link = struct + let[@react.component] make ~children ~href ?(className = "") = + let base_class = "hover:text-gray-300 transition-colors" in + let clas = Printf.sprintf "%s %s" base_class className in + children + ;; +end + +let rs = React.string + +let[@react.component] make () = +
+
+ + + + +
+ (rs "SEARCH") + (rs "LOGIN") +
+
+
+;; diff --git a/lib/pages/components/SiteTitle.mlx b/lib/pages/components/SiteTitle.mlx new file mode 100644 index 0000000..cfee4f3 --- /dev/null +++ b/lib/pages/components/SiteTitle.mlx @@ -0,0 +1,10 @@ +let[@react.component] make () = +
+ +

+ (React.string "BLOODY SHOVEL 5") +

+ +

(React.string "Nemo nos Salvabit")

+
+;; diff --git a/lib/pages/dune b/lib/pages/dune index 8cc2720..8ec2184 100644 --- a/lib/pages/dune +++ b/lib/pages/dune @@ -3,6 +3,10 @@ (library (name pages) (libraries + ; local + shared + ; + logs lwt.unix server-reason-react.belt server-reason-react.js diff --git a/lib/pages/lmao.re b/lib/pages/lmao.re new file mode 100644 index 0000000..24c630e --- /dev/null +++ b/lib/pages/lmao.re @@ -0,0 +1,40 @@ +[@react.component] +let make = () => { + + + + + {React.string("Bloody Shovel 5")} + +

{React.string("Oh hai")}

+ ; + // let _lol = conn; + // let make = (~conn) => { +}; +// [@react.component] +// let make = (~conn: Query.conn) => { +// let posts = +// switch (Query.get_poasts(conn)) { +// | Ok(posts) => posts +// | Error(_) => [] +// }; + +// +// +// +// {React.string("Bloody Shovel 5")} +// +// +//

{React.string("Oh hai")}

+//
    +// {posts +// |> List.map(post => +//
  • +// {React.string(post.title)} +//
    • +// ) +// |> React.array} +//
+// +// ; +// }; diff --git a/lib/post_handlers.ml b/lib/post_handlers.ml index 2035792..dc0f43b 100644 --- a/lib/post_handlers.ml +++ b/lib/post_handlers.ml @@ -1,4 +1,5 @@ open Piaf +open Shared type pool = ((module Rapper_helper.CONNECTION), Caqti_error.t) Caqti_eio.Pool.t @@ -8,32 +9,47 @@ type pool = ((module Rapper_helper.CONNECTION), Caqti_error.t) Caqti_eio.Pool.t let create_post (db_pool : pool) (request : Request.t) = Caqti_eio.Pool.use (fun conn -> - (* Parse JSON body *) - match Body.to_string request.body with - | Error _ -> Ok (Response.create `Bad_request) - | Ok body_str -> - try - let json = Yojson.Safe.from_string body_str in - let open Yojson.Safe.Util in - let title = json |> member "title" |> to_string in - let content = json |> member "content" |> to_string in - let tags = json |> member "tags" |> to_string_option |> Option.value ~default:"" in - let url = json |> member "url" |> to_string_option |> Option.value ~default:"" in - let date = Unix.time () |> Unix.gmtime |> fun tm -> - Printf.sprintf "%04d-%02d-%02d %02d:%02d:%02d" - (tm.tm_year + 1900) (tm.tm_mon + 1) tm.tm_mday - tm.tm_hour tm.tm_min tm.tm_sec in - (* Insert the post *) - match Query.create_post ~title ~content ~date ~tags ~url conn with - | Ok () -> - let response_json = `Assoc ["message", `String "Post created successfully"] in - Ok (Response.of_string ~body:(Yojson.Safe.to_string response_json) `Created) - | Error err -> - Logs.err (fun m -> m "Database error: %a" Caqti_error.pp err); - Ok (Response.create `Internal_server_error) - with - | Yojson.Json_error _ -> Ok (Response.create `Bad_request) - | _ -> Ok (Response.create `Bad_request)) + (* Parse JSON body *) + match Body.to_string request.body with + | Error _ -> Ok (Response.create `Bad_request) + | Ok body_str -> + (try + let json = Yojson.Safe.from_string body_str in + let open Yojson.Safe.Util in + let title = json |> member "title" |> to_string in + let content = json |> member "content" |> to_string in + let tags = + json |> member "tags" |> to_string_option |> Option.value ~default:"" + in + let url = + json |> member "url" |> to_string_option |> Option.value ~default:"" + in + let date = + Unix.time () + |> Unix.gmtime + |> fun tm -> + Printf.sprintf + "%04d-%02d-%02d %02d:%02d:%02d" + (tm.tm_year + 1900) + (tm.tm_mon + 1) + tm.tm_mday + tm.tm_hour + tm.tm_min + tm.tm_sec + in + (* Insert the post *) + match Query.create_post ~title ~content ~date ~tags ~url conn with + | Ok () -> + let response_json = + `Assoc [ "message", `String "Post created successfully" ] + in + Ok (Response.of_string ~body:(Yojson.Safe.to_string response_json) `Created) + | Error err -> + Logs.err (fun m -> m "Database error: %a" Caqti_error.pp err); + Ok (Response.create `Internal_server_error) + with + | Yojson.Json_error _ -> Ok (Response.create `Bad_request) + | _ -> Ok (Response.create `Bad_request))) db_pool ;; @@ -41,33 +57,50 @@ let create_post (db_pool : pool) (request : Request.t) = let create_comment (db_pool : pool) (request : Request.t) = Caqti_eio.Pool.use (fun conn -> - match Body.to_string request.body with - | Error _ -> Ok (Response.create `Bad_request) - | Ok body_str -> - try - let json = Yojson.Safe.from_string body_str in - let open Yojson.Safe.Util in - let content = json |> member "content" |> to_string in - let post_id = json |> member "post_id" |> to_int in - let parent = json |> member "parent" |> to_int_option in - let author = json |> member "author" |> to_string in - let tags = json |> member "tags" |> to_string_option |> Option.value ~default:"" in - let url = json |> member "url" |> to_string_option |> Option.value ~default:"" in - let date = Unix.time () |> Unix.gmtime |> fun tm -> - Printf.sprintf "%04d-%02d-%02d %02d:%02d:%02d" - (tm.tm_year + 1900) (tm.tm_mon + 1) tm.tm_mday - tm.tm_hour tm.tm_min tm.tm_sec in - (* Insert the comment *) - match Query.create_comment ~content ~date ~tags ~url ~post_id ?parent ~author conn with - | Ok () -> - let response_json = `Assoc ["message", `String "Comment created successfully"] in - Ok (Response.of_string ~body:(Yojson.Safe.to_string response_json) `Created) - | Error err -> - Logs.err (fun m -> m "Database error: %a" Caqti_error.pp err); - Ok (Response.create `Internal_server_error) - with - | Yojson.Json_error _ -> Ok (Response.create `Bad_request) - | _ -> Ok (Response.create `Bad_request)) + match Body.to_string request.body with + | Error _ -> Ok (Response.create `Bad_request) + | Ok body_str -> + (try + let json = Yojson.Safe.from_string body_str in + let open Yojson.Safe.Util in + let content = json |> member "content" |> to_string in + let post_id = json |> member "post_id" |> to_int in + let parent = json |> member "parent" |> to_int_option in + let author = json |> member "author" |> to_string in + let tags = + json |> member "tags" |> to_string_option |> Option.value ~default:"" + in + let url = + json |> member "url" |> to_string_option |> Option.value ~default:"" + in + let date = + Unix.time () + |> Unix.gmtime + |> fun tm -> + Printf.sprintf + "%04d-%02d-%02d %02d:%02d:%02d" + (tm.tm_year + 1900) + (tm.tm_mon + 1) + tm.tm_mday + tm.tm_hour + tm.tm_min + tm.tm_sec + in + (* Insert the comment *) + match + Query.create_comment ~content ~date ~tags ~url ~post_id ?parent ~author conn + with + | Ok () -> + let response_json = + `Assoc [ "message", `String "Comment created successfully" ] + in + Ok (Response.of_string ~body:(Yojson.Safe.to_string response_json) `Created) + | Error err -> + Logs.err (fun m -> m "Database error: %a" Caqti_error.pp err); + Ok (Response.create `Internal_server_error) + with + | Yojson.Json_error _ -> Ok (Response.create `Bad_request) + | _ -> Ok (Response.create `Bad_request))) db_pool ;; @@ -75,26 +108,28 @@ let create_comment (db_pool : pool) (request : Request.t) = let create_vote (db_pool : pool) (request : Request.t) = Caqti_eio.Pool.use (fun conn -> - match Body.to_string request.body with - | Error _ -> Ok (Response.create `Bad_request) - | Ok body_str -> - try - let json = Yojson.Safe.from_string body_str in - let open Yojson.Safe.Util in - let user_id = json |> member "user_id" |> to_string in - let vote_type = json |> member "vote_type" |> to_string in - let post_id = json |> member "post_id" |> to_int_option in - let comment_id = json |> member "comment_id" |> to_int_option in - (* Insert the vote *) - match Query.create_vote ~user_id ~vote_type ?post_id ?comment_id conn with - | Ok () -> - let response_json = `Assoc ["message", `String "Vote created successfully"] in - Ok (Response.of_string ~body:(Yojson.Safe.to_string response_json) `Created) - | Error err -> - Logs.err (fun m -> m "Database error: %a" Caqti_error.pp err); - Ok (Response.create `Internal_server_error) - with - | Yojson.Json_error _ -> Ok (Response.create `Bad_request) - | _ -> Ok (Response.create `Bad_request)) + match Body.to_string request.body with + | Error _ -> Ok (Response.create `Bad_request) + | Ok body_str -> + (try + let json = Yojson.Safe.from_string body_str in + let open Yojson.Safe.Util in + let user_id = json |> member "user_id" |> to_string in + let vote_type = json |> member "vote_type" |> to_string in + let post_id = json |> member "post_id" |> to_int_option in + let comment_id = json |> member "comment_id" |> to_int_option in + (* Insert the vote *) + match Query.create_vote ~user_id ~vote_type ?post_id ?comment_id conn with + | Ok () -> + let response_json = + `Assoc [ "message", `String "Vote created successfully" ] + in + Ok (Response.of_string ~body:(Yojson.Safe.to_string response_json) `Created) + | Error err -> + Logs.err (fun m -> m "Database error: %a" Caqti_error.pp err); + Ok (Response.create `Internal_server_error) + with + | Yojson.Json_error _ -> Ok (Response.create `Bad_request) + | _ -> Ok (Response.create `Bad_request))) db_pool -;; \ No newline at end of file +;; diff --git a/lib/query.ml b/lib/query.ml deleted file mode 100644 index 179deb6..0000000 --- a/lib/query.ml +++ /dev/null @@ -1,171 +0,0 @@ -(* 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 - get_many - {sql| - SELECT @int{id}, @string{title}, @string{content}, @string{date} - FROM Posts - ORDER BY id DESC LIMIT 100 - |sql} - record_out] - ;; - - let poast = - [%rapper - get_opt - {sql| - SELECT @int{id}, @string{title}, @string{content}, @string{date}, @string{tags}, @string{url} - FROM Posts - WHERE id = %int{post_id} - |sql} - record_out] - ;; - - let comment = - [%rapper - get_opt - {sql| - SELECT @int{id}, @string{content}, @string{date}, @string{tags}, @string{url} - FROM Comments - WHERE id = %int{id} - |sql} - record_out] - ;; - - let user_comments = - [%rapper - get_many - {sql| - SELECT @int{id}, @string{content}, @string{date}, @string{tags}, @string{url} - FROM Comments - WHERE author = %string{username} - |sql} - record_out] - ;; - - let post_comments = - [%rapper - get_many - {sql| - SELECT @int{id}, @string{content}, @string{date}, @string{tags}, @string{url} - FROM Comments - WHERE post_id = %int{post_id} - |sql} - record_out] - ;; - - let comment_children = - [%rapper - get_many - {sql| - SELECT @int{id}, @string{content}, @string{date}, @string{tags}, @string{url} - FROM Comments - WHERE parent= %int{post_id} - |sql} - record_out] - ;; - - (* Insert queries *) - let insert_post = - [%rapper - execute - {sql| - INSERT INTO Posts (title, content, date, tags, url) - VALUES (%string{title}, %string{content}, %string{date}, %string{tags}, %string{url}) - |sql}] - ;; - - let insert_comment = - [%rapper - execute - {sql| - INSERT INTO Comments (content, date, tags, url, post_id, parent, author) - VALUES (%string{content}, %string{date}, %string{tags}, %string{url}, %int{post_id}, %int?{parent}, %string{author}) - |sql}] - ;; - - let insert_vote = - [%rapper - execute - {sql| - INSERT INTO Votes (post_id, comment_id, user_id, vote_type) - VALUES (%int?{post_id}, %int?{comment_id}, %string{user_id}, %string{vote_type}) - |sql}] - ;; -end - -let get_poasts conn = Query.poasts conn -let get_poast post_id conn = Query.poast ~post_id conn - -(* Insert functions *) -let create_post ~title ~content ~date ~tags ~url conn = - Query.insert_post ~title ~content ~date ~tags ~url conn - -let create_comment ~content ~date ~tags ~url ~post_id ?parent ~author conn = - Query.insert_comment ~content ~date ~tags ~url ~post_id ~parent ~author conn - -let create_vote ~user_id ~vote_type ?post_id ?comment_id conn = - Query.insert_vote ~post_id ~comment_id ~user_id ~vote_type conn - -(* 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"; -] - -(* Example of how to execute raw SQL with Caqti *) -let init_connection conn = - let module C = (val conn : Rapper_helper.CONNECTION) in - (* For PRAGMA commands, we don't know the return type, so use a custom approach *) - (* Some return strings, some return ints, some return nothing *) - let exec_pragma sql = - let open Caqti_request.Infix in - let open Caqti_type in - (* Try to execute as a simple exec first (for pragmas that return nothing) *) - match C.exec ((unit ->. unit) sql) () with - | Ok () -> Ok () - | Error _ -> - (* If that fails, try as a query that returns a string *) - match C.find_opt ((unit ->? string) sql) () with - | Ok _ -> Ok () - | Error _ -> - (* If that also fails, try as a query that returns an int *) - match C.find_opt ((unit ->? int) sql) () with - | Ok _ -> Ok () - | Error e -> Error e - in - (* Execute each pragma *) - List.fold_left (fun acc sql -> - match acc with - | Error e -> Error e - | Ok () -> exec_pragma sql - ) (Ok ()) sqlite_pragmas diff --git a/lib/router.ml b/lib/router.ml index 4e05da7..8649e5f 100644 --- a/lib/router.ml +++ b/lib/router.ml @@ -56,7 +56,8 @@ let routes = (* bs5 routes *) (* root *) - ; `GET, nil @--> Html.render @@ Pages.BlogIndex.make () + (* ; `GET, nil @--> Html.render @@ Pages.BlogIndex.make () *) + ; `GET, nil @--> Html.render_conn @@ Pages.BlogIndex.make ; `GET, (s "l" /? nil) @--> Html.get_root ] ;; @@ -64,7 +65,6 @@ 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 lol = Html.render @@ Pages.BlogIndex.make () (* Function to match an incoming request against our routes *) let match_route verb path = diff --git a/lib/shared/dune b/lib/shared/dune new file mode 100644 index 0000000..12bfe80 --- /dev/null +++ b/lib/shared/dune @@ -0,0 +1,8 @@ +(library + (name shared) + (libraries + caqti + caqti-eio + ppx_rapper_eio) + (preprocess + (pps ppx_rapper))) \ No newline at end of file diff --git a/lib/shared/query.ml b/lib/shared/query.ml new file mode 100644 index 0000000..bd1f11c --- /dev/null +++ b/lib/shared/query.ml @@ -0,0 +1,186 @@ +open Rapper_helper + +type conn = (module CONNECTION) +type pool = ((module CONNECTION), Caqti_error.t) Caqti_eio.Pool.t +type 'a result_promise = ('a, Caqti_error.t) result Eio.Promise.t + +(* 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 + get_many + {sql| + SELECT @int{id}, @string{title}, @string{content}, @string{date} + FROM Posts + ORDER BY id DESC LIMIT 100 + |sql} + record_out] + ;; + + let poast = + [%rapper + get_opt + {sql| + SELECT @int{id}, @string{title}, @string{content}, @string{date}, @string{tags}, @string{url} + FROM Posts + WHERE id = %int{post_id} + |sql} + record_out] + ;; + + let comment = + [%rapper + get_opt + {sql| + SELECT @int{id}, @string{content}, @string{date}, @string{tags}, @string{url} + FROM Comments + WHERE id = %int{id} + |sql} + record_out] + ;; + + let user_comments = + [%rapper + get_many + {sql| + SELECT @int{id}, @string{content}, @string{date}, @string{tags}, @string{url} + FROM Comments + WHERE author = %string{username} + |sql} + record_out] + ;; + + let post_comments = + [%rapper + get_many + {sql| + SELECT @int{id}, @string{content}, @string{date}, @string{tags}, @string{url} + FROM Comments + WHERE post_id = %int{post_id} + |sql} + record_out] + ;; + + let comment_children = + [%rapper + get_many + {sql| + SELECT @int{id}, @string{content}, @string{date}, @string{tags}, @string{url} + FROM Comments + WHERE parent= %int{post_id} + |sql} + record_out] + ;; + + (* Insert queries *) + let insert_post = + [%rapper + execute + {sql| + INSERT INTO Posts (title, content, date, tags, url) + VALUES (%string{title}, %string{content}, %string{date}, %string{tags}, %string{url}) + |sql}] + ;; + + let insert_comment = + [%rapper + execute + {sql| + INSERT INTO Comments (content, date, tags, url, post_id, parent, author) + VALUES (%string{content}, %string{date}, %string{tags}, %string{url}, %int{post_id}, %int?{parent}, %string{author}) + |sql}] + ;; + + let insert_vote = + [%rapper + execute + {sql| + INSERT INTO Votes (post_id, comment_id, user_id, vote_type) + VALUES (%int?{post_id}, %int?{comment_id}, %string{user_id}, %string{vote_type}) + |sql}] + ;; +end + +(* let get_poasts pool = Caqti_eio.Pool.use (Query.poasts ()) pool *) + +let get_poasts conn = Query.poasts conn +let get_poast post_id conn = Query.poast ~post_id conn + +(* Insert functions *) +let create_post ~title ~content ~date ~tags ~url conn = + Query.insert_post ~title ~content ~date ~tags ~url conn +;; + +let create_comment ~content ~date ~tags ~url ~post_id ?parent ~author conn = + Query.insert_comment ~content ~date ~tags ~url ~post_id ~parent ~author conn +;; + +let create_vote ~user_id ~vote_type ?post_id ?comment_id conn = + Query.insert_vote ~post_id ~comment_id ~user_id ~vote_type conn +;; + +(* 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" + ] +;; + +(* Example of how to execute raw SQL with Caqti *) +let init_connection conn = + let module C = (val conn : Rapper_helper.CONNECTION) in + (* For PRAGMA commands, we don't know the return type, so use a custom approach *) + (* Some return strings, some return ints, some return nothing *) + let exec_pragma sql = + let open Caqti_request.Infix in + let open Caqti_type in + (* Try to execute as a simple exec first (for pragmas that return nothing) *) + match C.exec ((unit ->. unit) sql) () with + | Ok () -> Ok () + | Error _ -> + (* If that fails, try as a query that returns a string *) + (match C.find_opt ((unit ->? string) sql) () with + | Ok _ -> Ok () + | Error _ -> + (* If that also fails, try as a query that returns an int *) + (match C.find_opt ((unit ->? int) sql) () with + | Ok _ -> Ok () + | Error e -> Error e)) + in + (* Execute each pragma *) + List.fold_left + (fun acc sql -> + match acc with + | Error e -> Error e + | Ok () -> exec_pragma sql) + (Ok ()) + sqlite_pragmas +;; -- cgit v1.2.3