WIP: uncommitted changes before archiving

💘 Generated with Crush

Assisted-by: GLM-4.7 via Crush <crush@charm.land>

lib/database.ml

@@ -4,14 +4,22 @@ open Lwt.Infix
 open Caqti_type
 
 (* Database connection pool *)
+let pool = ref None
 let pool_size = 5
 
-(* Database URL from environment *)
-let db_url =
+(* Get database URL from environment *)
+let db_url () =
   try Sys.getenv "DATABASE_URL"
   with Not_found ->
     "postgresql://monitor_user:changeme@localhost:5432/website_monitor"
 
+(* Create database pool *)
+let create_pool () =
+  let driver = Caqti_lwt.connect (Caqti_driver_postgres.connect ()) in
+  let uri = Caqti_uri.of_string_exn (db_url ()) in
+  let p = Caqti_pool.create ~max_size:pool_size driver uri in
+  pool := Some p
+
 (* Website model *)
 module Website = struct
   type t = {
@@ -49,6 +57,22 @@ module Website = struct
       created_at; updated_at; last_checked; last_status }
 end
 
+(* Get database connection pool *)
+let get_pool () =
+  match !pool with
+  | Some p -> p
+  | None -> failwith "Database pool not initialized"
+
+(* Set database pool (called by Dream middleware) *)
+let set_pool p =
+  pool := Some p
+
+(* Initialize database pool *)
+let initialize_pool () =
+  ()
+
+(* Note: When using Dream.sql_pool, the pool is passed via Dream.sql *)
+
 (* Alert model *)
 module Alert = struct
   type t = {
@@ -101,12 +125,6 @@ module CheckHistory = struct
     { id; website_id; status_code; response_time; error_message; checked_at }
 end
 
-(* Database connection pool *)
-let pool =
-  let driver = Caqti_block.connect (Caqti_driver_postgres.connect ()) in
-  let uri = Caqti_uri.of_string_exn db_url in
-  Caqti_pool.create ~max_size:pool_size driver uri
-
 (* Initialize database schema *)
 let init_schema () =
   let queries =
@@ -114,7 +132,8 @@ let init_schema () =
        Alerts.create_table;
        CheckHistories.create_table |]
   in
-  Lwt_list.iter_s (fun q -> Caqti_request.exec pool q ()) queries
+  let p = get_pool () in
+  Lwt_list.iter_s (fun q -> Caqti_request.exec p q ()) queries
   >>= fun () ->
   Logs.app (fun m -> m "Database schema initialized");
   Lwt.return_unit