From 6b377719c10d5ab3343fd5221f99a4a21008e25a Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Thu, 14 Mar 2024 08:26:58 +0100 Subject: Initial commit --- lib/sql/date.ml | 24 ++++ lib/sql/db.ml | 383 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ lib/sql/db.mli | 106 +++++++++++++++ lib/sql/dune | 15 +++ lib/sql/hashs.ml | 79 +++++++++++ lib/sql/header.ml | 74 +++++++++++ lib/sql/join.ml | 30 +++++ lib/sql/match.ml | 22 ++++ lib/sql/math.ml | 20 +++ lib/sql/t.ml | 52 ++++++++ lib/sql/trim.ml | 9 ++ lib/sql/year.ml | 19 +++ 12 files changed, 833 insertions(+) create mode 100644 lib/sql/date.ml create mode 100644 lib/sql/db.ml create mode 100644 lib/sql/db.mli create mode 100644 lib/sql/dune create mode 100644 lib/sql/hashs.ml create mode 100644 lib/sql/header.ml create mode 100644 lib/sql/join.ml create mode 100644 lib/sql/match.ml create mode 100644 lib/sql/math.ml create mode 100644 lib/sql/t.ml create mode 100644 lib/sql/trim.ml create mode 100644 lib/sql/year.ml (limited to 'lib/sql') diff --git a/lib/sql/date.ml b/lib/sql/date.ml new file mode 100644 index 0000000..e8933c7 --- /dev/null +++ b/lib/sql/date.ml @@ -0,0 +1,24 @@ +(** Parse a text value into a date *) + +let first_day = CalendarLib.Date.make 1899 12 30 + +let f : Sqlite3.Data.t -> Sqlite3.Data.t -> Sqlite3.Data.t = + fun str data -> + match (str, data) with + | Sqlite3.Data.TEXT format_, Sqlite3.Data.TEXT content -> ( + try + let date = CalendarLib.Printer.Date.from_fstring format_ content in + let period = + CalendarLib.Date.sub date first_day + |> CalendarLib.Date.Period.nb_days |> Int64.of_int + in + Sqlite3.Data.INT period + with + | Invalid_argument e -> + prerr_endline e; + Sqlite3.Data.NULL) + | _ -> + (* If the data is already a date, it should be preserved as is *) + data + +let register : Sqlite3.db -> unit = fun db -> Sqlite3.create_fun2 db "date" f diff --git a/lib/sql/db.ml b/lib/sql/db.ml new file mode 100644 index 0000000..89431b1 --- /dev/null +++ b/lib/sql/db.ml @@ -0,0 +1,383 @@ +open StdLabels +module CSV = ImportCSV +module Syntax = ImportConf.Syntax +module Table = ImportDataTypes.Table +module Path = ImportDataTypes.Path + +type 'a t = 'a T.t + +let ( let* ) res cont = Result.bind (T.to_result res) cont +let ( let** ) res cont = Result.bind res cont +let begin_transaction = T.begin_transaction +let rollback = T.rollback +let commit = T.commit +let finalize = T.finalize +let reset = T.reset +let insert_header = Header.insert_header +let query_headers = Header.query_headers + +let with_db : string -> (Sqlite3.db -> unit T.result) -> unit T.result = + fun filename f -> + let db = Sqlite3.db_open filename in + + Match.register db; + Date.register db; + Year.register db; + Join.register db; + Math.register db; + Trim.register db; + + (*let* _ = Sqlite3.exec db "PRAGMA foreign_keys = ON" |> to_result in*) + Sqlite3.( let& ) db f + +let create_table : 'a t -> ImportAnalyser.Dependency.t -> unit T.result = + fun db table -> + let source = ImportAnalyser.Dependency.table table in + let name = Table.name source in + + let* _ = + Sqlite3.exec db + (String.concat ~sep:"" [ "DROP TABLE IF EXISTS '"; name; "'" ]) + in + + let query = ImportAnalyser.Query.create_table table in + let* _ = Sqlite3.exec db query in + match Header.create_table db with + | Ok () -> Hashs.create_table db + | e -> e + +let update_hash : 'a t -> ImportAnalyser.Dependency.t -> unit T.result = + fun db mapping -> + match Hashs.insert db mapping with + | Ok () -> Ok () + | Error _ -> + let _ = Hashs.create_table db in + Hashs.insert db mapping + +let check_table_schema : 'a t -> ImportAnalyser.Dependency.t -> bool T.result = + fun db table -> + let source = ImportAnalyser.Dependency.table table in + let name = Table.name source in + let query = + String.concat ~sep:"" + [ "SELECT sql FROM sqlite_schema WHERE name = '"; name; "'" ] + in + let stmt = Sqlite3.prepare db query in + + let rc, result = + Sqlite3.fold stmt ~init:false ~f:(fun value row -> + if Array.length row <> 1 then value + else + match Sqlite3.Data.to_string (Array.get row 0) with + | Some s -> + let query = ImportAnalyser.Query.create_table table in + String.equal s query + | None -> value) + in + let* _ = rc in + + (* The schema is the same, now check the hash in case the indexes changed *) + let rc_hash = Hashs.query db source in + match rc_hash with + | Ok (Some i) -> + let hash = Hashs.evaluate table in + begin + if i == hash then Ok result + else + let _ = update_hash db table in + Ok false + end + | _ -> + let _ = update_hash db table in + Ok result + +let prepare_insert : + Sqlite3.db -> ImportAnalyser.Dependency.t -> Sqlite3.stmt T.result = + fun db mapping -> + (* Get the list of columns from the table configuration *) + let columns = + ImportAnalyser.Dependency.columns mapping + |> ImportContainers.IntSet.elements + in + let table_name = Table.name (ImportAnalyser.Dependency.table mapping) in + + let open Buffer in + let buff = create 20 and value_buff = create 10 and col_buff = create 10 in + + add_string col_buff "'id',"; + + (* Add the key name if present *) + List.iter (ImportAnalyser.Dependency.keys mapping) + ~f:(fun { ImportAnalyser.Dependency.name; _ } -> + add_string col_buff "'key_"; + + add_string col_buff name; + add_string col_buff "',"); + + add_string value_buff ":id,"; + + (* Add the key settings if presents *) + List.iter (ImportAnalyser.Dependency.keys mapping) ~f:(fun key -> + ImportAnalyser.Query.build_key_insert value_buff key; + add_string value_buff ","); + + List.iter columns ~f:(fun id -> + add_string col_buff "'col_"; + add_string col_buff (string_of_int id); + add_string col_buff "',"; + + let col_name = ":col_" ^ string_of_int id in + + add_string value_buff col_name; + add_string value_buff ","); + + truncate col_buff (length col_buff - 1); + truncate value_buff (length value_buff - 1); + add_string buff "INSERT INTO '"; + add_string buff table_name; + add_string buff "' ("; + add_buffer buff col_buff; + add_string buff " ) VALUES ("; + add_buffer buff value_buff; + add_string buff " )"; + + let query = contents buff in + + try Ok (Sqlite3.prepare db query) with + | e -> + print_endline "Error during this query :"; + print_endline query; + Error e + +let eval_key : + 'a t -> + Sqlite3.stmt option -> + ImportAnalyser.Dependency.key list -> + (int * CSV.DataType.t) list -> + (Sqlite3.stmt option * Sqlite3.Data.t list) T.result = + fun db stmt keys values -> + match keys with + | [] -> Ok (None, []) + | _ -> + let buffer = Buffer.create 16 in + Buffer.add_string buffer "SELECT "; + List.iter keys ~f:(fun key -> + ImportAnalyser.Query.build_key_insert buffer key; + Buffer.add_string buffer ","); + + Buffer.truncate buffer (Buffer.length buffer - 1); + let query = Buffer.contents buffer in + + let statement = Sqlite3.prepare_or_reset db (ref stmt) query in + + (* Extract all the column id used in the keys. + *) + let keys_id = + List.fold_left keys ~init:ImportContainers.IntSet.empty + ~f:(fun acc (keys : ImportAnalyser.Dependency.key) -> + let columns = Lazy.force keys.ImportAnalyser.Dependency.columns in + ImportContainers.IntSet.union acc columns) + in + + let** _ = + List.fold_left values ~init:(Ok 1) ~f:(fun idx (id, value) -> + let** idx = idx in + + (* Ensure the column is required in the keys *) + match ImportContainers.IntSet.mem (1 + id) keys_id with + | false -> Ok (idx + 1) + | true -> + let sql_data = T.of_datatype value in + + let col_name = ":col_" ^ string_of_int (1 + id) in + let* _ = Sqlite3.bind_name statement col_name sql_data in + Ok (idx + 1)) + in + + let result, evaluated_keys = + Sqlite3.fold statement ~init:[] ~f:(fun _ v -> Array.to_list v) + in + let* _ = result in + Ok (Some statement, evaluated_keys) + +let insert : + Sqlite3.db -> + Sqlite3.stmt -> + id:int -> + (int * CSV.DataType.t) list -> + unit T.result = + fun db statement ~id values -> + let** _ = T.savepoint db "PREVIOUS" in + let* _ = + Sqlite3.bind_name statement ":id" (Sqlite3.Data.INT (Int64.of_int id)) + in + let** _ = + List.fold_left values ~init:(Ok 1) ~f:(fun idx (id, value) -> + let** idx = idx in + let sql_data = T.of_datatype value in + + let col_name = ":col_" ^ string_of_int (1 + id) in + let* _ = Sqlite3.bind_name statement col_name sql_data in + + Ok (idx + 1)) + in + + match T.to_result (Sqlite3.step statement) with + | Ok () -> T.release db "PREVIOUS" + | Error e -> + (* I intentionnaly ignore any error here, as we are already in an + error case *) + ignore (Sqlite3.exec db "ROLLBACK TRANSACTION TO SAVEPOINT PREVIOUS"); + Error e + +(** This simple function convert a query generated by the application into a + statement executed with sqlite. + + The function expect a perfect match between the query and the parameters. *) +let execute_query : + Sqlite3.db -> ImportAnalyser.Query.query -> Sqlite3.stmt T.result = + fun db query -> + let statement = + try Sqlite3.prepare db query.q with + | e -> + print_endline "Error during this query :"; + print_endline query.q; + raise e + in + + (* Add the binded parameters *) + let values = + Seq.map (fun v -> T.of_datatype v) query.parameters |> List.of_seq + in + + let* _ = Sqlite3.bind_values statement values in + + Ok statement + +let query : + f:((Path.t ImportExpression.T.t * CSV.DataType.t) array -> unit) -> + Sqlite3.db -> + Syntax.t -> + unit T.result = + fun ~f db output -> + (* Extract the query from the configuration. *) + let** query_analysis = + match ImportAnalyser.Query.select output with + | exception e -> Error e + | other -> Ok other + in + + let query, columns = query_analysis in + let** statement = execute_query db query in + + let* _ = + Sqlite3.iter statement ~f:(fun data -> + let values = + Array.map2 data columns ~f:(fun value column -> + (column, T.to_datatype value)) + in + f values) + in + Ok () + +let create_view : Sqlite3.db -> Syntax.t -> unit T.result = + fun db output -> + ignore output; + let* drop = Sqlite3.exec db "DROP VIEW IF EXISTS 'result'" in + ignore drop; + + Ok () + +(* + let query, _ = ImportAnalyser.Query.select output in + + let query = + { query with q = Printf.sprintf "CREATE VIEW result AS %s" query.q } + in + let** statement = execute_query db query in + + Sqlite3.step statement |> T.to_result + *) + +let check_foreign : + f:((string * CSV.DataType.t) array -> unit) -> + Sqlite3.db -> + Syntax.t -> + Syntax.extern -> + unit T.result = + fun ~f db conf external_ -> + let query = ImportAnalyser.Query.check_external conf external_ in + + let** statement = execute_query db query in + Sqlite3.iter statement ~f:(fun data -> + let values = + Array.mapi data ~f:(fun i value -> + (Sqlite3.column_name statement i, T.to_datatype value)) + in + f values) + |> T.to_result + +let clear_duplicates : + f:((string * ImportCSV.DataType.t) array -> unit) -> + 'a t -> + ImportDataTypes.Table.t -> + ImportAnalyser.Dependency.key list -> + unit T.result = + fun ~f db table keys -> + let table_name = Table.name table in + + List.fold_left keys ~init:(Ok ()) + ~f:(fun state { ImportAnalyser.Dependency.name; _ } -> + let** _ = state in + + let select_query = + String.concat ~sep:"" + [ + "SELECT '"; + table_name; + "'.id, '"; + table_name; + "'.'key_"; + name; + "', '"; + name; + "' FROM '"; + table_name; + "' INNER JOIN (SELECT id, row_number() OVER(PARTITION BY '"; + table_name; + "'.'key_"; + name; + "' ORDER BY (id)) AS row_num from '"; + table_name; + "') other_table WHERE other_table.row_num <> 1 and '"; + table_name; + "'.id = other_table.id"; + ] + in + let stmt = Sqlite3.prepare db select_query in + + ignore + @@ Sqlite3.iter stmt ~f:(fun data -> + let values = + Array.mapi data ~f:(fun i value -> + (Sqlite3.column_name stmt i, T.to_datatype value)) + in + f values); + + let delete_query = + Printf.sprintf + {|UPDATE '%s' +SET key_%s = NULL +FROM +( + SELECT id, row_number() OVER(PARTITION BY key_%s ORDER BY (id)) AS row_num + from '%s' +) other_table +WHERE other_table.row_num <> 1 +and '%s'.id = other_table.id|} + table_name name name table_name table_name + in + + Sqlite3.exec db delete_query |> T.to_result) + +type 'a result = ('a, exn) Result.t diff --git a/lib/sql/db.mli b/lib/sql/db.mli new file mode 100644 index 0000000..465b159 --- /dev/null +++ b/lib/sql/db.mli @@ -0,0 +1,106 @@ +module Syntax = ImportConf.Syntax + +type 'a t +type 'a result = ('a, exn) Result.t + +val with_db : string -> ('a t -> unit result) -> unit result + +val check_table_schema : 'a t -> ImportAnalyser.Dependency.t -> bool result +(** Check if a table with the same structure already exists in the database. + + This query allow to reuse the same data without reloading the file if + nothing changed. *) + +val create_table : 'a t -> ImportAnalyser.Dependency.t -> unit result +(** [create_table db name] will create a new table in the + db with the given name, and the columns from the configuration (see + [ImportAnalyser.Query.create_table]) + + Any previous table with the same name will be deleted. *) + +val prepare_insert : 'a t -> ImportAnalyser.Dependency.t -> Sqlite3.stmt result +(** Create a statement to use in an insert. + [prepare_insert db table] will prepare a statement for inserting + the columns at the given index. *) + +val finalize : Sqlite3.stmt -> unit result +(** Finalize the statement. The function shall be called once each insert are + done, or after an error in the insert. *) + +val reset : Sqlite3.stmt -> unit result + +val eval_key : + 'a t -> + Sqlite3.stmt option -> + ImportAnalyser.Dependency.key list -> + (int * ImportCSV.DataType.t) list -> + (Sqlite3.stmt option * Sqlite3.Data.t list) result +(** Evaluate the keys in sqlite and get the results. + + The function is intended to check if the values are null before inserting + them in a batch *) + +val insert : + 'a t -> + Sqlite3.stmt -> + id:int -> + (int * ImportCSV.DataType.t) list -> + unit result +(** Insert a new row in the database. + + [insert db ~id statement values] will add a new row in the given table with + [id]. The columns are identified with their index number (there is a + difference by one with the column number) + + Thanks to SQLite Flexible Typing (https://www.sqlite.org/flextypegood.html) + each column can contain values typed differently which is how the spreadsheet + also works. + + This function is expected to be run inside a transaction. *) + +val begin_transaction : 'a t -> unit result +val commit : 'a t -> unit result +val rollback : 'a t -> unit result + +val query : + f: + ((ImportDataTypes.Path.t ImportExpression.T.t * ImportCSV.DataType.t) array -> + unit) -> + 'a t -> + Syntax.t -> + unit result +(** This one the most important function from the application. The function + will transform the configuration into an sql query and will fetch the + result from the sqlite engine. + + The function [f] given in argument will be called for each line + + *) + +val create_view : 'a t -> Syntax.t -> unit result +(** Create a view which represent the result *) + +val check_foreign : + f:((string * ImportCSV.DataType.t) array -> unit) -> + 'a t -> + Syntax.t -> + Syntax.extern -> + unit result + +val clear_duplicates : + f:((string * ImportCSV.DataType.t) array -> unit) -> + 'a t -> + ImportDataTypes.Table.t -> + ImportAnalyser.Dependency.key list -> + unit result +(** Remove all duplicated keys in the table by setting them to NULL. *) + +val insert_header : + 'a t -> + ImportDataTypes.Table.t -> + (int * ImportCSV.DataType.t) array -> + unit T.result + +val query_headers : + 'a t -> ImportDataTypes.Table.t -> ImportCSV.DataType.t array T.result +(** Get all the headers from the database (used or not) *) diff --git a/lib/sql/dune b/lib/sql/dune new file mode 100644 index 0000000..9f9f205 --- /dev/null +++ b/lib/sql/dune @@ -0,0 +1,15 @@ +(library + (name importSQL) + (libraries + re + sqlite3 + calendar + importAnalyser + importCSV + importConf + importContainers + importDataTypes + importErrors + importExpression + ) +) diff --git a/lib/sql/hashs.ml b/lib/sql/hashs.ml new file mode 100644 index 0000000..af1f092 --- /dev/null +++ b/lib/sql/hashs.ml @@ -0,0 +1,79 @@ +(** + This module store the hash of the indexes ([extern_key]) for each table in + order to update the file if the configuration changed. + + The hashes are stored in a table named [hashes] and are evaluated just + before inserting the values. +*) + +open StdLabels +module Table = ImportDataTypes.Table + +let ( let* ) = Result.bind + +let create_table : 'a T.t -> unit T.result = + fun db -> + Sqlite3.exec db + "CREATE TABLE IF NOT EXISTS 'hashes' ('table' TEXT, 'hash' INTEGER, \ + PRIMARY KEY ('table'))" + |> T.to_result + +let evaluate : ImportAnalyser.Dependency.t -> int = + fun table -> + (* Extract all the references to this table *) + let keys = + List.map (ImportAnalyser.Dependency.keys table) + ~f:(fun ImportAnalyser.Dependency.{ name; columns; expression } -> + ignore columns; + (name, expression)) + in + Hashtbl.hash keys + +let insert : 'a T.t -> ImportAnalyser.Dependency.t -> unit T.result = + fun db table -> + let source = ImportAnalyser.Dependency.table table in + let table_name = Table.name source in + + let hash = evaluate table in + + let query = + String.concat ~sep:"" + [ + "INSERT INTO 'hashes' ('table', 'hash') VALUES ('"; + table_name; + "', :hash) ON CONFLICT(hashes.'table') DO UPDATE SET 'hash' = :hash"; + ] + in + let* statement = + try Ok (Sqlite3.prepare db query) with + | e -> Error e + in + + let* _ = T.begin_transaction db in + let sql_data = Sqlite3.Data.INT (Int64.of_int hash) in + + let* _ = Sqlite3.bind_name statement ":hash" sql_data |> T.to_result in + let* _ = T.to_result (Sqlite3.step statement) in + T.commit db + +let query : 'a T.t -> ImportDataTypes.Table.t -> int option T.result = + fun db table -> + let table_name = Table.name table in + let query = + String.concat ~sep:"" + [ "SELECT hash FROM 'hashes' WHERE hashes.'table' = '"; table_name; "'" ] + in + + let* stmt = + try Ok (Sqlite3.prepare db query) with + | e -> Error e + in + let state, res = + Sqlite3.fold stmt ~init:None ~f:(fun _ d -> + Some (T.to_datatype (Array.get d 0))) + in + + let* _ = T.to_result state in + match res with + | Some (ImportCSV.DataType.Integer i) -> Ok (Some i) + | _ -> Ok None diff --git a/lib/sql/header.ml b/lib/sql/header.ml new file mode 100644 index 0000000..3cac5fb --- /dev/null +++ b/lib/sql/header.ml @@ -0,0 +1,74 @@ +open StdLabels +module Table = ImportDataTypes.Table + +let ( let* ) = Result.bind + +let create_table : 'a T.t -> unit T.result = + fun db -> + Sqlite3.exec db + "CREATE TABLE IF NOT EXISTS 'header' ('table' TEXT, 'column' INTEGER, \ + 'label', PRIMARY KEY ('table', 'column'))" + |> T.to_result + +let insert_header : + 'a T.t -> + ImportDataTypes.Table.t -> + (int * ImportCSV.DataType.t) array -> + unit T.result = + fun db table values -> + let table_name = Table.name table in + + let query = + String.concat ~sep:"" + [ + "INSERT INTO 'header' ('table', 'column', 'label') VALUES ('"; + table_name; + "', :column, :label) ON CONFLICT(header.'table', header.'column') DO \ + UPDATE SET 'label' = :label"; + ] + in + + let statement = Sqlite3.prepare db query in + + let* _ = T.begin_transaction db in + let* _ = + Array.fold_left values ~init:(Ok ()) ~f:(fun acc (column, value) -> + let* _ = acc in + let sql_data = T.of_datatype value in + let* _ = Sqlite3.bind_name statement ":label" sql_data |> T.to_result in + + let* _ = + Sqlite3.bind_name statement ":column" + (Sqlite3.Data.INT (Int64.of_int column)) + |> T.to_result + in + let* _ = T.to_result (Sqlite3.step statement) in + T.reset statement) + in + T.commit db + +let query_headers : + 'a T.t -> ImportDataTypes.Table.t -> ImportCSV.DataType.t array T.result = + fun db table -> + let table_name = Table.name table in + let query = + String.concat ~sep:"" + [ + "SELECT label FROM 'header' WHERE header.'table' = '"; + table_name; + "' ORDER BY column DESC"; + ] + in + + let* stmt = + try Ok (Sqlite3.prepare db query) with + | e -> Error e + in + let state, res = + Sqlite3.fold stmt ~init:[] ~f:(fun acc d -> + let value = T.to_datatype (Array.get d 0) in + value :: acc) + in + + let* _ = T.to_result state in + Ok (Array.of_list res) diff --git a/lib/sql/join.ml b/lib/sql/join.ml new file mode 100644 index 0000000..3f82b92 --- /dev/null +++ b/lib/sql/join.ml @@ -0,0 +1,30 @@ +module D = Sqlite3.Data + +let f : Sqlite3.Data.t array -> Sqlite3.Data.t = + fun arguments -> + if Array.length arguments < 2 then Sqlite3.Data.NULL + else + let sep = Array.get arguments 0 in + + (* Shift all the elements into an list*) + let contents = + Array.to_seqi arguments + |> Seq.filter_map (fun (i, value) -> + if i = 0 then None + else + match value with + | D.INT i -> Some (Int64.to_string i) + | D.FLOAT f -> Some (Float.to_string f) + | D.NONE -> None + | D.NULL -> None + | D.TEXT s | D.BLOB s -> + if String.length s = 0 then None else Some (String.trim s)) + |> List.of_seq + in + + D.TEXT (String.concat (D.to_string_coerce sep) contents) + +let register : Sqlite3.db -> unit = + fun db -> + Sqlite3.create_funN db "join" f; + Sqlite3.create_funN db "concat" f diff --git a/lib/sql/match.ml b/lib/sql/match.ml new file mode 100644 index 0000000..82fc1da --- /dev/null +++ b/lib/sql/match.ml @@ -0,0 +1,22 @@ +let f : Sqlite3.Data.t -> Sqlite3.Data.t -> Sqlite3.Data.t = + let memo = Hashtbl.create 16 in + fun str data_1 -> + match (str, data_1) with + | Sqlite3.Data.TEXT s, Sqlite3.Data.TEXT content -> ( + let regex = + match Hashtbl.find_opt memo s with + | None -> + let regex = Re.Posix.compile_pat s in + Hashtbl.add memo s regex; + regex + | Some v -> v + in + + match Re.exec_opt regex content with + | None -> Sqlite3.Data.NULL + | Some g -> + let matched = Re.Group.get g 1 in + Sqlite3.Data.TEXT matched) + | _, _ -> data_1 + +let register : Sqlite3.db -> unit = fun db -> Sqlite3.create_fun2 db "match" f diff --git a/lib/sql/math.ml b/lib/sql/math.ml new file mode 100644 index 0000000..576d9f6 --- /dev/null +++ b/lib/sql/math.ml @@ -0,0 +1,20 @@ +(** Math functions *) + +let int : Sqlite3.Data.t -> Sqlite3.Data.t = + fun data -> + match data with + (* If the data is already an int, do not change it *) + | Sqlite3.Data.INT _ -> data + | Sqlite3.Data.FLOAT content -> Sqlite3.Data.INT (Int64.of_float content) + | Sqlite3.Data.BLOB content | Sqlite3.Data.TEXT content -> begin + match Int64.of_string_opt content with + | Some i -> Sqlite3.Data.INT i + | None -> begin + match Float.of_string_opt content with + | Some f -> Sqlite3.Data.INT (Int64.of_float f) + | None -> Sqlite3.Data.NULL + end + end + | _ -> Sqlite3.Data.NULL + +let register : Sqlite3.db -> unit = fun db -> Sqlite3.create_fun1 db "int" int diff --git a/lib/sql/t.ml b/lib/sql/t.ml new file mode 100644 index 0000000..202c535 --- /dev/null +++ b/lib/sql/t.ml @@ -0,0 +1,52 @@ +exception SqlError of Sqlite3.Rc.t + +type 'a t = Sqlite3.db +type 'a result = ('a, exn) Result.t + +let to_result : Sqlite3.Rc.t -> unit result = function + | Sqlite3.Rc.OK | Sqlite3.Rc.DONE -> Ok () + | res -> Error (SqlError res) + +let begin_transaction : Sqlite3.db -> unit result = + fun db -> + let query = "BEGIN" in + Sqlite3.exec db query |> to_result + +let commit : Sqlite3.db -> unit result = + fun db -> + let query = "COMMIT" in + Sqlite3.exec db query |> to_result + +let rollback : Sqlite3.db -> unit result = + fun db -> + let query = "ROLLBACK" in + Sqlite3.exec db query |> to_result + +let savepoint : Sqlite3.db -> string -> unit result = + fun db name -> + let query = "SAVEPOINT " ^ name in + Sqlite3.exec db query |> to_result + +let release : Sqlite3.db -> string -> unit result = + fun db name -> + let query = "RELEASE SAVEPOINT " ^ name in + Sqlite3.exec db query |> to_result + +let finalize : Sqlite3.stmt -> unit result = + fun statement -> to_result (Sqlite3.finalize statement) + +let reset : Sqlite3.stmt -> unit result = + fun statement -> to_result (Sqlite3.reset statement) + +let of_datatype = function + | ImportCSV.DataType.Float f -> Sqlite3.Data.FLOAT f + | ImportCSV.DataType.Integer i -> Sqlite3.Data.INT (Int64.of_int i) + | ImportCSV.DataType.Null -> Sqlite3.Data.NULL + | ImportCSV.DataType.Error _ -> Sqlite3.Data.NULL + | ImportCSV.DataType.Content s -> Sqlite3.Data.TEXT s + +let to_datatype : Sqlite3.Data.t -> ImportCSV.DataType.t = function + | Sqlite3.Data.NONE | Sqlite3.Data.NULL -> ImportCSV.DataType.Null + | Sqlite3.Data.INT i -> ImportCSV.DataType.Integer (Int64.to_int i) + | Sqlite3.Data.FLOAT f -> ImportCSV.DataType.Float f + | Sqlite3.Data.TEXT t | Sqlite3.Data.BLOB t -> ImportCSV.DataType.Content t diff --git a/lib/sql/trim.ml b/lib/sql/trim.ml new file mode 100644 index 0000000..4e4bcf4 --- /dev/null +++ b/lib/sql/trim.ml @@ -0,0 +1,9 @@ +(* Override the trim function with another which also remove the retchar *) + +let f : Sqlite3.Data.t -> Sqlite3.Data.t = + fun data -> + match data with + | Sqlite3.Data.TEXT content -> Sqlite3.Data.TEXT (String.trim content) + | _ -> data + +let register : Sqlite3.db -> unit = fun db -> Sqlite3.create_fun1 db "trim" f diff --git a/lib/sql/year.ml b/lib/sql/year.ml new file mode 100644 index 0000000..1e9c599 --- /dev/null +++ b/lib/sql/year.ml @@ -0,0 +1,19 @@ +(** Parse a text value into a date *) + +open CalendarLib + +let first_day = CalendarLib.Date.make 1899 12 30 + +let f : Sqlite3.Data.t -> Sqlite3.Data.t = + fun data -> + match data with + | Sqlite3.Data.INT content -> + let nb = Int64.to_int content in + let date = Date.add first_day (Date.Period.day nb) in + let year = CalendarLib.Date.year date in + + Sqlite3.Data.INT (Int64.of_int year) + | _ -> data + + +let register : Sqlite3.db -> unit = fun db -> Sqlite3.create_fun1 db "year" f -- cgit v1.2.3