m

8 files changed, 196 insertions, 41 deletions

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 =