From f606912c8975381324ba6ae2654d1c0db2829e79 Mon Sep 17 00:00:00 2001 From: Gleb <10594395+jongleb@users.noreply.github.com> Date: Tue, 1 Sep 2026 20:37:43 +0400 Subject: [PATCH] add -line-directives --- doc/_cli-options.md | 2 + src/cli.ml | 15 +- src/gen.ml | 28 +- src/gen_caml.ml | 19 +- src/gen_migrations.ml | 2 + src/main.ml | 78 ++-- src/schema_diff.ml | 3 +- src/sqlgg_config.ml | 4 + src/test.ml | 10 +- test/cram/line_directives.t/dyn.sql | 7 + test/cram/line_directives.t/extends.sql | 6 + test/cram/line_directives.t/initial.sql | 1 + test/cram/line_directives.t/long.sql | 15 + test/cram/line_directives.t/one.sql | 4 + test/cram/line_directives.t/queries.sql | 15 + test/cram/line_directives.t/run.t | 457 ++++++++++++++++++++++++ test/cram/line_directives.t/target.sql | 1 + 17 files changed, 611 insertions(+), 56 deletions(-) create mode 100644 test/cram/line_directives.t/dyn.sql create mode 100644 test/cram/line_directives.t/extends.sql create mode 100644 test/cram/line_directives.t/initial.sql create mode 100644 test/cram/line_directives.t/long.sql create mode 100644 test/cram/line_directives.t/one.sql create mode 100644 test/cram/line_directives.t/queries.sql create mode 100644 test/cram/line_directives.t/run.t create mode 100644 test/cram/line_directives.t/target.sql diff --git a/doc/_cli-options.md b/doc/_cli-options.md index cce123dc..13299e9b 100644 --- a/doc/_cli-options.md +++ b/doc/_cli-options.md @@ -6,6 +6,8 @@ -category {all|none|[-]{,}+} Only generate code for these specific query categories (possible values: DDL DQL DML DCL TCL) -open Make definitions (schema, reusable queries) from available without generating code for it (unless the file is also given as an input) -dynamic-select Generate static and dynamic version for every SELECT (dynamic allows to pick columns per call) + -line-directives Emit `# ""` directives so that OCaml and merlin report errors in a generated query function on the line the query starts at (caml/caml_io only) + -line-directives-file Name of the generated file, used by -line-directives to hand numbering back to it outside of query functions (default: .ml) - Read sql from stdin Schema and migrations: diff --git a/src/cli.ml b/src/cli.ml index 6966b08d..5891a6be 100644 --- a/src/cli.ml +++ b/src/cli.ml @@ -87,15 +87,12 @@ let parse_output s = | "none" -> None | _ -> failwith (sprintf "Unknown output language: %s" s) -let stamp_source filename stmts = - List.map (fun (stmt : Gen.stmt) -> { stmt with props = Props.set stmt.props "file" filename }) stmts - (* parse always runs for its schema-registration side effects, even in -gen none *) let read_statements = function | "-" -> Main.get_statements stdin | filename -> - Main.with_channel filename (Option.map_default Main.get_statements []) - |> stamp_source (Filename.basename filename) + Main.with_channel filename + (Option.map_default (Main.get_statements ~file:(Filename.basename filename)) []) let filter_stmts ~output stmts = match output with @@ -339,6 +336,10 @@ let parse_args () = "-open", Arg.String open_input, " Make definitions (schema, reusable queries) from available without generating code for it (unless the file is also given as an input)"; "-dynamic-select", Arg.Set Sqlgg_config.dynamic_select, " Generate static and dynamic version for every SELECT (dynamic allows to pick columns per call)"; + "-line-directives", Arg.Set Sqlgg_config.line_directives, + " Emit `# \"\"` directives so that OCaml and merlin report errors in a generated query function on the line the query starts at (caml/caml_io only)"; + "-line-directives-file", Arg.String (fun s -> Sqlgg_config.line_directives_file := Some s), + " Name of the generated file, used by -line-directives to hand numbering back to it outside of query functions (default: .ml)"; "-", Arg.Unit (fun () -> work "-"), " Read sql from stdin"; ] }; @@ -445,7 +446,9 @@ let parse_args () = inputs = List.rev !inputs; } -let read_blocks f = Main.with_channel f (function Some ch -> Main.raw_blocks ch | None -> []) +let read_blocks f = + Main.with_channel f (function Some ch -> Main.raw_blocks ch | None -> []) + |> List.map (fun (sql, props) -> sql, Props.set props "file" (Filename.basename f)) let parse_migrations blocks = let migs = List.filter_map Main.migration_of_block blocks in diff --git a/src/gen.ml b/src/gen.ml index 34deeb1b..e5e99f15 100644 --- a/src/gen.ml +++ b/src/gen.ml @@ -8,7 +8,9 @@ open Stmt type subst_mode = | Named | Unnamed | Oracle | PostgreSQL -type stmt = { schema : Sql.schema_column list; vars : Sql.var list; kind : kind; props : Props.t; } +type src = { file : string; line : int } + +type stmt = { schema : Sql.schema_column list; vars : Sql.var list; kind : kind; props : Props.t; src : src option } (** defines substitution function for parameter literals *) let params_mode = ref None @@ -19,12 +21,28 @@ let (inc_indent,dec_indent,make_indent) = (fun () -> v := !v - 2), (fun () -> String.make !v ' ') -let print_indent () = print_string (make_indent ()) -let indent s = print_indent (); print_string s -let indent_endline s = print_indent (); print_endline @@ String.trim s +let cur_src : src option ref = ref None +let out_line = ref 1 + +let emit s = print_string s; String.iter (function '\n' -> incr out_line | _ -> ()) s +let directive line file = emit (sprintf "# %d %S\n" line file) + +let enter_src src = cur_src := if !Sqlgg_config.line_directives then src else None + +let leave_src () = + !cur_src |> Option.may (fun { file; _ } -> + cur_src := None; + let after_directive = !out_line + 1 in + directive after_directive (Option.default (file ^ ".ml") !Sqlgg_config.line_directives_file)) + +let emit_line str = + Option.may (fun s -> directive s.line s.file) !cur_src; + emit str; emit "\n" +let indent s = emit (make_indent ()); emit s +let indent_endline s = emit_line (make_indent () ^ String.trim s) let output fmt = ksprintf indent_endline fmt let output_l = List.iter indent_endline -let print fmt = ksprintf print_endline fmt +let print fmt = ksprintf emit_line fmt let indented k = inc_indent (); k (); dec_indent () let name_of attr index = diff --git a/src/gen_caml.ml b/src/gen_caml.ml index dfccfed5..2227a31e 100644 --- a/src/gen_caml.ml +++ b/src/gen_caml.ml @@ -115,7 +115,7 @@ let quote_comment_inline str = let make_comment str = "(* " ^ (quote_comment_inline str) ^ " *)" let comment () fmt = Printf.ksprintf (indent_endline $ make_comment) fmt -let empty_line () = print_newline () +let empty_line () = emit "\n" let enums_hash_tbl = Hashtbl.create 100 @@ -342,9 +342,7 @@ let emit_cols_module ~brand_decl ~field_names body = let emit_verbatim_block src = let ind = make_indent () in String.split_on_char '\n' src - |> List.iter (fun line -> - if line = "" then print_newline () - else Printf.printf "%s%s\n" ind line) + |> List.iter (fun line -> if line = "" then emit "\n" else emit_line (ind ^ line)) let append_func_params ~has_callback ~module_kind inputs = inputs @@ -352,6 +350,7 @@ let append_func_params ~has_callback ~module_kind inputs = ^ (if module_kind = `Fold then " acc" else "") let emit_func_header ~name ~extra_params ~has_callback ~format_input ~module_kind stmt = + enter_src stmt.src; let subst = Props.get_all stmt.props "subst" in let inputs = (subst @ names_of_vars stmt.vars) |> List.map format_input |> inline_values in output "let %s db%s %s =" name extra_params (append_func_params ~has_callback ~module_kind inputs); @@ -401,6 +400,7 @@ let consumer = function let complete_func c = c.c_finish (); dec_indent (); + leave_src (); empty_line () let make_variant_name i name ~is_poly = @@ -1163,6 +1163,7 @@ let generate_dynamic_select_modules stmts = in let count_expr = eval_count_params field_args in let set_helper_name = sprintf "_set_%s" field_name in + enter_src stmt.Gen.src; begin match names_of_vars field_args with | [] -> output "let %s : _ t =" field_name | names -> output "let %s %s : _ t =" field_name (String.concat " " names) @@ -1186,7 +1187,8 @@ let generate_dynamic_select_modules stmts = output "column = %s;" column_body; output "count = %s;" count_expr; output "deps = %s;" (deps_of_field field_schema)); - output "}") + output "}"); + leave_src () in emit_cols_module ~brand_decl ~field_names:(List.map (fun f -> f.field_name) fields) @@ -1280,17 +1282,18 @@ let generate_migrations name migrations = Gen.choose_name m.props m.kind index, m ) migrations in let migration_names = List.map fst named in - let make_stmt fn_name sql = - { Gen.schema = []; vars = []; kind = Stmt.Other; + let make_stmt ~src fn_name sql = + { Gen.schema = []; vars = []; kind = Stmt.Other; src; props = Props.set (Props.set Props.empty "name" fn_name) "sql" sql } in let revert_stmt name (m : Gen_migrations.migration) = + let make_stmt = make_stmt ~src:m.revert_src in match m.revert with | [] -> let s = make_stmt ("revert_" ^ name) "" in { s with props = Props.set s.props "noop" "" } | revert -> make_stmt ("revert_" ^ name) (String.concat ";\n" revert) in let stmts = List.concat_map (fun (name, (m : Gen_migrations.migration)) -> - [make_stmt ("apply_" ^ name) (String.concat ";\n" m.apply); revert_stmt name m] + [make_stmt ~src:m.apply_src ("apply_" ^ name) (String.concat ";\n" m.apply); revert_stmt name m] ) named in Option.may (Header.generate_header ()) !Sqlgg_config.gen_header; generate ~gen_io:true ~migration_names:(Some migration_names) name stmts diff --git a/src/gen_migrations.ml b/src/gen_migrations.ml index c374414e..ec2e9606 100644 --- a/src/gen_migrations.ml +++ b/src/gen_migrations.ml @@ -271,6 +271,8 @@ type migration = { kind : Stmt.kind; apply : string list; revert : string list; + apply_src : Gen.src option; + revert_src : Gen.src option; } let drop_type_sql type_name = diff --git a/src/main.ml b/src/main.ml index 6a92d681..93bf6591 100644 --- a/src/main.ml +++ b/src/main.ml @@ -113,7 +113,7 @@ let parse_one' (sql, props) = | _ -> () end; let props = Props.set props "sql" sql in - { Gen.schema; vars; kind; props } + { Gen.schema; vars; kind; props; src = None } (** @return parsed statement or [None] in case of parsing failure. @raise exn for other errors (typing etc) @@ -132,7 +132,7 @@ let stmt_has_dynamic_select (stmt : Gen.stmt) = let parse_one (sql, props as x) = match Props.get props "noparse" with - | Some _ -> [ { Gen.schema=[]; vars=[]; kind=Stmt.Other; props=Props.set props "sql" sql } ] + | Some _ -> [ { Gen.schema=[]; vars=[]; kind=Stmt.Other; props=Props.set props "sql" sql; src=None } ] | None -> match try_parse parse_one' x with | None -> [] @@ -191,15 +191,20 @@ end let lex_tokens lexbuf = Enum.from (fun () -> - if lexbuf.Lexing.lex_eof_reached then raise Enum.No_more_elements - else match Sql_lexer.ruleStatement lexbuf with + match Sql_lexer.ruleStatement lexbuf with | `Eof -> raise Enum.No_more_elements - | #token as x -> x) + | #token as x -> (x, Lexing.lexeme_start lexbuf)) + +let lex_channel ch = + let source = Std.input_all ch in + let line = Array.make (String.length source + 1) 1 in + String.iteri (fun i c -> line.(i + 1) <- line.(i) + (if c = '\n' then 1 else 0)) source; + lex_tokens (Lexing.from_string source), Array.get line let extract_statement' tokens = let b = Buffer.create 1024 in let props = ref Props.empty in - let answer () = Buffer.contents b, !props in + let answer start = Buffer.contents b, !props, start in let internal_props = ref Props.empty in @@ -210,39 +215,46 @@ let extract_statement' tokens = ) in - let rec loop smth = + let rec loop start = + let started = Option.is_some start in match Enum.get tokens with - | None -> if smth then Some (answer ()) else None - | Some x -> + | None -> if started then Some (answer start) else None + | Some (x, off) -> + let content_start = if started then start else Some off in begin match x with - | `Comment _ -> loop smth - | `Char c -> flush_internal_props (); Buffer.add_char b c; loop true - | `Token s -> flush_internal_props (); Buffer.add_string b s; loop true - | `Space _ when smth = false -> loop smth - | `Space s -> Buffer.add_string b s; loop true - | `Props p when smth -> internal_props := Props.set_all p !internal_props; loop smth - | `Props p -> props := Props.set_all p !props; loop smth - | `Semicolon -> Some (answer ()) + | `Comment _ -> loop start + | `Char c -> flush_internal_props (); Buffer.add_char b c; loop content_start + | `Token s -> flush_internal_props (); Buffer.add_string b s; loop content_start + | `Space _ when not started -> loop start + | `Space s -> Buffer.add_string b s; loop start + | `Props p when started -> internal_props := Props.set_all p !internal_props; loop start + | `Props p -> props := Props.set_all p !props; loop start + | `Semicolon -> Some (answer start) end in Parser_state.Stmt_metadata.reset(); - try loop false + try loop None with e -> Error.log "lexer failed (%s)" (Printexc.to_string e); None -let get_statements ch = - let lexbuf = Lexing.from_channel ch in - let tokens = lex_tokens lexbuf in +let get_statements ?file ch = + let (tokens, line_at) = lex_channel ch in Enum.from (fun () -> match extract_statement' tokens with | Some x -> x | None -> raise Enum.No_more_elements) - |> Enum.map (fun (buffer, props) -> + |> Enum.map (fun (buffer, props, start) -> + let props = Option.map_default (Props.set props "file") props file in + let src = match file, start with + | Some file, Some off -> Some { Gen.file; line = line_at off } + | _ -> None + in let include_ = match Props.get props "include" with | Some s -> Include.of_string s | None -> Include.OnlyExecutable in + List.map (fun (stmt : Gen.stmt) -> { stmt with Gen.src }) @@ match include_ with | OnlyReusable -> let (_: Sql.select_full option) = parse_select_one (buffer, props) in @@ -255,21 +267,24 @@ let get_statements ch = | ReusableAndExecutable -> parse_select_one (buffer, props) |> Option.map_default (fun select_full -> let (schema, vars, kind) = Syntax.eval_select select_full in - let stmt = { Gen.schema; vars; kind; props = Props.set props "sql" buffer } in + let stmt = { Gen.schema; vars; kind; props = Props.set props "sql" buffer; src = None } in check_statement stmt buffer; [stmt]) [] ) |> List.of_enum |> List.concat let replay_sql sql = ignore (try_parse parse_one' (sql, Props.empty)) let collect_blocks ch = - let lexbuf = Lexing.from_channel ch in - let tokens = lex_tokens lexbuf in + let (tokens, line_at) = lex_channel ch in let rec aux acc = match extract_statement' tokens with | None -> List.rev acc - | Some (buffer, props) -> + | Some (buffer, props, start) -> let b = String.trim buffer in - if b = "" then aux acc else aux ((b, props) :: acc) + if b = "" then aux acc else + let props = + Option.map_default (fun off -> Props.set props "line" (string_of_int (line_at off))) props start + in + aux ((b, props) :: acc) in aux [] @@ -279,6 +294,7 @@ let glue_downs blocks = | (sql, props) :: (down_sql, down_props) :: rest when has "id" props && not (has "down" props) && not (has "irreversible" props) && not (has "id" down_props) -> + let props = Option.map_default (Props.set props "down_line") props (Props.get down_props "line") in (sql, Props.set props "down" down_sql) :: aux rest | b :: rest -> b :: aux rest | [] -> [] @@ -313,7 +329,13 @@ let migration_of_block (sql, props) = | _ -> stmt.props) | _ -> stmt.props in - { Gen_migrations.props; kind = stmt.kind; apply = [apply]; revert }) + let src key = + match Props.get props "file", Props.get props key with + | Some file, Some line -> Option.map (fun line -> { Gen.file; line }) (int_of_string_opt line) + | _ -> None + in + { Gen_migrations.props; kind = stmt.kind; apply = [apply]; revert; + apply_src = src "line"; revert_src = src "down_line" }) let with_channel filename f = match try Some (open_in filename) with _ -> None with diff --git a/src/schema_diff.ml b/src/schema_diff.ml index 6b44b6d0..1490a7aa 100644 --- a/src/schema_diff.ml +++ b/src/schema_diff.ml @@ -293,7 +293,8 @@ let generate ~naming ~ddl_as_migration ~from_ ~to_ = let by_from = table_by_name from_ in let by_to = table_by_name to_ in diff ~ddl_as_migration ~from_ ~to_ ~by_from ~by_to |> List.map (fun up -> - { Gen_migrations.props = Props.set Props.empty "name" (change_name ~naming up); + { Gen_migrations.apply_src = None; revert_src = None; + props = Props.set Props.empty "name" (change_name ~naming up); kind = kind_of_change up; apply = render_apply up; revert = render_apply (invert ~by_from ~by_to up) }) diff --git a/src/sqlgg_config.ml b/src/sqlgg_config.ml index 531f0a23..ea2158e3 100644 --- a/src/sqlgg_config.ml +++ b/src/sqlgg_config.ml @@ -24,3 +24,7 @@ let no_check_features: Dialect.feature list ref = ref [] let set_no_check_features l = no_check_features := l let allow_write_notnull_null b = Syntax.Config.allow_write_notnull_null := b + +let line_directives = ref false + +let line_directives_file : string option ref = ref None diff --git a/src/test.ml b/src/test.ml index c0a84779..b67d68cc 100644 --- a/src/test.ml +++ b/src/test.ml @@ -21,15 +21,9 @@ let cmp_params p1 p2 = _ -> false let parse sql = - let lexbuf = Lexing.from_string sql in - let tokens = Enum.from (fun () -> - match Sql_lexer.ruleStatement lexbuf with - | `Eof -> `Semicolon - | #Main.token as x -> x) - in - match Main.extract_statement' tokens with + match Main.extract_statement' (Main.lex_tokens (Lexing.from_string sql)) with | None -> raise Enum.No_more_elements - | Some (buffer, _) -> + | Some (buffer, _, _) -> match Main.parse_one (buffer,[]) with | exception exn -> assert_failure @@ sprintf "failed : %s : %s" (Printexc.to_string exn) sql | [] -> assert_failure @@ sprintf "Failed to parse : %s" sql diff --git a/test/cram/line_directives.t/dyn.sql b/test/cram/line_directives.t/dyn.sql new file mode 100644 index 00000000..7aa27cb0 --- /dev/null +++ b/test/cram/line_directives.t/dyn.sql @@ -0,0 +1,7 @@ +CREATE TABLE items (id INT NOT NULL PRIMARY KEY, name TEXT NULL); + +-- [sqlgg] dynamic_select=true +-- @pick +SELECT id, name + FROM items + WHERE id = @id; diff --git a/test/cram/line_directives.t/extends.sql b/test/cram/line_directives.t/extends.sql new file mode 100644 index 00000000..fff80d3b --- /dev/null +++ b/test/cram/line_directives.t/extends.sql @@ -0,0 +1,6 @@ +-- [sqlgg] manual +-- [sqlgg] id=20260609000000 +ALTER TABLE users + RENAME COLUMN email TO email_address; +ALTER TABLE users + RENAME COLUMN email_address TO email; diff --git a/test/cram/line_directives.t/initial.sql b/test/cram/line_directives.t/initial.sql new file mode 100644 index 00000000..92062e98 --- /dev/null +++ b/test/cram/line_directives.t/initial.sql @@ -0,0 +1 @@ +CREATE TABLE users (id INT NOT NULL, email TEXT NOT NULL); diff --git a/test/cram/line_directives.t/long.sql b/test/cram/line_directives.t/long.sql new file mode 100644 index 00000000..2cb39d0a --- /dev/null +++ b/test/cram/line_directives.t/long.sql @@ -0,0 +1,15 @@ +CREATE TABLE wide ( + c1 INT NOT NULL, c2 INT NOT NULL, c3 INT NOT NULL, c4 INT NOT NULL, + c5 INT NOT NULL, c6 INT NOT NULL, c7 INT NOT NULL, c8 INT NOT NULL, + -- [sqlgg] module=No_such_codec + bad INT NOT NULL +); + +-- @big +UPDATE wide + SET c1 = @p1, c2 = @p2, c3 = @p3, c4 = @p4, + c5 = @p5, c6 = @p6, c7 = @p7, c8 = @p8 + WHERE bad = @bad; + +-- @after +DELETE FROM wide; diff --git a/test/cram/line_directives.t/one.sql b/test/cram/line_directives.t/one.sql new file mode 100644 index 00000000..18a2050f --- /dev/null +++ b/test/cram/line_directives.t/one.sql @@ -0,0 +1,4 @@ +CREATE TABLE t (id INT NOT NULL); + +-- @erase +DELETE FROM t WHERE id = @id; diff --git a/test/cram/line_directives.t/queries.sql b/test/cram/line_directives.t/queries.sql new file mode 100644 index 00000000..90d1c6bd --- /dev/null +++ b/test/cram/line_directives.t/queries.sql @@ -0,0 +1,15 @@ +CREATE TABLE person ( + id INT NOT NULL, + name TEXT NOT NULL +); + +-- @count_persons +SELECT count(*) FROM person; + +-- @rename +UPDATE person + SET name = @name + WHERE id = @id; + +-- @erase +DELETE FROM person WHERE id = @id; diff --git a/test/cram/line_directives.t/run.t b/test/cram/line_directives.t/run.t new file mode 100644 index 00000000..f9616928 --- /dev/null +++ b/test/cram/line_directives.t/run.t @@ -0,0 +1,457 @@ +`-line-directives` makes the generated OCaml carry `# ""` +directives, so that ocamlc and merlin report an error inside a generated query +function on the line of the query it came from, instead of on a line of the +machine-written .ml that nobody reads. + +Start with the smallest possible file, and look at the whole thing. + + $ grep -n '' one.sql + 1:CREATE TABLE t (id INT NOT NULL); + 2: + 3:-- @erase + 4:DELETE FROM t WHERE id = @id; + +Off by default, the output is exactly what it always was: + + $ sqlgg -no-header -gen caml one.sql + module Sqlgg (T : Sqlgg_traits.M) = struct + + module IO = Sqlgg_io.Blocking + + let create_t db = + T.execute_unprepared db (Sqlgg_traits.Query.make ~filename:"one.sql" ~sql:("CREATE TABLE t (id INT NOT NULL)") ~name:"create_t" ~kind:Sqlgg_traits.Query.(Create "t") ()) + + let erase db ~id = + let set_params stmt = + let p = T.start_params stmt (1) in + T.set_param_Int p id; + T.finish_params p + in + T.execute db (Sqlgg_traits.Query.make ~filename:"one.sql" ~sql:("DELETE FROM t WHERE id = @id") ~name:"erase" ~kind:Sqlgg_traits.Query.(Delete ["t"]) ()) set_params + + end (* module Sqlgg *) + +On, each generated line carries the line its query starts at -- 1 for the +CREATE, 4 for the DELETE, which is the statement itself and not the `-- @erase` +comment on line 3. Leaving a function, a second directive hands numbering back +to the generated file, so what follows is attributed to it and not to whatever +comes next in the .sql: + + $ sqlgg -no-header -gen caml -line-directives one.sql + module Sqlgg (T : Sqlgg_traits.M) = struct + + module IO = Sqlgg_io.Blocking + + # 1 "one.sql" + let create_t db = + # 1 "one.sql" + T.execute_unprepared db (Sqlgg_traits.Query.make ~filename:"one.sql" ~sql:("CREATE TABLE t (id INT NOT NULL)") ~name:"create_t" ~kind:Sqlgg_traits.Query.(Create "t") ()) + # 10 "one.sql.ml" + + # 4 "one.sql" + let erase db ~id = + # 4 "one.sql" + let set_params stmt = + # 4 "one.sql" + let p = T.start_params stmt (1) in + # 4 "one.sql" + T.set_param_Int p id; + # 4 "one.sql" + T.finish_params p + # 4 "one.sql" + in + # 4 "one.sql" + T.execute db (Sqlgg_traits.Query.make ~filename:"one.sql" ~sql:("DELETE FROM t WHERE id = @id") ~name:"erase" ~kind:Sqlgg_traits.Query.(Delete ["t"]) ()) set_params + # 26 "one.sql.ml" + + end (* module Sqlgg *) + +No generator other than caml/caml_io emits anything, with or without the flag: + + $ for g in cxx java xml csharp; do + > sqlgg -no-header -line-directives -gen $g one.sql | grep -c '^# ' || true + > done + 0 + 0 + 0 + 0 + +Reading from stdin there is no file to point at, so nothing is emitted either: + + $ sqlgg -no-header -gen caml -line-directives - < one.sql | grep -c '^# ' || true + 0 + +`-line-directives-file` names the generated file explicitly, for build rules +whose target is not `.ml`: + + $ sqlgg -no-header -gen caml -line-directives -line-directives-file sql_t.ml one.sql + module Sqlgg (T : Sqlgg_traits.M) = struct + + module IO = Sqlgg_io.Blocking + + # 1 "one.sql" + let create_t db = + # 1 "one.sql" + T.execute_unprepared db (Sqlgg_traits.Query.make ~filename:"one.sql" ~sql:("CREATE TABLE t (id INT NOT NULL)") ~name:"create_t" ~kind:Sqlgg_traits.Query.(Create "t") ()) + # 10 "sql_t.ml" + + # 4 "one.sql" + let erase db ~id = + # 4 "one.sql" + let set_params stmt = + # 4 "one.sql" + let p = T.start_params stmt (1) in + # 4 "one.sql" + T.set_param_Int p id; + # 4 "one.sql" + T.finish_params p + # 4 "one.sql" + in + # 4 "one.sql" + T.execute db (Sqlgg_traits.Query.make ~filename:"one.sql" ~sql:("DELETE FROM t WHERE id = @id") ~name:"erase" ~kind:Sqlgg_traits.Query.(Delete ["t"]) ()) set_params + # 26 "sql_t.ml" + + end (* module Sqlgg *) + +Now a file with a multi-line query and several module kinds. Note that the SQL +stays one OCaml string literal with escaped newlines and no directive spliced +into it, and that `module Single = struct` / `end (* module Single *)` are not +preceded by one either: + + $ grep -n '' queries.sql + 1:CREATE TABLE person ( + 2: id INT NOT NULL, + 3: name TEXT NOT NULL + 4:); + 5: + 6:-- @count_persons + 7:SELECT count(*) FROM person; + 8: + 9:-- @rename + 10:UPDATE person + 11: SET name = @name + 12: WHERE id = @id; + 13: + 14:-- @erase + 15:DELETE FROM person WHERE id = @id; + $ sqlgg -no-header -gen caml -line-directives queries.sql > out.ml + $ cat out.ml + module Sqlgg (T : Sqlgg_traits.M) = struct + + module IO = Sqlgg_io.Blocking + + # 1 "queries.sql" + let create_person db = + # 1 "queries.sql" + T.execute_unprepared db (Sqlgg_traits.Query.make ~filename:"queries.sql" ~sql:("CREATE TABLE person (\n\ + id INT NOT NULL,\n\ + name TEXT NOT NULL\n\ + )") ~name:"create_person" ~kind:Sqlgg_traits.Query.(Create "person") ()) + # 13 "queries.sql.ml" + + # 7 "queries.sql" + let count_persons db = + # 7 "queries.sql" + let get_row stmt = + # 7 "queries.sql" + (T.get_column_Int stmt 0) + # 7 "queries.sql" + in + # 7 "queries.sql" + T.select_one db (Sqlgg_traits.Query.make ~filename:"queries.sql" ~sql:("SELECT count(*) FROM person") ~name:"count_persons" ~kind:Sqlgg_traits.Query.(Select One) ()) T.no_params get_row + # 25 "queries.sql.ml" + + # 10 "queries.sql" + let rename db ~name ~id = + # 10 "queries.sql" + let set_params stmt = + # 10 "queries.sql" + let p = T.start_params stmt (2) in + # 10 "queries.sql" + T.set_param_Text p name; + # 10 "queries.sql" + T.set_param_Int p id; + # 10 "queries.sql" + T.finish_params p + # 10 "queries.sql" + in + # 10 "queries.sql" + T.execute db (Sqlgg_traits.Query.make ~filename:"queries.sql" ~sql:("UPDATE person\n\ + SET name = @name\n\ + WHERE id = @id") ~name:"rename" ~kind:Sqlgg_traits.Query.(Update (Some "person")) ()) set_params + # 45 "queries.sql.ml" + + # 15 "queries.sql" + let erase db ~id = + # 15 "queries.sql" + let set_params stmt = + # 15 "queries.sql" + let p = T.start_params stmt (1) in + # 15 "queries.sql" + T.set_param_Int p id; + # 15 "queries.sql" + T.finish_params p + # 15 "queries.sql" + in + # 15 "queries.sql" + T.execute db (Sqlgg_traits.Query.make ~filename:"queries.sql" ~sql:("DELETE FROM person WHERE id = @id") ~name:"erase" ~kind:Sqlgg_traits.Query.(Delete ["person"]) ()) set_params + # 61 "queries.sql.ml" + + module Single = struct + # 7 "queries.sql" + let count_persons db callback = + # 7 "queries.sql" + let invoke_callback stmt = + # 7 "queries.sql" + callback + # 7 "queries.sql" + ~r:(T.get_column_Int stmt 0) + # 7 "queries.sql" + in + # 7 "queries.sql" + T.select_one db (Sqlgg_traits.Query.make ~filename:"queries.sql" ~sql:("SELECT count(*) FROM person") ~name:"count_persons" ~kind:Sqlgg_traits.Query.(Select One) ()) T.no_params invoke_callback + # 76 "queries.sql.ml" + + end (* module Single *) + end (* module Sqlgg *) + $ ocamlfind ocamlc -package sqlgg.traits,sqlgg -c out.ml + $ echo $? + 0 + +Dynamic selects are generated through their own path -- a per-query column +module plus its `select` -- and get the same treatment: + + $ grep -n '' dyn.sql + 1:CREATE TABLE items (id INT NOT NULL PRIMARY KEY, name TEXT NULL); + 2: + 3:-- [sqlgg] dynamic_select=true + 4:-- @pick + 5:SELECT id, name + 6: FROM items + 7: WHERE id = @id; + $ sqlgg -no-header -gen caml -line-directives dyn.sql > dyn.ml + $ cat dyn.ml + module Sqlgg (T : Sqlgg_traits.M) = struct + + module IO = Sqlgg_io.Blocking + module Pick = struct + type brand + include Sqlgg_scope.Make (struct type nonrec brand = brand type row = T.row type params = T.params end) + module Cols = struct + # 5 "dyn.sql" + let id : _ t = + # 5 "dyn.sql" + { + # 5 "dyn.sql" + set = (fun _p -> ()); + # 5 "dyn.sql" + read = (fun row idx -> (T.get_column_Int row idx, idx + 1)); + # 5 "dyn.sql" + column = ("id"); + # 5 "dyn.sql" + count = 0; + # 5 "dyn.sql" + deps = []; + # 5 "dyn.sql" + } + # 25 "dyn.sql.ml" + # 5 "dyn.sql" + let name : _ t = + # 5 "dyn.sql" + { + # 5 "dyn.sql" + set = (fun _p -> ()); + # 5 "dyn.sql" + read = (fun row idx -> (T.get_column_Text_nullable row idx, idx + 1)); + # 5 "dyn.sql" + column = ("name"); + # 5 "dyn.sql" + count = 0; + # 5 "dyn.sql" + deps = []; + # 5 "dyn.sql" + } + # 42 "dyn.sql.ml" + end + include Cols + let cols = object + method id = Cols.id + method name = Cols.name + end + + # 5 "dyn.sql" + let select db (col : _ t) ~id = + # 5 "dyn.sql" + let set_params stmt = + # 5 "dyn.sql" + let p = T.start_params stmt (1 + col.count) in + # 5 "dyn.sql" + col.set p; + # 5 "dyn.sql" + T.set_param_Int p id; + # 5 "dyn.sql" + T.finish_params p + # 5 "dyn.sql" + in + # 5 "dyn.sql" + T.select_one_maybe db + # 5 "dyn.sql" + (Sqlgg_traits.Query.make ~filename:"dyn.sql" ~sql:("SELECT " ^ col.column ^ "\n\ + FROM items\n\ + WHERE id = @id") ~name:"pick" ~kind:Sqlgg_traits.Query.(Select Zero_one) ()) + # 5 "dyn.sql" + set_params (fun row -> let (__sqlgg_r_col, __sqlgg_idx_after_col) = col.read row 0 in (__sqlgg_r_col)) + # 72 "dyn.sql.ml" + + end + + + # 1 "dyn.sql" + let create_items db = + # 1 "dyn.sql" + T.execute_unprepared db (Sqlgg_traits.Query.make ~filename:"dyn.sql" ~sql:("CREATE TABLE items (id INT NOT NULL PRIMARY KEY, name TEXT NULL)") ~name:"create_items" ~kind:Sqlgg_traits.Query.(Create "items") ()) + # 81 "dyn.sql.ml" + + module Single = struct + end (* module Single *) + end (* module Sqlgg *) + $ ocamlfind ocamlc -package sqlgg.traits,sqlgg -c dyn.ml + $ echo $? + 0 + +The mapping has to hold for the whole function body, which is much longer than +the query it came from. Here `big` starts on line 9 and `after` already on 15, +while the body of `big` runs for a good deal more than six lines. Column `bad` +carries a `module=` that does not exist and is bound by the last parameter, so +the broken line sits at the very end of that body: + + $ grep -n '' long.sql + 1:CREATE TABLE wide ( + 2: c1 INT NOT NULL, c2 INT NOT NULL, c3 INT NOT NULL, c4 INT NOT NULL, + 3: c5 INT NOT NULL, c6 INT NOT NULL, c7 INT NOT NULL, c8 INT NOT NULL, + 4: -- [sqlgg] module=No_such_codec + 5: bad INT NOT NULL + 6:); + 7: + 8:-- @big + 9:UPDATE wide + 10: SET c1 = @p1, c2 = @p2, c3 = @p3, c4 = @p4, + 11: c5 = @p5, c6 = @p6, c7 = @p7, c8 = @p8 + 12: WHERE bad = @bad; + 13: + 14:-- @after + 15:DELETE FROM wide; + $ sqlgg -no-header -gen caml -line-directives long.sql > long.ml + $ cat long.ml + module Sqlgg (T : Sqlgg_traits.M) = struct + + module IO = Sqlgg_io.Blocking + + # 1 "long.sql" + let create_wide db = + # 1 "long.sql" + T.execute_unprepared db (Sqlgg_traits.Query.make ~filename:"long.sql" ~sql:("CREATE TABLE wide (\n\ + c1 INT NOT NULL, c2 INT NOT NULL, c3 INT NOT NULL, c4 INT NOT NULL,\n\ + c5 INT NOT NULL, c6 INT NOT NULL, c7 INT NOT NULL, c8 INT NOT NULL,\n\ + bad INT NOT NULL\n\ + )") ~name:"create_wide" ~kind:Sqlgg_traits.Query.(Create "wide") ()) + # 14 "long.sql.ml" + + # 9 "long.sql" + let big db ~p1 ~p2 ~p3 ~p4 ~p5 ~p6 ~p7 ~p8 ~bad = + # 9 "long.sql" + let set_params stmt = + # 9 "long.sql" + let p = T.start_params stmt (9) in + # 9 "long.sql" + T.set_param_Int p p1; + # 9 "long.sql" + T.set_param_Int p p2; + # 9 "long.sql" + T.set_param_Int p p3; + # 9 "long.sql" + T.set_param_Int p p4; + # 9 "long.sql" + T.set_param_Int p p5; + # 9 "long.sql" + T.set_param_Int p p6; + # 9 "long.sql" + T.set_param_Int p p7; + # 9 "long.sql" + T.set_param_Int p p8; + # 9 "long.sql" + T.set_param_int64 p (No_such_codec.set_param bad); + # 9 "long.sql" + T.finish_params p + # 9 "long.sql" + in + # 9 "long.sql" + T.execute db (Sqlgg_traits.Query.make ~filename:"long.sql" ~sql:("UPDATE wide\n\ + SET c1 = @p1, c2 = @p2, c3 = @p3, c4 = @p4,\n\ + c5 = @p5, c6 = @p6, c7 = @p7, c8 = @p8\n\ + WHERE bad = @bad") ~name:"big" ~kind:Sqlgg_traits.Query.(Update (Some "wide")) ()) set_params + # 49 "long.sql.ml" + + # 15 "long.sql" + let after db = + # 15 "long.sql" + T.execute_unprepared db (Sqlgg_traits.Query.make ~filename:"long.sql" ~sql:("DELETE FROM wide") ~name:"after" ~kind:Sqlgg_traits.Query.(Delete ["wide"]) ()) + # 55 "long.sql.ml" + + end (* module Sqlgg *) + +A single directive per function would have numbered the broken line past the end +of long.sql; with a shorter body it would have landed on `after`. Re-pinning +every line keeps it on 9: + + $ ocamlfind ocamlc -package sqlgg.traits,sqlgg -c long.ml 2>&1 + File "long.sql", line 9, characters 27-50: + Error: Unbound module No_such_codec + [2] + +Without the flag the same error is reported against the generated file, as before: + + $ sqlgg -no-header -gen caml long.sql > long_plain.ml + $ ocamlfind ocamlc -package sqlgg.traits,sqlgg -c long_plain.ml 2>&1 + File "long_plain.ml", line 23, characters 27-50: + 23 | T.set_param_int64 p (No_such_codec.set_param bad); + ^^^^^^^^^^^^^^^^^^^^^^^ + Error: Unbound module No_such_codec + [2] + +Migrations: `apply_*` and `revert_*` come from two separate SQL blocks and are +mapped onto their own, here lines 3 and 5 of extends.sql: + + $ grep -n '' extends.sql + 1:-- [sqlgg] manual + 2:-- [sqlgg] id=20260609000000 + 3:ALTER TABLE users + 4: RENAME COLUMN email TO email_address; + 5:ALTER TABLE users + 6: RENAME COLUMN email_address TO email; + $ sqlgg -no-header -dialect mysql -migrate -now 20260101000000 -gen caml -name migrations \ + > -line-directives -initial initial.sql -extends extends.sql -target target.sql + module Migrations (T : Sqlgg_traits.M_io) = struct + + module IO = T.IO + + # 3 "extends.sql" + let apply_alter_users_0 db = + # 3 "extends.sql" + T.execute_unprepared db (Sqlgg_traits.Query.make ~sql:("ALTER TABLE users\n\ + RENAME COLUMN email TO email_address") ~name:"apply_alter_users_0" ~kind:Sqlgg_traits.Query.Other ()) + # 11 "extends.sql.ml" + + # 5 "extends.sql" + let revert_alter_users_0 db = + # 5 "extends.sql" + T.execute_unprepared db (Sqlgg_traits.Query.make ~sql:("ALTER TABLE users\n\ + RENAME COLUMN email_address TO email") ~name:"revert_alter_users_0" ~kind:Sqlgg_traits.Query.Other ()) + # 18 "extends.sql.ml" + + let migrations = [ + ("alter_users_0", apply_alter_users_0, revert_alter_users_0); + ] + + end (* module Migrations *) + nothing new to migrate; regenerated code from 1 recorded migration(s) diff --git a/test/cram/line_directives.t/target.sql b/test/cram/line_directives.t/target.sql new file mode 100644 index 00000000..0ee8fdde --- /dev/null +++ b/test/cram/line_directives.t/target.sql @@ -0,0 +1 @@ +CREATE TABLE users (id INT NOT NULL, email_address TEXT NOT NULL);