use caqti infix

src/babillard.ml

@@ -41,163 +41,155 @@ type t =
   | Post of post
 
 module Q = struct
+  open Caqti_request.Infix
+
   let create_post_user_table =
-    Caqti_request.exec Caqti_type.unit
+    (Caqti_type.unit ->. Caqti_type.unit)
       "CREATE TABLE IF NOT EXISTS post_user (post_id TEXT, user_id TEXT, \
        PRIMARY KEY(post_id), FOREIGN KEY(user_id) REFERENCES user(user_id) ON \
        DELETE CASCADE);"
 
   (* one row for each thread, with thread's data *)
   let create_thread_info_table =
-    Caqti_request.exec Caqti_type.unit
+    (Caqti_type.unit ->. Caqti_type.unit)
       "CREATE TABLE IF NOT EXISTS thread_info (thread_id TEXT, subject TEXT, \
        lat FLOAT, lng FLOAT, FOREIGN KEY(thread_id) REFERENCES \
        post_user(post_id) ON DELETE CASCADE);"
 
   (* map thread and reply to the thread *)
   let create_thread_post_table =
-    Caqti_request.exec Caqti_type.unit
+    (Caqti_type.unit ->. Caqti_type.unit)
       "CREATE TABLE IF NOT EXISTS thread_post (thread_id TEXT, post_id TEXT, \
        FOREIGN KEY(thread_id) REFERENCES post_user(post_id) ON DELETE CASCADE, \
        FOREIGN KEY(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE);"
 
   let create_post_replies_table =
-    Caqti_request.exec Caqti_type.unit
+    (Caqti_type.unit ->. Caqti_type.unit)
       "CREATE TABLE IF NOT EXISTS post_replies (post_id TEXT, reply_id TEXT, \
        FOREIGN KEY(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE, \
        FOREIGN KEY(reply_id) REFERENCES post_user(post_id) ON DELETE CASCADE);"
 
   let create_post_citations_table =
-    Caqti_request.exec Caqti_type.unit
+    (Caqti_type.unit ->. Caqti_type.unit)
       "CREATE TABLE IF NOT EXISTS post_citations (post_id TEXT, cited_id TEXT, \
        FOREIGN KEY(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE, \
        FOREIGN KEY(cited_id) REFERENCES post_user(post_id) ON DELETE CASCADE);"
 
   let create_post_date_table =
-    Caqti_request.exec Caqti_type.unit
+    (Caqti_type.unit ->. Caqti_type.unit)
       "CREATE TABLE IF NOT EXISTS post_date (post_id TEXT, date FLOAT, FOREIGN \
        KEY(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE);"
 
   let create_post_comment_table =
-    Caqti_request.exec Caqti_type.unit
+    (Caqti_type.unit ->. Caqti_type.unit)
       "CREATE TABLE IF NOT EXISTS post_comment (post_id TEXT, comment TEXT, \
        FOREIGN KEY(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE);"
 
   let create_post_tags_table =
-    Caqti_request.exec Caqti_type.unit
+    (Caqti_type.unit ->. Caqti_type.unit)
       "CREATE TABLE IF NOT EXISTS post_tags (post_id TEXT, tag TEXT, FOREIGN \
        KEY(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE);"
 
   let create_report_table =
-    Caqti_request.exec Caqti_type.unit
+    (Caqti_type.unit ->. Caqti_type.unit)
       "CREATE TABLE IF NOT EXISTS report (user_id TEXT, reason TEXT, date \
        FLOAT,post_id TEXT, FOREIGN KEY(post_id) REFERENCES post_user(post_id) \
        ON DELETE CASCADE, FOREIGN KEY(user_id) REFERENCES user(user_id) ON \
        DELETE CASCADE);"
 
   let upload_report =
-    Caqti_request.exec
+    (Caqti_type.(tup4 string string float string) ->. Caqti_type.unit)
-      Caqti_type.(tup4 string string float string)
       "INSERT INTO report VALUES (?,?,?,?);"
 
   let ignore_report =
-    Caqti_request.exec Caqti_type.string "DELETE FROM report WHERE post_id=?;"
+    (Caqti_type.string ->. Caqti_type.unit)
+      "DELETE FROM report WHERE post_id=?;"
 
   let get_reports =
-    Caqti_request.collect Caqti_type.unit
+    (Caqti_type.unit ->* Caqti_type.(tup4 string string float string))
-      Caqti_type.(tup4 string string float string)
       "SELECT * FROM report;"
 
   let upload_post_id =
-    Caqti_request.exec
+    (Caqti_type.(tup2 string string) ->. Caqti_type.unit)
-      Caqti_type.(tup2 string string)
       "INSERT INTO post_user VALUES (?,?);"
 
   let upload_thread_info =
-    Caqti_request.exec
+    (Caqti_type.(tup4 string string float float) ->. Caqti_type.unit)
-      Caqti_type.(tup4 string string float float)
       "INSERT INTO thread_info VALUES (?,?,?,?);"
 
   let upload_thread_post =
-    Caqti_request.exec
+    (Caqti_type.(tup2 string string) ->. Caqti_type.unit)
-      Caqti_type.(tup2 string string)
       "INSERT INTO thread_post VALUES (?,?);"
 
   let upload_post_reply =
-    Caqti_request.exec
+    (Caqti_type.(tup2 string string) ->. Caqti_type.unit)
-      Caqti_type.(tup2 string string)
       "INSERT INTO post_replies VALUES (?,?);"
 
   let upload_post_comment =
-    Caqti_request.exec
+    (Caqti_type.(tup2 string string) ->. Caqti_type.unit)
-      Caqti_type.(tup2 string string)
       "INSERT INTO post_comment VALUES (?,?);"
 
   let upload_post_tag =
-    Caqti_request.exec
+    (Caqti_type.(tup2 string string) ->. Caqti_type.unit)
-      Caqti_type.(tup2 string string)
       "INSERT INTO post_tags VALUES (?,?);"
 
   let upload_post_date =
-    Caqti_request.exec
+    (Caqti_type.(tup2 string float) ->. Caqti_type.unit)
-      Caqti_type.(tup2 string float)
       "INSERT INTO post_date VALUES (?,?);"
 
   let get_post_user_id =
-    Caqti_request.find Caqti_type.string Caqti_type.string
+    (Caqti_type.string ->! Caqti_type.string)
       "SELECT user_id FROM post_user WHERE post_id=?;"
 
   let get_post_comment =
-    Caqti_request.find Caqti_type.string Caqti_type.string
+    (Caqti_type.string ->! Caqti_type.string)
       "SELECT comment FROM post_comment WHERE post_id=?;"
 
   let get_post_tags =
-    Caqti_request.collect Caqti_type.string Caqti_type.string
+    (Caqti_type.string ->* Caqti_type.string)
       "SELECT tag FROM post_tags WHERE post_id=?;"
 
   let get_post_date =
-    Caqti_request.find Caqti_type.string Caqti_type.float
+    (Caqti_type.string ->! Caqti_type.float)
       "SELECT date FROM post_date WHERE post_id=?;"
 
   let get_post_citations =
-    Caqti_request.collect Caqti_type.string Caqti_type.string
+    (Caqti_type.string ->* Caqti_type.string)
       "SELECT post_id FROM post_citations WHERE post_id=?;"
 
   let get_post_replies =
-    Caqti_request.collect Caqti_type.string Caqti_type.string
+    (Caqti_type.string ->* Caqti_type.string)
       "SELECT reply_id FROM post_replies WHERE post_id=?;"
 
   let get_thread_posts =
-    Caqti_request.collect Caqti_type.string Caqti_type.string
+    (Caqti_type.string ->* Caqti_type.string)
       "SELECT post_id FROM thread_post WHERE thread_id=?;"
 
   let count_thread_posts =
-    Caqti_request.find Caqti_type.string Caqti_type.int
+    (Caqti_type.string ->! Caqti_type.int)
       "SELECT COUNT(post_id) FROM thread_post WHERE thread_id=?;"
 
   let get_is_thread =
-    Caqti_request.find Caqti_type.string Caqti_type.string
+    (Caqti_type.string ->! Caqti_type.string)
       "SELECT thread_id FROM thread_info WHERE thread_id=? LIMIT 1;"
 
   let get_is_post =
-    Caqti_request.find Caqti_type.string Caqti_type.string
+    (Caqti_type.string ->! Caqti_type.string)
       "SELECT post_id FROM post_user WHERE post_id=? LIMIT 1;"
 
   let get_post_thread =
-    Caqti_request.find Caqti_type.string Caqti_type.string
+    (Caqti_type.string ->! Caqti_type.string)
       "SELECT thread_id FROM thread_post WHERE post_id=? LIMIT 1;"
 
   let get_thread_info =
-    Caqti_request.find Caqti_type.string
+    (Caqti_type.string ->! Caqti_type.(tup3 string float float))
-      Caqti_type.(tup3 string float float)
       "SELECT subject,lat,lng FROM thread_info WHERE thread_id=?;"
 
   let get_threads =
-    Caqti_request.collect Caqti_type.unit Caqti_type.string
+    (Caqti_type.unit ->* Caqti_type.string) "SELECT thread_id FROM thread_info;"
-      "SELECT thread_id FROM thread_info;"
 
   let delete_post =
-    Caqti_request.exec Caqti_type.string
+    (Caqti_type.string ->. Caqti_type.unit)
       "DELETE FROM post_user WHERE post_id=?;"
 end
 

src/db.ml

@@ -1,3 +1,5 @@
+open Caqti_request.Infix
+
 let db_root = App.data_dir
 
 let () =
@@ -16,14 +18,14 @@ module Db =
 
 let () =
   let set_foreign_keys_on =
-    Caqti_request.exec Caqti_type.unit "PRAGMA foreign_keys = ON;"
+    (Caqti_type.unit ->. Caqti_type.unit) "PRAGMA foreign_keys = ON;"
   in
   if Result.is_error (Db.exec set_foreign_keys_on ()) then
     Dream.error (fun log -> log "can't set foreign_keys on")
 
 let () =
   let query =
-    Caqti_request.exec Caqti_type.unit
+    (Caqti_type.unit ->. Caqti_type.unit)
       "CREATE TABLE IF NOT EXISTS dream_session (id TEXT PRIMARY KEY, label \
        TEXT NOT NULL, expires_at REAL NOT NULL, payload TEXT NOT NULL);"
   in

src/discuss.ml

@@ -1,3 +1,6 @@
+open Db
+open Caqti_request.Infix
+
 (** Creating the table of all messages.
 
     Each message is made of :
@@ -10,27 +13,25 @@
     TODO: add date ? *)
 let () =
   let create_msg_table =
-    Caqti_request.exec Caqti_type.unit
+    (Caqti_type.unit ->. Caqti_type.unit)
       "CREATE TABLE IF NOT EXISTS msg ( msg_id TEXT, from_id TEXT, to_id TEXT, \
        msg TEXT, PRIMARY KEY(msg_id), FOREIGN KEY(from_id) REFERENCES \
        user(user_id) ON DELETE CASCADE, FOREIGN KEY(to_id) REFERENCES \
        user(user_id) ON DELETE CASCADE);"
   in
-  match Db.Db.exec create_msg_table () with
+  match Db.exec create_msg_table () with
   | Ok () -> ()
   | Error _e -> Dream.error (fun log -> log "can't create msg table")
 
 (** let's find who the user is talking to so we can know if they're dangerous *)
 let find_comrades =
   let find_comrades =
-    Caqti_request.collect
+    (Caqti_type.(tup2 string string) ->* Caqti_type.(tup2 string string))
-      Caqti_type.(tup2 string string)
-      Caqti_type.(tup2 string string)
       "SELECT from_id, to_id FROM msg WHERE from_id=? OR to_id=?"
   in
   fun user_id ->
     let open Syntax in
-    let^ comrades = Db.Db.collect_list find_comrades (user_id, user_id) in
+    let^ comrades = Db.collect_list find_comrades (user_id, user_id) in
     let comrades =
       List.map (fun (l, r) -> if l = user_id then r else l) comrades
     in
@@ -39,15 +40,14 @@ let find_comrades =
 (** find all messages between two товарищи *)
 let find_messages =
   let find_messages =
-    Caqti_request.collect
+    ( Caqti_type.(tup2 (tup2 string string) (tup2 string string))
-      Caqti_type.(tup2 (tup2 string string) (tup2 string string))
+    ->* Caqti_type.(tup2 string string) )
-      Caqti_type.(tup2 string string)
       "SELECT from_id, msg FROM msg WHERE (from_id=? AND to_id=?) OR \
        (from_id=? AND to_id=?)"
   in
   fun k1 k2 ->
     let open Syntax in
-    let^ comrades = Db.Db.collect_list find_messages ((k1, k2), (k2, k1)) in
+    let^ comrades = Db.collect_list find_messages ((k1, k2), (k2, k1)) in
     Ok comrades
 
 (** display the list of discussions *)
@@ -135,13 +135,12 @@ let render_one request =
 
 let insert_msg =
   let insert_msg =
-    Caqti_request.exec
+    (Caqti_type.(tup3 string string string) ->. Caqti_type.unit)
-      Caqti_type.(tup3 string string string)
       "INSERT INTO msg VALUES (NULL, ?, ?, ?);"
   in
   fun from_id to_id msg ->
     let open Syntax in
-    let^ () = Db.Db.exec insert_msg (from_id, to_id, msg) in
+    let^ () = Db.exec insert_msg (from_id, to_id, msg) in
     Ok ()
 
 (** handle posts *)

src/image.ml

@@ -1,5 +1,5 @@
-open Syntax
 open Db
+open Syntax
 
 type t =
   { name : string
@@ -9,85 +9,81 @@ type t =
   }
 
 module Q = struct
+  open Caqti_request.Infix
+
   let create_info_table =
-    Caqti_request.exec Caqti_type.unit
+    (Caqti_type.unit ->. Caqti_type.unit)
       "CREATE TABLE IF NOT EXISTS image_info (post_id TEXT, image_name TEXT, \
        image_alt TEXT, FOREIGN KEY(post_id) REFERENCES post_user(post_id) ON \
        DELETE CASCADE);"
 
   let create_content_table =
-    Caqti_request.exec Caqti_type.unit
+    (Caqti_type.unit ->. Caqti_type.unit)
       "CREATE TABLE IF NOT EXISTS image_content (post_id TEXT, content TEXT, \
        FOREIGN KEY(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE);"
 
   let create_thumbnail_table =
-    Caqti_request.exec Caqti_type.unit
+    (Caqti_type.unit ->. Caqti_type.unit)
       "CREATE TABLE IF NOT EXISTS image_thumbnail (post_id TEXT, content TEXT, \
        FOREIGN KEY(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE);"
 
   let upload_info =
-    Caqti_request.exec
+    (Caqti_type.(tup3 string string string) ->. Caqti_type.unit)
-      Caqti_type.(tup3 string string string)
       "INSERT INTO image_info VALUES (?,?,?);"
 
   let upload_content =
-    Caqti_request.exec
+    (Caqti_type.(tup2 string string) ->. Caqti_type.unit)
-      Caqti_type.(tup2 string string)
       "INSERT INTO image_content VALUES (?,?);"
 
   let upload_thumbnail =
-    Caqti_request.exec
+    (Caqti_type.(tup2 string string) ->. Caqti_type.unit)
-      Caqti_type.(tup2 string string)
       "INSERT INTO image_thumbnail VALUES (?,?);"
 
   let get_post_content =
-    Caqti_request.find_opt Caqti_type.string Caqti_type.string
+    (Caqti_type.string ->? Caqti_type.string)
       "SELECT content FROM image_content WHERE post_id=?;"
 
   let get_post_thumbnail =
-    Caqti_request.find_opt Caqti_type.string Caqti_type.string
+    (Caqti_type.string ->? Caqti_type.string)
       "SELECT content FROM image_thumbnail WHERE post_id=?;"
 
   let get_post_info =
-    Caqti_request.find_opt Caqti_type.string
+    (Caqti_type.string ->? Caqti_type.(tup2 string string))
-      Caqti_type.(tup2 string string)
       "SELECT image_name,image_alt FROM image_info WHERE post_id=?;"
 
   (*avatars*)
   let create_user_content_table =
-    Caqti_request.exec Caqti_type.unit
+    (Caqti_type.unit ->. Caqti_type.unit)
       "CREATE TABLE IF NOT EXISTS user_image_content (user_id TEXT, content \
        TEXT, FOREIGN KEY(user_id) REFERENCES user(user_id) ON DELETE CASCADE);"
 
   let create_user_thumbnail_table =
-    Caqti_request.exec Caqti_type.unit
+    (Caqti_type.unit ->. Caqti_type.unit)
       "CREATE TABLE IF NOT EXISTS user_image_thumbnail (user_id TEXT, content \
        TEXT, FOREIGN KEY(user_id) REFERENCES user(user_id) ON DELETE CASCADE);"
 
   let upload_user_content =
-    Caqti_request.exec
+    (Caqti_type.(tup2 string string) ->. Caqti_type.unit)
-      Caqti_type.(tup2 string string)
       "INSERT INTO user_image_content VALUES (?,?);"
 
   let upload_user_thumbnail =
-    Caqti_request.exec
+    (Caqti_type.(tup2 string string) ->. Caqti_type.unit)
-      Caqti_type.(tup2 string string)
       "INSERT INTO user_image_thumbnail VALUES (?,?);"
 
   let get_user_content =
-    Caqti_request.find_opt Caqti_type.string Caqti_type.string
+    (Caqti_type.string ->? Caqti_type.string)
       "SELECT content FROM user_image_content WHERE user_id=?;"
 
   let get_user_thumbnail =
-    Caqti_request.find_opt Caqti_type.string Caqti_type.string
+    (Caqti_type.string ->? Caqti_type.string)
       "SELECT content FROM user_image_thumbnail WHERE user_id=?;"
 
   let delete_user_content =
-    Caqti_request.exec Caqti_type.string
+    (Caqti_type.string ->. Caqti_type.unit)
       "DELETE FROM user_image_content WHERE user_id=?;"
 
   let delete_user_thumbnail =
-    Caqti_request.exec Caqti_type.string
+    (Caqti_type.string ->. Caqti_type.unit)
       "DELETE FROM user_image_thumbnail WHERE user_id=?;"
 end
 

src/user.ml

@@ -1,5 +1,5 @@
-open Syntax
 open Db
+open Syntax
 
 type t =
   { user_id : string
@@ -11,110 +11,102 @@ type t =
   }
 
 module Q = struct
+  open Caqti_request.Infix
+
   let create_user_table =
-    Caqti_request.exec Caqti_type.unit
+    (Caqti_type.unit ->. Caqti_type.unit)
       "CREATE TABLE IF NOT EXISTS user (user_id TEXT, nick TEXT, password \
        TEXT, email TEXT, bio TEXT, PRIMARY KEY(user_id));"
 
   let create_banished_table =
-    Caqti_request.exec Caqti_type.unit
+    (Caqti_type.unit ->. Caqti_type.unit)
       "CREATE TABLE IF NOT EXISTS banished (nick TEXT, email TEXT);"
 
   let create_metadata_table =
-    Caqti_request.exec Caqti_type.unit
+    (Caqti_type.unit ->. Caqti_type.unit)
       "CREATE TABLE IF NOT EXISTS user_metadata (user_id TEXT, metadata TEXT, \
        FOREIGN KEY(user_id) REFERENCES user(user_id) ON DELETE CASCADE);"
 
   let get_metadata =
-    Caqti_request.find Caqti_type.string Caqti_type.string
+    (Caqti_type.string ->! Caqti_type.string)
       "SELECT metadata FROM user_metadata WHERE user_id=?;"
 
   let upload_metadata =
-    Caqti_request.exec
+    (Caqti_type.(tup2 string string) ->. Caqti_type.unit)
-      Caqti_type.(tup2 string string)
       "INSERT INTO user_metadata VALUES (?, ?);"
 
   let delete_metadata =
-    Caqti_request.exec Caqti_type.string
+    (Caqti_type.string ->. Caqti_type.unit)
       "DELETE FROM user_metadata WHERE user_id=?;"
 
   let get_user_id_from_nick =
-    Caqti_request.find Caqti_type.string Caqti_type.string
+    (Caqti_type.string ->! Caqti_type.string)
       "SELECT user_id FROM user WHERE nick=?;"
 
   let get_user_id_from_email =
-    Caqti_request.find Caqti_type.string Caqti_type.string
+    (Caqti_type.string ->! Caqti_type.string)
       "SELECT user_id FROM user WHERE email=?;"
 
   let get_password =
-    Caqti_request.find Caqti_type.string Caqti_type.string
+    (Caqti_type.string ->! Caqti_type.string)
       "SELECT password FROM user WHERE user_id=?;"
 
   let is_already_user =
-    Caqti_request.find
+    (Caqti_type.(tup2 string string) ->! Caqti_type.int)
-      Caqti_type.(tup2 string string)
-      Caqti_type.int
       "SELECT EXISTS(SELECT 1 FROM user WHERE nick=? OR email=?);"
 
   let upload_user =
-    Caqti_request.exec
+    ( Caqti_type.(tup4 string string string Caqti_type.(tup2 string string))
-      Caqti_type.(tup4 string string string Caqti_type.(tup2 string string))
+    ->. Caqti_type.unit )
       "INSERT INTO user VALUES (?, ?, ?, ?, ?);"
 
   let list_nicks =
-    Caqti_request.collect Caqti_type.unit Caqti_type.string
+    (Caqti_type.unit ->* Caqti_type.string) "SELECT nick FROM user;"
-      "SELECT nick FROM user;"
 
   let get_user =
-    Caqti_request.find Caqti_type.string
     (* there is no "tup6" *)
-      Caqti_type.(tup4 string string string Caqti_type.(tup2 string string))
+    ( Caqti_type.string
+    ->! Caqti_type.(tup4 string string string Caqti_type.(tup2 string string))
+    )
       "SELECT * FROM user WHERE user_id=?;"
 
   let update_bio =
-    Caqti_request.exec
+    (Caqti_type.(tup2 string string) ->. Caqti_type.unit)
-      Caqti_type.(tup2 string string)
       "UPDATE user SET bio=? WHERE user_id=?;"
 
   let update_nick =
-    Caqti_request.exec
+    (Caqti_type.(tup2 string string) ->. Caqti_type.unit)
-      Caqti_type.(tup2 string string)
       "UPDATE user SET nick=? WHERE user_id=?;"
 
   let update_email =
-    Caqti_request.exec
+    (Caqti_type.(tup2 string string) ->. Caqti_type.unit)
-      Caqti_type.(tup2 string string)
       "UPDATE user SET email=? WHERE user_id=?;"
 
   let update_password =
-    Caqti_request.exec
+    (Caqti_type.(tup2 string string) ->. Caqti_type.unit)
-      Caqti_type.(tup2 string string)
       "UPDATE user SET password=? WHERE user_id=?;"
 
   let get_nick =
-    Caqti_request.find Caqti_type.string Caqti_type.string
+    (Caqti_type.string ->! Caqti_type.string)
       "SELECT nick FROM user WHERE user_id=?;"
 
   let get_bio =
-    Caqti_request.find Caqti_type.string Caqti_type.string
+    (Caqti_type.string ->! Caqti_type.string)
       "SELECT bio FROM user WHERE user_id=?;"
 
   let get_email =
-    Caqti_request.find Caqti_type.string Caqti_type.string
+    (Caqti_type.string ->! Caqti_type.string)
       "SELECT email FROM user WHERE user_id=?;"
 
   let delete_user =
-    Caqti_request.exec Caqti_type.string "DELETE FROM user WHERE user_id=?;"
+    (Caqti_type.string ->. Caqti_type.unit) "DELETE FROM user WHERE user_id=?;"
 
   let upload_banished =
-    Caqti_request.exec
+    (Caqti_type.(tup2 string string) ->. Caqti_type.unit)
-      Caqti_type.(tup2 string string)
       "INSERT INTO banished VALUES (?,?);"
 
   let get_banished =
-    Caqti_request.find
+    (Caqti_type.(tup2 string string) ->! Caqti_type.(tup2 string string))
-      Caqti_type.(tup2 string string)
-      Caqti_type.(tup2 string string)
       "SELECT * FROM banished WHERE nick=? OR email=?;"
 end