(*---------------------------------------------------------------------------
  Copyright (c) 2026 Thomas Gazagnaire. All rights reserved.
  SPDX-License-Identifier: ISC
  ---------------------------------------------------------------------------*)

module Ast = Sql.Ast

let parse sql =
  match Sql.Lexer.parse_statements sql with
  | Ok stmts -> stmts
  | Error e -> Fmt.failwith "parse error in %S: %s" sql e

let test_desc_is_a_column_reference () =
  let col q name sql =
    match parse sql with
    | [ Ast.Select { cols = [ { expr; _ } ]; _ } ] ->
        Alcotest.(check bool) sql true (Ast.equal_expr expr (Ast.Col (q, name)))
    | _ -> Alcotest.failf "not a single-column SELECT: %s" sql
  in
  col None "desc" "SELECT desc FROM t";
  col (Some "t") "desc" "SELECT t.desc FROM t";
  col None "desc" "SELECT desc FROM pragma_index_xinfo('i')";
  (* the direction still parses after the name, and after the name alone *)
  let direction sql expected =
    match parse sql with
    | [ Ast.Select { order_by = [ (key, dir) ]; _ } ] ->
        Alcotest.(check bool)
          (sql ^ ": key") true
          (Ast.equal_expr key (Ast.Col (None, "desc")));
        Alcotest.(check bool) sql expected (dir = Ast.Desc)
    | _ -> Alcotest.failf "not a one-key ORDER BY: %s" sql
  in
  direction "SELECT desc FROM t ORDER BY desc" false;
  direction "SELECT desc FROM t ORDER BY desc DESC" true

(* [sql] does not parse, as it does not parse in sqlite3. *)
let refuses sql =
  match Sql.Lexer.parse_statements sql with
  | Error _ -> ()
  | Ok _ -> Alcotest.failf "%S parsed; expected a syntax error" sql

let test_a_pragma_value_is_a_bare_keyword () =
  let takes sql word =
    match parse sql with
    | [ Ast.Pragma { value = Some v; _ } ] ->
        Alcotest.(check bool)
          sql true
          (Catalog.Value.equal v (Catalog.Value.Text word))
    | _ -> Alcotest.failf "not a PRAGMA with a value: %s" sql
  in
  takes "PRAGMA journal_mode=delete" "delete";
  takes "PRAGMA journal_mode(delete)" "delete";
  takes "PRAGMA temp_store=default" "default";
  takes "PRAGMA synchronous=full" "full";
  takes "PRAGMA locking_mode=exclusive" "exclusive";
  takes "PRAGMA journal_mode=row" "row";
  takes "PRAGMA journal_mode=cast" "cast";
  takes "PRAGMA journal_mode=unbounded" "unbounded";
  takes "PRAGMA journal_mode=column" "column";
  takes "PRAGMA journal_mode=current_timestamp" "current_timestamp";
  (* the words already taken, which stay taken *)
  takes "PRAGMA journal_mode=wal" "wal";
  takes "PRAGMA foreign_keys=on" "on";
  refuses "PRAGMA journal_mode=select";
  refuses "PRAGMA journal_mode=from";
  refuses "PRAGMA journal_mode=not"

let test_a_pragma_value_is_a_signed_number () =
  let takes sql v =
    match parse sql with
    | [ Ast.Pragma { value = Some got; _ } ] ->
        Alcotest.(check bool) sql true (Catalog.Value.equal got v)
    | _ -> Alcotest.failf "not a PRAGMA with a value: %s" sql
  in
  takes "PRAGMA journal_mode=-1" (Catalog.Value.Int (-1L));
  takes "PRAGMA cache_size=-2000" (Catalog.Value.Int (-2000L));
  takes "PRAGMA cache_size(-2000)" (Catalog.Value.Int (-2000L));
  takes "PRAGMA cache_size=+2000" (Catalog.Value.Int 2000L);
  takes "PRAGMA journal_mode=-1.5" (Catalog.Value.Float (-1.5));
  (* the unsigned forms already taken, which stay taken *)
  takes "PRAGMA journal_mode=1" (Catalog.Value.Int 1L);
  takes "PRAGMA journal_mode='wal'" (Catalog.Value.Text "wal");
  (* NULL and a blob are no PRAGMA value *)
  refuses "PRAGMA journal_mode=NULL";
  refuses "PRAGMA journal_mode=null";
  refuses "PRAGMA journal_mode=x'00'";
  refuses "PRAGMA journal_mode=X'00'";
  refuses "PRAGMA journal_mode(NULL)";
  refuses "PRAGMA journal_mode(x'00')";
  (* and the sign is a number's, not the position's *)
  refuses "PRAGMA journal_mode=-wal";
  refuses "PRAGMA journal_mode=-'wal'"

