m

14 files changed, 312 insertions, 136 deletions

diff --git a/.envrc b/.envrc
index 3550a30..10307d6 100644
--- a/.envrc
+++ b/.envrc
@@ -1 +1,2 @@
+# use flake . --impure
 use flake
diff --git a/CLAUDE.md b/CLAUDE.md
index b849fa7..8c6cf38 100644
--- a/CLAUDE.md
+++ b/CLAUDE.md
@@ -1,15 +1,23 @@
-# OCaml Routes Library DSL
+# OCaml SSR React APP on Eio
 
-## The `@-->` Operator
+This app is a WIP to implement a blog as a React webapp (using reason-react) using Ocaml, Piaf for HTTP handling, Caqti to handle database queries, using Eio across the app for async.
+
+
+
+## Things to take into account
+
+### Ocaml Routes library
+
+#### The `@-->` Operator
 
 The `@-->` operator is from the `routes` library and is used to bind route patterns to handler functions.
 
-### Example:
+##### Example:
 ```ocaml
 `GET, (s "posts" /? nil) @--> Handler.get_posts
 ```
 
-### Breaking it down:
+##### Breaking it down:
 - `s "posts"` - matches the string "posts" in the URL path
 - `/?` - path concatenation operator 
 - `nil` - end of path (no more segments)
@@ -17,9 +25,9 @@ The `@-->` operator is from the `routes` library and is used to bind route patte
 
 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:
+##### 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
+It's a DSL (domain-specific language) for expressing routes in a concise, type-safe way.
diff --git a/bin/server.ml b/bin/server.ml
index b5cdd84..d640095 100644
--- a/bin/server.ml
+++ b/bin/server.ml
@@ -10,7 +10,12 @@ let setup_log ?style_renderer level =
 
 let request_handler ~db_pool Server.{ request; _ } =
   match Lib.Router.match_route request.meth request.target with
-  | Some handler -> Result.get_ok @@ handler db_pool request
+  | Some handler ->
+    (match handler db_pool request with
+     | Ok response -> response
+     | Error err ->
+       Logs.err (fun m -> m "Handler error: %a" Caqti_error.pp err);
+       Response.create `Internal_server_error)
   | None ->
     Logs.info (fun d -> d "the fuck %S\n" request.target);
     Response.create `Not_found
@@ -31,9 +36,11 @@ let () =
   let db_uri =
     Uri.make ~scheme:"sqlite3" ~path:"/home/y/code/ocaml/bs5/bulkdata/blog.db" ()
   in
+  let pool_config = Caqti_pool_config.create ~max_size:10 () in
   (* Create connection pool with initialization function *)
   let connect_pool ~sw ~stdenv uri =
     Caqti_eio_unix.connect_pool
+      ~pool_config
       ~sw
       ~stdenv
       ~post_connect:(fun conn ->
diff --git a/flake.lock b/flake.lock
index ed1eb1b..9e85e72 100644
--- a/flake.lock
+++ b/flake.lock
@@ -18,35 +18,34 @@
         "type": "github"
       }
     },
-    "flake-utils_2": {
-      "inputs": {
-        "systems": "systems_2"
-      },
+    "nixpkgs": {
       "locked": {
-        "lastModified": 1705309234,
-        "narHash": "sha256-uNRRNRKmJyCRC/8y1RqBkqWBLM034y4qN7EprSdmgyA=",
-        "owner": "numtide",
-        "repo": "flake-utils",
-        "rev": "1ef2e671c3b0c19053962c07dbda38332dcebf26",
+        "lastModified": 1750865895,
+        "narHash": "sha256-p2dWAQcLVzquy9LxYCZPwyUdugw78Qv3ChvnX755qHA=",
+        "owner": "nixos",
+        "repo": "nixpkgs",
+        "rev": "61c0f513911459945e2cb8bf333dc849f1b976ff",
         "type": "github"
       },
       "original": {
-        "owner": "numtide",
-        "repo": "flake-utils",
+        "owner": "nixos",
+        "ref": "nixpkgs-unstable",
+        "repo": "nixpkgs",
         "type": "github"
       }
     },
-    "nixpkgs": {
+    "ocaml": {
       "inputs": {
-        "flake-utils": "flake-utils_2",
-        "nixpkgs": "nixpkgs_2"
+        "nixpkgs": [
+          "nixpkgs"
+        ]
       },
       "locked": {
-        "lastModified": 1705609824,
-        "narHash": "sha256-ARrxzdKiiMsAs2zQzxe+XkxTo/eg1FpmvWhFoDgYB/A=",
+        "lastModified": 1750750851,
+        "narHash": "sha256-xNAoEaLXs5cQlvYj9+baCgu54Fg1CrVqEXkXhRLLdfs=",
         "owner": "nix-ocaml",
         "repo": "nix-overlays",
-        "rev": "0477e3c5a2c05351707a3e36c462aef4c78f769f",
+        "rev": "d042ec68f4386d8ee47456335b910eae850dc059",
         "type": "github"
       },
       "original": {
@@ -55,26 +54,11 @@
         "type": "github"
       }
     },
-    "nixpkgs_2": {
-      "locked": {
-        "lastModified": 1705429789,
-        "narHash": "sha256-7gQju9WiToi7wI6oahTXiqwJu2RZoV0cg8OGa9YhEvw=",
-        "owner": "NixOS",
-        "repo": "nixpkgs",
-        "rev": "cc3ab0e45687d15cb21663a95f5a53a05abd39e4",
-        "type": "github"
-      },
-      "original": {
-        "owner": "NixOS",
-        "repo": "nixpkgs",
-        "rev": "cc3ab0e45687d15cb21663a95f5a53a05abd39e4",
-        "type": "github"
-      }
-    },
     "root": {
       "inputs": {
         "flake-utils": "flake-utils",
-        "nixpkgs": "nixpkgs"
+        "nixpkgs": "nixpkgs",
+        "ocaml": "ocaml"
       }
     },
     "systems": {
@@ -91,21 +75,6 @@
         "repo": "default",
         "type": "github"
       }
-    },
-    "systems_2": {
-      "locked": {
-        "lastModified": 1681028828,
-        "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=",
-        "owner": "nix-systems",
-        "repo": "default",
-        "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e",
-        "type": "github"
-      },
-      "original": {
-        "owner": "nix-systems",
-        "repo": "default",
-        "type": "github"
-      }
     }
   },
   "root": "root",
diff --git a/flake.nix b/flake.nix
index 899547c..3b14a24 100644
--- a/flake.nix
+++ b/flake.nix
@@ -1,34 +1,86 @@
 {
   inputs = {
     flake-utils.url = "github:numtide/flake-utils";
-    nixpkgs.url = "github:nix-ocaml/nix-overlays";
+    nixpkgs.url = "github:nixos/nixpkgs/nixpkgs-unstable";
+    ocaml.url = "github:nix-ocaml/nix-overlays";
+    ocaml.inputs.nixpkgs.follows = "nixpkgs";
   };
 
   outputs = {
     self,
     nixpkgs,
+    ocaml,
     flake-utils,
   }:
     flake-utils.lib.eachDefaultSystem (system: let
-      pkgs = nixpkgs.legacyPackages.${system}.appendOverlays [
-        (self: super: {
-          ocamlPackages =
-            super.ocaml-ng.ocamlPackages_5_1.overrideScope'
-            (oself: osuper: {
-              pg_query = osuper.pg_query.overrideAttrs (prev: {
-                propagatedBuildInputs =
-                  prev.propagatedBuildInputs
-                  ++ [osuper.cmdliner];
-              });
-            });
-        })
-      ];
+      pkgs = import nixpkgs {
+        inherit system;
 
-      combattant = pkgs.ocamlPackages.buildDunePackage {
-        pname = "combattant";
-        version = "0.0.1";
-        src = ./.;
-        buildInputs = with pkgs.ocamlPackages; [
+        overlays = [ocaml.overlays.default];
+      };
+
+      quickjs = pkgs.ocamlPackages.buildDunePackage {
+        name = "quickjs";
+        pname = "quickjs";
+        version = "0.1.2";
+        src = pkgs.fetchFromGitHub {
+          fetchSubmodules = true;
+          owner = "ml-in-barcelona";
+          repo = "quickjs.ml";
+          rev = "5c4aa494acdf0f7b83a7b135b4ecd5d086cc1c64";
+          sha256 = "2rHyfc4Ru5fjuQY5xueJRSXBcVofVvPDagN0sFL7/nY=";
+        };
+        buildInputs = [pkgs.git];
+        propagatedBuildInputs = [
+          pkgs.git
+          pkgs.ocamlPackages.alcotest
+          pkgs.ocamlPackages.integers
+          pkgs.ocamlPackages.ctypes
+        ];
+      };
+      server-reason-react = pkgs.ocamlPackages.buildDunePackage {
+        pname = "server-reason-react";
+        version = "0.4.0";
+        src = pkgs.fetchFromGitHub {
+          owner = "polwex";
+          repo = "server-reason-react";
+          rev = "d5dd436b0a447ff0a82f9a8d7a02f102139299a9";
+          sha256 = "PsrOqZgdFIy5tGoLpS+hf9uz42vKJZbSvdWRW8MX604=";
+        };
+
+        propagatedBuildInputs = with pkgs.ocamlPackages; [
+          melange
+          ppxlib
+          ocaml_pcre
+          lwt
+          lwt_ppx
+          uri
+          quickjs
+          #
+          yojson
+          uucp
+        ];
+        nativeBuildInputs = with pkgs.ocamlPackages; [
+          reason
+          melange
+          # reason-native.refmett
+        ];
+      };
+    in {
+      devShells.default = pkgs.mkShell rec {
+        buildInputs =
+          nativeBuildInputs
+          ++ (with pkgs.ocamlPackages; [utop]);
+        nativeBuildInputs = with pkgs.ocamlPackages; [
+          pkgs.openjdk17
+          pkgs.nodejs
+          pkgs.sqlite
+          pkgs.dune_3
+          pkgs.ocaml
+          findlib
+          ocaml-lsp
+          ocamlformat
+          melange-json-native
           ppx_rapper
           ppx_rapper_eio
           yojson
@@ -38,29 +90,12 @@
           caqti-dynload
           caqti-driver-postgresql
           caqti-driver-sqlite3
-          pkgs.sqlite
           ppx_expect
-
           logs
+          #
+          reason
+          server-reason-react
         ];
       };
-    in {
-      devShells.default = pkgs.mkShell rec {
-        nativeBuildInputs = with pkgs.ocamlPackages; [
-          dune_3
-          findlib
-          ocaml
-          ocaml-lsp
-          ocamlformat
-          pkgs.openjdk17
-          pkgs.sqlite
-        ];
-
-        buildInputs =
-          combattant.buildInputs
-          ++ (with pkgs.ocamlPackages; [utop]);
-      };
-
-      packages.default = combattant;
     });
 }
diff --git a/lib/dune b/lib/dune
index 9064fed..a50de52 100644
--- a/lib/dune
+++ b/lib/dune
@@ -1,12 +1,25 @@
 (library
  (name lib)
  (libraries
+  ; local
+  pages
+  ;
   piaf
   routes
   yojson
   caqti
   caqti-driver-sqlite3
   caqti-eio
-  ppx_rapper_eio)
+  ppx_rapper_eio
+  ; react
+  server-reason-react.belt
+  server-reason-react.js
+  server-reason-react.react
+  server-reason-react.reactDom
+  server-reason-react.html)
  (preprocess
-  (pps ppx_rapper)))
+  (pps
+   ppx_rapper
+   server-reason-react.ppx
+   server-reason-react.melange_ppx
+   melange-json-native.ppx)))
diff --git a/lib/html.ml b/lib/html.ml
new file mode 100644
index 0000000..db5ad51
--- /dev/null
+++ b/lib/html.ml
@@ -0,0 +1,49 @@
+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_root (db_pool : pool) (request : Request.t) =
+  let _coki = Piaf.Cookies.Cookie.parse request.headers in
+  (* 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
+;;
+
+let render page (db_pool : pool) (_request : Request.t) =
+  (* Caqti_eio.Pool.use *)
+  (* (fun conn -> *)
+  (* let posts_or = Query.get_poasts () conn in *)
+  (* match posts_or with *)
+  (* | Error err -> *)
+  (* Logs.err (fun m -> m "Database error %a" Caqti_error.pp err); *)
+  (* Ok (Response.create `Internal_server_error) *)
+  (* | 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))
+    db_pool
+;;
diff --git a/lib/http.ml b/lib/http.ml
new file mode 100644
index 0000000..e8e7db4
--- /dev/null
+++ b/lib/http.ml
@@ -0,0 +1,89 @@
+open Piaf
+
+(* open Result_syntax *)
+open Eio.Std
+
+type mode =
+  | Hx
+  | HxSwap
+  | Server
+
+let query_param uri param =
+  match Uri.query uri |> List.assoc_opt param with
+  | Some [ param ] -> Some param
+  | _ -> None
+;;
+
+let send_raw_html ?(headers = []) ?(status = `OK) body =
+  let headers =
+    Headers.(of_list ([ Well_known.content_type, "text/html; charset=utf-8" ] @ headers))
+  in
+  Response.of_string ~headers ~body status
+;;
+
+let piaf_config = { Piaf.Config.default with follow_redirects = true }
+
+(* let get env ~headers ~sw url = *)
+(* TODO: curl-style debug logging *)
+(* let result = *)
+(* let* response = *)
+(* Client.Oneshot.get ~headers ~config:piaf_config ~sw env (Uri.of_string url) *)
+(* in *)
+(* let body = Body.to_string response.body in *)
+(* if Status.is_successful response.status *)
+(* then body *)
+(* else *)
+(* let* body = body in *)
+(* let message = Status.to_string response.status in *)
+(* Error (`Msg (Format.sprintf "%s %s" message body)) *)
+(* in *)
+(* result |> Result.map_error Error.to_string *)
+(* ;; *)
+
+(* let post env ~body ~headers ~sw url = *)
+(* TODO: curl-style debug logging *)
+(* let result = *)
+(* let* response = *)
+(* Client.Oneshot.post ~headers ~body ~config:piaf_config ~sw env (Uri.of_string url) *)
+(* in *)
+(* let body = Body.to_string response.body in *)
+(* if Status.is_successful response.status *)
+(* then body *)
+(* else *)
+(* let* body = body in *)
+(* let message = Status.to_string response.status in *)
+(* Error (`Msg (Format.sprintf "%s %s" message body)) *)
+(* in *)
+(* result |> Result.map_error Error.to_string *)
+(* ;; *)
+
+(* let parse_form_body ctx = *)
+(* let result = *)
+(* let+ body = ctx.Piaf.Server.request.body |> Body.to_string in *)
+(* body *)
+(* |> String.split_on_char '&' *)
+(* |> List.filter_map (fun pair -> *)
+(* match pair |> String.split_on_char '=' with *)
+(* | [ key; value ] -> *)
+(* let key = Uri.pct_decode key in *)
+(* let value = Uri.pct_decode value in *)
+(* Some (key, value) *)
+(* | parts -> *)
+(* traceln "Ignoring invalid param %s" (String.concat "," parts); *)
+(* None) *)
+(* in *)
+(* result |> Result.map_error (Fmt.to_to_string Piaf.Error.pp_hum) *)
+(* ;; *)
+
+let form_field field params =
+  params
+  |> List.assoc_opt field
+  |> Option.to_result ~none:(Format.sprintf "Missing %s field" field)
+;;
+
+let handle_error result =
+  result
+  |> Result.fold ~ok:Fun.id ~error:(fun error ->
+    traceln "Failed handling request %s" error;
+    Piaf.Response.create `Internal_server_error)
+;;
diff --git a/lib/pages.ml b/lib/pages.ml
deleted file mode 100644
index e52332f..0000000
--- a/lib/pages.ml
+++ /dev/null
@@ -1,33 +0,0 @@
-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_root (db_pool : pool) (request : Request.t) =
-  let _coki = Piaf.Cookies.Cookie.parse request.headers in
-  (* 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
-;;
diff --git a/lib/pages/BlogIndex.re b/lib/pages/BlogIndex.re
new file mode 100644
index 0000000..50beaed
--- /dev/null
+++ b/lib/pages/BlogIndex.re
@@ -0,0 +1,11 @@
+[@react.component]
+let make = () => {
+  <html>
+    <head>
+      <meta charSet="utf-8" />
+      <title> {React.string("Bloody Shovel 5")} </title>
+    </head>
+    // <link rel="stylesheet" href="/output.css" />
+    <body> <h1> {React.string("Oh hai")} </h1> </body>
+  </html>;
+};
diff --git a/lib/pages/dune b/lib/pages/dune
new file mode 100644
index 0000000..8cc2720
--- /dev/null
+++ b/lib/pages/dune
@@ -0,0 +1,13 @@
+(include_subdirs unqualified)
+
+(library
+ (name pages)
+ (libraries
+  lwt.unix
+  server-reason-react.belt
+  server-reason-react.js
+  server-reason-react.react
+  server-reason-react.reactDom
+  server-reason-react.html)
+ (preprocess
+  (pps melange.ppx lwt_ppx server-reason-react.ppx melange-json-native.ppx)))
diff --git a/lib/query.ml b/lib/query.ml
index 70285fc..179deb6 100644
--- a/lib/query.ml
+++ b/lib/query.ml
@@ -145,15 +145,27 @@ let sqlite_pragmas = [
 (* Example of how to execute raw SQL with Caqti *)
 let init_connection conn =
   let module C = (val conn : Rapper_helper.CONNECTION) in
-  (* Create a request: unit input -> unit output using Caqti infix operators *)
-  let pragma_req sql = 
+  (* 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
-    (unit ->. unit) sql 
+    (* 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 () -> C.exec (pragma_req sql) ()
+    | Ok () -> exec_pragma sql
   ) (Ok ()) sqlite_pragmas
diff --git a/lib/router.ml b/lib/router.ml
index 013686c..4e05da7 100644
--- a/lib/router.ml
+++ b/lib/router.ml
@@ -56,14 +56,15 @@ let routes =
 
       (* bs5 routes *)
       (* root *)
-    ; `GET, nil @--> Pages.get_root
-    ; `GET, (s "l" /? nil) @--> Pages.get_root
+    ; `GET, nil @--> Html.render @@ 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 = 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/test.sh b/test.sh
new file mode 100644
index 0000000..7efe850
--- /dev/null
+++ b/test.sh
@@ -0,0 +1 @@
+curl 'http://localhost:4455/posts'