Type mapping step 3, INSERT/UPDATE

doc.md

@@ -4,16 +4,20 @@
 - [📘 Documentation `sqlgg`](#-documentation-sqlgg)
   - [🧭 Contents](#-contents)
   - [🆕 Feature Review](#-feature-review)
-    - [Column-level Customization for Query Parameters](#column-level-customization-for-query-parameters)
-      - [🔹 Supported Parameter Forms](#-supported-parameter-forms)
+    - [Column-level Customization for INSERT/UPDATE Operations](#column-level-customization-for-insertupdate-operations)
+      - [🔹 Example Schema and Queries](#-example-schema-and-queries)
       - [🔹 Generated OCaml (Excerpt)](#-generated-ocaml-excerpt)
       - [🔹 Module Requirements](#-module-requirements)
+    - [Column-level Customization for Query Parameters](#column-level-customization-for-query-parameters)
+      - [🔹 Supported Parameter Forms](#-supported-parameter-forms)
+      - [🔹 Generated OCaml (Excerpt)](#-generated-ocaml-excerpt-1)
+      - [🔹 Module Requirements](#-module-requirements-1)
     - [Column-level Customization for `SELECT` (currently) Queries](#column-level-customization-for-select-currently-queries)
       - [🔹 Supported Annotations](#-supported-annotations)
       - [🔹 Example](#-example)
-      - [🔹 Generated OCaml (Excerpt)](#-generated-ocaml-excerpt-1)
+      - [🔹 Generated OCaml (Excerpt)](#-generated-ocaml-excerpt-2)
       - [🧠 Semantics](#-semantics)
-      - [🔹 Module Requirements](#-module-requirements-1)
+      - [🔹 Module Requirements](#-module-requirements-2)
       - [🔹 OCaml Implementation Example](#-ocaml-implementation-example)
     - [Support for DEFAULT Values](#support-for-default-values)
       - [🔹 Example](#-example-1)
@@ -41,6 +45,88 @@
 
 > Features are listed from latest to earliest, with detailed descriptions and examples.
 
+### Column-level Customization for INSERT/UPDATE Operations
+
+*Added: May 2025*
+
+Extends column-level customization to `INSERT` and `UPDATE` statements using the same custom modules as query parameters.
+
+
+#### 🔹 Example Schema and Queries
+
+```sql
+CREATE TABLE users (
+  -- [sqlgg] module=UserId
+  id INT AUTO_INCREMENT PRIMARY KEY,
+  -- [sqlgg] module=UserName
+  name VARCHAR(255) NOT NULL,
+  -- [sqlgg] module=UserEmail
+  email VARCHAR(255) UNIQUE,
+  created_at DATETIME DEFAULT CURRENT_TIMESTAMP
+);
+
+-- @create_user
+INSERT INTO users (name, email) 
+VALUES (@name, @email);
+
+-- @update_user_email
+UPDATE users 
+SET email = @new_email 
+WHERE id = @user_id;
+
+-- @update_user_profile
+UPDATE users 
+SET name = @name, email = @email 
+WHERE id = @user_id;
+```
+
+#### 🔹 Generated OCaml (Excerpt)
+
+```
+let create_user db ~name ~email =
+  let set_params stmt =
+    let p = T.start_params stmt 2 in
+    T.set_param_Text p (UserName.set_param name);
+    T.set_param_Text p (UserEmail.set_param email);
+    T.finish_params p
+  in
+  T.execute db 
+    "INSERT INTO users (name, email) VALUES (?, ?)" 
+    set_params
+
+let update_user_email db ~new_email ~user_id =
+  let set_params stmt =
+    let p = T.start_params stmt 2 in
+    T.set_param_Text p (UserEmail.set_param new_email);
+    T.set_param_Int p (UserId.set_param user_id);
+    T.finish_params p
+  in
+  T.execute db 
+    "UPDATE users SET email = ? WHERE id = ?" 
+    set_params
+
+let update_user_profile db ~name ~email ~user_id =
+  let set_params stmt =
+    let p = T.start_params stmt 3 in
+    T.set_param_Text p (UserName.set_param name);
+    T.set_param_Text p (UserEmail.set_param email);
+    T.set_param_Int p (UserId.set_param user_id);
+    T.finish_params p
+  in
+  T.execute db 
+    "UPDATE users SET name = ?, email = ? WHERE id = ?" 
+    set_params
+```
+
+#### 🔹 Module Requirements
+
+Uses the same `set_param` functions as for query parameters - no additional implementation needed.
+
+
+→ [PR #199](https://github.com/ygrek/sqlgg/pull/199/files)
+
+---
+
 ### Column-level Customization for Query Parameters
 
 *Added: May 2025*

lib/sql.ml

@@ -240,6 +240,15 @@ module Meta = struct
     end
 
   let equal = StringMap.equal String.equal
+
+  let merge_right t1 t2 =
+    StringMap.merge (fun _ v1 v2 ->
+      match v1, v2 with
+      | Some v, None -> Some v
+      | Some _, Some v2 -> Some v2
+      | None, Some v -> Some v
+      | None, None -> None
+    ) t1 t2
 end
 
 type attr = {name : string; domain : Type.t; extra : Constraints.t; meta: Meta.t }
@@ -517,15 +526,15 @@ and case = {
 } [@@deriving show]
 and expr =
   | Value of Type.t (** literal value *)
-  | Param of param
-  | Inparam of param
+  | Param of param * Meta.t
+  | Inparam of param * Meta.t
   | Choices of param_id * expr choices
   | InChoice of param_id * in_or_not_in * expr
   | Fun of fun_
   | SelectExpr of select_full * [ `AsValue | `Exists ]
   | Column of col_name
   | Inserted of string (** inserted value *)
-  | InTupleList of { exprs: expr list; param_id: param_id; kind: in_or_not_in; pos: pos }
+  | InTupleList of { exprs: expr list; param_id: param_id; kind: in_or_not_in; pos: pos;}
    (* pos - full syntax pos from {, to }?, pos is only sql, that inside {}?
       to use it during the substitution and to not depend on the magic numbers there.
    *) 

lib/sql_parser.mly

@@ -443,15 +443,15 @@ expr:
     | e1=expr IN table=table_name { Tables.check table; e1 }
     | e1=expr k=in_or_not_in p=param
       {
-        let e = poly (depends Bool) [ e1; Inparam (new_param p (depends Any)) ] in
+        let e = poly (depends Bool) [ e1; Inparam (new_param p (depends Any), Meta.empty()) ] in
         InChoice ({ label = p.label; pos = ($startofs, $endofs) }, k, e )
       }
-    | LPAREN names=commas(expr) RPAREN k=in_or_not_in p=param
+    | LPAREN exprs=commas(expr) RPAREN k=in_or_not_in p=param
       {
-        InTupleList({exprs = names; param_id = p; kind = k; pos = ($startofs, $endofs) })
+        InTupleList({exprs; param_id = p; kind = k; pos = ($startofs, $endofs); })
       }
     | LPAREN select=select_stmt RPAREN { SelectExpr (select, `AsValue) }
-    | p=param t=preceded(DOUBLECOLON, manual_type)? { Param (new_param { p with pos=($startofs, $endofs) } (Option.default (depends Any) t))  }
+    | p=param t=preceded(DOUBLECOLON, manual_type)? { Param (new_param { p with pos=($startofs, $endofs) } (Option.default (depends Any) t), Meta.empty())  }
     | LCURLY e=expr RCURLY QSTN { OptionActions ({ choice=e; pos=(($startofs, $endofs), ($startofs + 1, $endofs - 2)); kind = BoolChoices}) }
     | p=param parser_state_ident LCURLY l=choices c2=RCURLY { let { label; pos=(p1,_p2) } = p in Choices ({ label; pos = (p1,c2+1)},l) }
     | SUBSTRING LPAREN s=expr FROM p=expr FOR n=expr RPAREN

lib/syntax.ml

@@ -203,12 +203,24 @@ let resolve_column ~env {cname;tname} =
   | None -> find (Option.map_default (schema_of ~env) env.schema tname) cname
   | Some result -> result
 
+let set_param_meta ~env col e = 
+  let m' = (resolve_column ~env col).attr.meta in
+  let rec aux = function 
+  | Param (p, m) -> Param (p, Meta.merge_right m' m)  
+  | Inparam (p, m) -> Inparam (p, Meta.merge_right m' m)
+  | OptionActions { choice; pos; kind } -> 
+    OptionActions { choice = aux choice; pos; kind }
+  | e -> e 
+  in
+  aux e
+
 let resolve_column_assignments ~env l =
   let open Schema.Source in 
   let open Attr in
   let all = all_tbl_columns (List.map (fun (a, b) -> a, (List.map (fun attr -> {sources=[a]; attr}) b)) env.tables) in
+  let env = { env with schema = all } in
   l |> List.map begin fun (col,expr) ->
-    let attr = resolve_column ~env:{ env with schema = all } col in
+    let attr = resolve_column ~env col in
     (* autoincrement is special - nullable on insert, strict otherwise *)
     let typ = if Constraints.mem Autoincrement attr.attr.extra then 
       Sql.Type.nullable attr.attr.domain.t else attr.attr.domain in
@@ -221,8 +233,8 @@ let resolve_column_assignments ~env l =
       Choices (n, List.map (fun (n,e) -> n, Option.map (equality typ) e) l) (* FIXME hack, should propagate properly *)
     | RegularExpr (OptionActions ch) ->
       OptionActions { ch with choice = (equality typ) ch.choice }  (* FIXME hack, should propagate properly *)
-    | RegularExpr expr -> equality typ expr
-    | WithDefaultParam (e, pos) -> with_default @@ OptionActions { choice = equality typ e; pos; kind = SetDefault }
+    | RegularExpr expr -> equality typ (set_param_meta ~env col expr)
+    | WithDefaultParam (e, pos) -> with_default @@ OptionActions { choice = equality typ (set_param_meta ~env col e); pos; kind = SetDefault }
     | AssignDefault -> with_default @@ (Value typ)
   end
 
@@ -248,8 +260,8 @@ let rec bool_choice_id = function
   | SelectExpr _
   | OptionActions _
   | Value _ -> None
-  | Inparam p
-  | Param p -> Some p.id
+  | Inparam (p, _)
+  | Param (p, _) -> Some p.id
   | Fun { parameters; _ } -> List.find_map bool_choice_id parameters
   | Choices (p, _)
   | InTupleList { param_id = p; _ }
@@ -259,6 +271,40 @@ let rec bool_choice_id = function
     (option_list case @ 
      List.flatten (List.map (fun { Sql.when_; then_ } -> [when_; then_]) branches) @ 
      option_list else_)
+
+let extract_meta_from_col ~env expr = 
+  let rec aux = function 
+    (* col_name = @param *)
+    | Sql.Fun ({ parameters = ([Column a; b]); kind = Comparison; _ } as fn)
+    (* col_name IN @param *)
+    | Fun ({ parameters = ([Column a; (Inparam _) as b]); _ } as fn) -> 
+      Fun { fn with parameters = [Column a; set_param_meta ~env a b] }
+    | Sql.Fun ({ parameters = ([b; Column a]); kind = Comparison; _ } as fn)
+    (* col_name IN @param *)
+    | Fun ({ parameters = ([(Inparam _) as b; Column a;]); _ } as fn) -> 
+      Fun { fn with parameters = [set_param_meta ~env a b; Column a;] }
+    (* (col_name, ..., any_expr, col_name2) IN @param *)
+    | InTupleList ({ exprs;_ } as in_tuple_list) -> 
+      InTupleList { in_tuple_list with exprs = List.map aux exprs }
+    | Fun ({ parameters; _ } as fn) -> 
+      Fun { fn with parameters = List.map aux parameters }
+    | Case { case; branches; else_ } ->
+      let case = Option.map aux case in
+      let branches = List.map (fun { Sql.when_; then_ } -> 
+        { Sql.when_ = aux when_; then_ = aux then_ }
+      ) branches in
+      let else_ = Option.map aux else_ in
+      Case { case; branches; else_ }
+    | OptionActions ({ choice; _ } as o) -> 
+      OptionActions { o with choice = aux choice; } 
+    | InChoice (n, k, e) -> 
+      InChoice (n, k, aux e)
+    | Choices (n,l) -> 
+      Choices (n, List.map (fun (n,e) -> n, Option.map aux e) l)
+    | (Value _ | Param _ | Inparam _
+      | SelectExpr (_, _) | Column _ | Inserted _) as e -> e
+  in
+  aux expr
 
 
 (** resolve each name reference (Column, Inserted, etc) into ResValue or ResFun of corresponding type *)
@@ -269,52 +315,7 @@ let rec resolve_columns env expr =
     eprintf "schema: "; Sql.Schema.print (Schema.Source.from_schema env.schema);
     Tables.print stderr env.tables;
   end;
-  let get_meta_of_schema_expr ~env expr =
-    let rec extract_parameter_id = function 
-      | Param p -> Some p.id
-      | Inparam p -> Some p.id
-      | Choices (p, _) -> Some p
-      | InChoice (p, _, _) -> Some p
-      | OptionActions { choice; _ } -> extract_parameter_id choice
-      | Fun _ | SelectExpr _ 
-      | Inserted _ | InTupleList _
-      | Value _ | Column _ | Case _ -> None
-    in
-    let hashtable = Hashtbl.create 10 in
-    let in_tuple_list_hashtable = Hashtbl.create 5 in
-    let extract_meta_from_col expr = 
-      let set_param col expr = expr |> extract_parameter_id |> Option.may @@ fun pid -> 
-        Option.may (fun l -> Hashtbl.add hashtable l (resolve_column ~env col).attr.meta ) pid.label
-      in
-      let rec aux = function 
-      (* col_name = @param *)
-      | Sql.Fun { parameters = ([Column a; b] | [b; Column a]); kind = Comparison; _ }
-      (* col_name IN @param *)
-      | Fun { parameters = ([Column a; (Inparam _) as b] | [(Inparam _) as b; Column a]); _ } -> set_param a b
-      (* (col_name, ..., any_expr, col_name2) IN @param *)
-      | InTupleList { exprs; param_id; _ } -> 
-        let meta_list = List.map (function
-          | Column col -> (resolve_column ~env col).attr.meta 
-          | _ -> Meta.empty()
-        ) exprs in
-        Option.may(fun k -> Hashtbl.add in_tuple_list_hashtable k meta_list) param_id.label;
-        List.iter aux exprs
-      | Fun { parameters; _ } -> List.iter aux parameters
-      | Case { case; branches; else_ } ->
-        Option.may aux case;
-        List.iter (fun { Sql.when_; then_ } -> aux when_; aux then_) branches;
-        Option.may aux else_
-      | OptionActions { choice; _ } -> aux choice
-      | InChoice (_, _, e) -> aux e
-      | Choices (_, l) -> List.iter (fun (_, e) -> Option.may aux e) l
-      | Value _ | Param _ | Inparam _
-      | SelectExpr (_, _) | Column _ | Inserted _ -> () in
-    aux expr in
-    extract_meta_from_col expr;
-    hashtable, in_tuple_list_hashtable
-  in
-  let hashtable, in_tuple_list_hashtable = get_meta_of_schema_expr ~env expr in
-  let get_meta_pid x = Option.default (Meta.empty()) @@ Stdlib.Option.bind x.id.label (Hashtbl.find_opt hashtable) in
+  let expr = extract_meta_from_col ~env expr in
   let rec each e =
     match e with
     | Value x -> ResValue x
@@ -329,7 +330,7 @@ let rec resolve_columns env expr =
     | Inserted name ->
       let attr = try Schema.find env.insert_schema name with Schema.Error (_,s) -> fail "for inserted values : %s" s in
       ResValue attr.domain
-    | Param x -> ResParam (x, get_meta_pid x)
+    | Param (x, m) -> ResParam (x, m)
     | InTupleList { exprs; param_id; kind; pos } -> 
       let res_exprs = List.map (fun expr ->
         let res_expr = each expr in
@@ -345,11 +346,13 @@ let rec resolve_columns env expr =
         | ResOptionActions _
         | ResInChoice _ -> fail "unsupported expression %s kind for WHERE e IN @tuplelist" (show_res_expr res_expr)
       ) exprs in
-      let meta_list = Option.default (List.init (List.length exprs) (fun _ -> Meta.empty())) 
-        @@ Stdlib.Option.bind param_id.label (Hashtbl.find_opt in_tuple_list_hashtable) in
-      let res_exprs = List.combine res_exprs meta_list in
+      let res_exprs = List.map2 (fun e re ->
+        match e with
+        | Column col -> re, (resolve_column ~env col).attr.meta 
+        | _ -> re, Meta.empty ()
+      ) exprs res_exprs in
       ResInTupleList {param_id; res_in_tuple_list = Res res_exprs; kind; pos }
-    | Inparam x -> ResInparam (x, get_meta_pid x)
+    | Inparam (x, m) -> ResInparam (x, m)
     | InChoice (n, k, x) -> ResInChoice (n, k, each x)
     | Choices (n,l) -> ResChoices (n, List.map (fun (n,e) -> n, Option.map each e) l)
     | Fun { kind; parameters; is_over_clause } ->
@@ -671,8 +674,8 @@ and params_of_order order final_schema env =
 
 and ensure_res_expr = function
   | Value x -> ResValue x
-  | Param x -> ResParam (x, Meta.empty ())
-  | Inparam x -> ResInparam (x, Meta.empty ())
+  | Param (x, m) -> ResParam (x, m)
+  | Inparam (x, m) -> ResInparam (x, m)
   | Case { case; branches; else_ }-> 
     let res_case = Option.map ensure_res_expr case in
     let res_branches = List.map (fun { Sql.when_; then_ } -> 

src/gen_caml.ml

@@ -293,7 +293,7 @@ let rec set_param ~meta index param =
       let set_param_name = set_param |> Sql.Meta.find_opt meta |> Option.default set_param in
       let runtime_repr_name = L.as_runtime_repr_name param'.typ in
       if nullable then
-         set_param_nullable pname @@ sprintf "T.set_param_%s p (%s);" runtime_repr_name (sprintf "%s.%s v" m set_param_name)
+         set_param_nullable pname @@ sprintf "T.set_param_%s p (%s);" runtime_repr_name (sprintf "%s.%s %s" m set_param_name pname)
       else
         output "T.set_param_%s p (%s);" runtime_repr_name (sprintf "%s.%s %s" m set_param_name pname)