let test_a_bare_default_is_a_string () =
  let default sql expected =
    match parse sql with
    | [ Ast.Create_table { defaults = [ (col, e) ]; _ } ] ->
        Alcotest.(check string) (sql ^ ": column") "b" col;
        Alcotest.(check bool) sql true (Ast.equal_expr e expected)
    | _ -> Alcotest.failf "not a CREATE TABLE with one default: %s" sql
  in
  let text s = Ast.Lit (Catalog.Value.Text s) in
  default "CREATE TABLE t(a, b DEFAULT c)" (text "c");
  default "CREATE TABLE t(a, b DEFAULT asc)" (text "asc");
  default "CREATE TABLE t(a, b DEFAULT unbounded)" (text "unbounded");
  default "CREATE TABLE t(a, b DEFAULT cast)" (text "cast");
  default "CREATE TABLE t(a, b DEFAULT row)" (text "row");
  (* the clause is still read left to right, so what follows it is the column's
     own, not part of the default *)
  default "CREATE TABLE t(a, b TEXT DEFAULT c NOT NULL)" (text "c");
  (* a literal still wins where one is written: NULL is a [term] *)
  default "CREATE TABLE t(a, b DEFAULT null)" (Ast.Lit Catalog.Value.Null);
  default "CREATE TABLE t(a, b DEFAULT 'c')" (text "c");
  refuses "CREATE TABLE t(a, b DEFAULT select)";
  (* and ADD COLUMN takes the same clause *)
  match parse "ALTER TABLE t ADD COLUMN d DEFAULT e" with
  | [
   Ast.Alter_table
     { op = Add_column { column = { col_default = Some e; _ }; _ }; _ };
  ] ->
      Alcotest.(check bool) "ADD COLUMN" true (Ast.equal_expr e (text "e"))
  | _ -> Alcotest.fail "not an ADD COLUMN with a default"

