diff options
| -rw-r--r-- | CLAUDE.md | 25 | ||||
| -rw-r--r-- | NOTES.md | 23 | ||||
| -rw-r--r-- | bin/mainlite.ml | 2 | ||||
| -rw-r--r-- | lib/dune | 9 | ||||
| -rw-r--r-- | litedb/handler.ml | 159 | ||||
| -rw-r--r-- | litedb/query.ml | 45 | ||||
| -rw-r--r-- | litedb/router.ml | 73 | ||||
| -rw-r--r-- | profile.dump | 0 |
8 files changed, 327 insertions, 9 deletions
diff --git a/CLAUDE.md b/CLAUDE.md new file mode 100644 index 0000000..b849fa7 --- /dev/null +++ b/CLAUDE.md @@ -0,0 +1,25 @@ +# OCaml Routes Library DSL + +## The `@-->` Operator + +The `@-->` operator is from the `routes` library and is used to bind route patterns to handler functions. + +### Example: +```ocaml +`GET, (s "posts" /? nil) @--> Handler.get_posts +``` + +### Breaking it down: +- `s "posts"` - matches the string "posts" in the URL path +- `/?` - path concatenation operator +- `nil` - end of path (no more segments) +- `@-->` - "maps to" operator that binds the route to the handler + +So `(s "posts" /? nil) @--> Handler.get_posts` means "the route `/posts` maps to the `Handler.get_posts` function". + +### Other common operators in the routes library: +- `/:` for path parameters (e.g., `s "user" /: int /? nil` matches `/user/123`) +- `//` for wildcard paths +- `<$>` for transforming matched values + +It's a DSL (domain-specific language) for expressing routes in a concise, type-safe way.
\ No newline at end of file diff --git a/NOTES.md b/NOTES.md new file mode 100644 index 0000000..0fd67b5 --- /dev/null +++ b/NOTES.md @@ -0,0 +1,23 @@ +apparently janestreet style is to use double semicolons + +# Cline's Notes + +## Objective: Fix the `litedb` build + +The user is experiencing a build failure with the `litedb` library. The error message "The module Litedb.Router is an alias for module Litedb__Router, which is missing" indicates a problem with how `dune` is resolving the modules within the library. + +### What I've tried: + +1. **Adding `(modules ...)` to `litedb/dune`:** This was incorrect, as the `lib` directory works without it. +2. **Creating `litedb/litedb.ml`:** This was also incorrect, as the `lib` directory doesn't have a main module file. +3. **Modifying `bin/mainlite.ml`:** I've tried various ways of referencing the `Litedb` modules, but the error persists. + +### What I've learned: + +* The `lib` and `litedb` directories have nearly identical `dune` files. +* The `lib` directory works correctly without a main module file or an explicit `(modules ...)` stanza. +* The error is specific to the `litedb` library. + +### Next Steps: + +I need to re-evaluate my understanding of how `dune` resolves modules. I will now try to run the application again, but this time I will pay close attention to the build output to see if there are any other clues that I've missed. diff --git a/bin/mainlite.ml b/bin/mainlite.ml index 3fd7e0f..42b0009 100644 --- a/bin/mainlite.ml +++ b/bin/mainlite.ml @@ -9,7 +9,7 @@ let setup_log ?style_renderer level = ;; let request_handler ~db_pool Server.{ request; _ } = - match Combattant.Router.match_route request.meth request.target with + match Litedb.Router.match_route request.meth request.target with | Some handler -> Result.get_ok @@ handler db_pool request | None -> Logs.info (fun d -> d "Não encontrei %S\n" request.target); @@ -1,5 +1,12 @@ (library (name combattant) - (libraries piaf routes yojson caqti caqti-driver-postgresql caqti-eio ppx_rapper_eio) + (libraries + piaf + routes + yojson + caqti + caqti-driver-postgresql + caqti-eio + ppx_rapper_eio) (preprocess (pps ppx_rapper))) 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 +;; diff --git a/profile.dump b/profile.dump new file mode 100644 index 0000000..e69de29 --- /dev/null +++ b/profile.dump |