let test_a_keyword_names_a_written_column () =
  let assigns sql cols =
    match parse sql with
    | [ Ast.Update { sets; _ } ] ->
        Alcotest.(check (list string)) sql cols (List.map fst sets)
    | _ -> Alcotest.failf "not an UPDATE: %s" sql
  in
  let inserts sql cols =
    match parse sql with
    | [ Ast.Insert { columns; _ } ] ->
        Alcotest.(check (list string)) sql cols columns
    | _ -> Alcotest.failf "not an INSERT: %s" sql
  in
  List.iter
    (fun w ->
      assigns (Fmt.str "UPDATE t SET %s = 1" w) [ w ];
      inserts (Fmt.str "INSERT INTO t(%s) VALUES(1)" w) [ w ])
    [
      "row";
      "rows";
      "desc";
      "asc";
      "key";
      "cast";
      "unbounded";
      "column";
      "action";
      "current_timestamp";
      "with";
      "replace";
    ];
  assigns "UPDATE t SET row = 1, desc = 2" [ "row"; "desc" ];
  inserts "INSERT INTO t(row, desc) VALUES(1, 2)" [ "row"; "desc" ];
  (* the upsert names the same two positions *)
  (match
     parse "INSERT INTO t(row) VALUES(1) ON CONFLICT(row) DO UPDATE SET row = 2"
   with
  | [ Ast.Insert { upsert = Some { target; action = Update (sets, _); _ }; _ } ]
    ->
      Alcotest.(check (list string)) "conflict target" [ "row" ] target;
      Alcotest.(check (list string))
        "upsert assignment" [ "row" ] (List.map fst sets)
  | _ -> Alcotest.fail "not an INSERT with a DO UPDATE upsert");
  (* and so does a foreign key's column list *)
  (match parse "CREATE TABLE t(a, FOREIGN KEY(row) REFERENCES u(row))" with
  | [ Ast.Create_table { foreign_keys = [ fk ]; _ } ] ->
      Alcotest.(check (list string)) "child columns" [ "row" ] fk.cols;
      Alcotest.(check (list string)) "parent columns" [ "row" ] fk.parent_cols
  | _ -> Alcotest.fail "not a CREATE TABLE with one foreign key");
  refuses "UPDATE t SET select = 1";
  refuses "INSERT INTO t(select) VALUES(1)"

let test_a_keyword_names_an_object () =
  let created sql name =
    match parse sql with
    | [ Ast.Create_table { tbl_name; _ } ] ->
        Alcotest.(check string) sql name tbl_name
    | _ -> Alcotest.failf "not a CREATE TABLE: %s" sql
  in
  let indexed sql name table =
    match parse sql with
    | [ Ast.Create_index i ] ->
        Alcotest.(check string) (sql ^ ": index") name i.name;
        Alcotest.(check string) (sql ^ ": table") table i.table
    | _ -> Alcotest.failf "not a CREATE INDEX: %s" sql
  in
  let renamed sql old_name new_name =
    match parse sql with
    | [ Ast.Alter_table { op = Rename_column (o, n); _ } ] ->
        Alcotest.(check string) (sql ^ ": old") old_name o;
        Alcotest.(check string) (sql ^ ": new") new_name n
    | _ -> Alcotest.failf "not a RENAME COLUMN: %s" sql
  in
  let dropped sql name =
    match parse sql with
    | [ Ast.Drop { object_ = Table; name = n; if_exists = false } ] ->
        Alcotest.(check string) sql name n
    | _ -> Alcotest.failf "not a DROP TABLE: %s" sql
  in
  let triggered sql name table =
    match parse sql with
    | [ Ast.Create_trigger tg ] ->
        Alcotest.(check string) (sql ^ ": trigger") name tg.name;
        Alcotest.(check string) (sql ^ ": table") table tg.table
    | _ -> Alcotest.failf "not a CREATE TRIGGER: %s" sql
  in
  let inserted sql table =
    match parse sql with
    | [ Ast.Insert { table = t; _ } ] -> Alcotest.(check string) sql table t
    | _ -> Alcotest.failf "not an INSERT: %s" sql
  in
  let scanned sql name =
    match parse sql with
    | [ Ast.Select { from = Table tr; _ } ] ->
        Alcotest.(check string) sql name tr.name
    | _ -> Alcotest.failf "not a SELECT over one named table: %s" sql
  in
  (* parse.y's [%fallback ID] lists DEFERRED, IMMEDIATE and EXCLUSIVE: the
     transaction types BEGIN takes name objects too *)
  List.iter
    (fun w ->
      created (Fmt.str "CREATE TABLE %s(a)" w) w;
      indexed (Fmt.str "CREATE INDEX %s ON t(a)" w) w "t";
      indexed (Fmt.str "CREATE INDEX i ON %s(a)" w) "i" w;
      renamed (Fmt.str "ALTER TABLE t RENAME COLUMN a TO %s" w) "a" w;
      dropped (Fmt.str "DROP TABLE %s" w) w;
      triggered
        (Fmt.str "CREATE TRIGGER %s AFTER INSERT ON t BEGIN SELECT 1; END" w)
        w "t";
      inserted (Fmt.str "INSERT INTO %s VALUES (1)" w) w;
      scanned (Fmt.str "SELECT * FROM %s" w) w)
    [ "row"; "after"; "replace"; "deferred"; "immediate"; "exclusive" ];
  (* the table a trigger guards is the same position, and so is a rename's
     target: an object created under the word is reachable under it *)
  triggered "CREATE TRIGGER g AFTER INSERT ON row BEGIN SELECT 1; END" "g" "row";
  (match parse "ALTER TABLE row RENAME TO after" with
  | [ Ast.Alter_table { table; op = Rename_table n } ] ->
      Alcotest.(check string) "ALTER TABLE: table" "row" table;
      Alcotest.(check string) "RENAME TO: new name" "after" n
  | _ -> Alcotest.fail "not an ALTER TABLE ... RENAME TO");
  (* a reserved word names no object, here as there *)
  refuses "CREATE TABLE select(a)";
  refuses "CREATE TABLE from(a)";
  refuses "CREATE INDEX select ON t(a)";
  refuses "SELECT * FROM select"

(* lang_transaction.html: [BEGIN [DEFERRED | IMMEDIATE | EXCLUSIVE]
   [TRANSACTION]]; parse.y, [cmd ::= BEGIN transtype trans_opt]. Each form is
   one statement, and keywords are case-insensitive (lang_keywords.html). *)
let test_begin_takes_a_transaction_type () =
  let one sql =
    match parse sql with
    | [ _ ] -> ()
    | _ -> Alcotest.failf "not one statement: %s" sql
  in
  List.iter
    (fun ty ->
      List.iter one
        [
          Fmt.str "BEGIN %s" ty;
          Fmt.str "BEGIN %s TRANSACTION" ty;
          Fmt.str "begin %s" (String.lowercase_ascii ty);
          Fmt.str "begin %s transaction" (String.lowercase_ascii ty);
        ])
    [ "DEFERRED"; "IMMEDIATE"; "EXCLUSIVE" ];
  List.iter one [ "BEGIN"; "BEGIN TRANSACTION"; "begin"; "begin transaction" ]

(* parse.y: [transtype] is one optional token of DEFERRED, IMMEDIATE and
   EXCLUSIVE; sqlite3 refuses any other word there, and two of them. *)
let test_begin_refuses_another_transaction_type () =
  refuses "BEGIN SOON";
  refuses "begin soon";
  refuses "BEGIN SOON TRANSACTION";
  refuses "BEGIN DEFERRED IMMEDIATE";
  refuses "BEGIN IMMEDIATE EXCLUSIVE TRANSACTION"

(* parse.y: [transtype ::= .] is [TK_DEFERRED], and each of DEFERRED,
   IMMEDIATE and EXCLUSIVE is its own [transtype]: three statements, and a
   plain BEGIN is BEGIN DEFERRED. *)
let test_begin_names_its_transaction_type () =
  let begins sql =
    match parse sql with
    | [ Ast.Begin Ast.Deferred ] -> "DEFERRED"
    | [ Ast.Begin Ast.Immediate ] -> "IMMEDIATE"
    | [ Ast.Begin Ast.Exclusive ] -> "EXCLUSIVE"
    | _ -> Alcotest.failf "not one BEGIN: %s" sql
  in
  let is expected sql = Alcotest.(check string) sql expected (begins sql) in
  List.iter (is "DEFERRED")
    [
      "BEGIN";
      "BEGIN TRANSACTION";
      "BEGIN DEFERRED";
      "BEGIN DEFERRED TRANSACTION";
      "begin deferred";
    ];
  List.iter (is "IMMEDIATE")
    [ "BEGIN IMMEDIATE"; "BEGIN IMMEDIATE TRANSACTION"; "begin immediate" ];
  List.iter (is "EXCLUSIVE")
    [ "BEGIN EXCLUSIVE"; "BEGIN EXCLUSIVE TRANSACTION"; "begin exclusive" ]

let suite =
  ( "parser",
    [
      Alcotest.test_case "desc is a column reference" `Quick
        test_desc_is_a_column_reference;
      Alcotest.test_case "a PRAGMA value is a bare keyword" `Quick
        test_a_pragma_value_is_a_bare_keyword;
      Alcotest.test_case "a PRAGMA value is a signed number" `Quick
        test_a_pragma_value_is_a_signed_number;
      Alcotest.test_case "a bare DEFAULT word is a string" `Quick
        test_a_bare_default_is_a_string;
      Alcotest.test_case "a keyword names a written column" `Quick
        test_a_keyword_names_a_written_column;
      Alcotest.test_case "a keyword names an object" `Quick
        test_a_keyword_names_an_object;
      Alcotest.test_case "BEGIN takes a transaction type" `Quick
        test_begin_takes_a_transaction_type;
      Alcotest.test_case "BEGIN refuses another transaction type" `Quick
        test_begin_refuses_another_transaction_type;
      Alcotest.test_case "BEGIN names its transaction type" `Quick
        test_begin_names_its_transaction_type;
    ] )