: SQL_ty =
struct
open Dbf_misc
type ty = SQL_db.ty
type numeric_option = SQL_db.numeric_option
type ty_kind =
| SQL_TinyInt | SQL_MediumInt | SQL_Int | SQL_BigInt
| SQL_Double | SQL_Float | SQL_Decimal
| SQL_Char | SQL_VarChar
| SQL_TinyBlob | SQL_Blob | SQL_MediumBlob | SQL_LongBlob
| SQL_TinyText | SQL_Text | SQL_MediumText | SQL_LongText
type ty_class =
| SQL_C_Int | SQL_C_Real | SQL_C_Char
exception Invalid_type of string
let kind_string_assoc =
[(SQL_TinyInt, "TINYINT");
(SQL_MediumInt, "MEDIUMINT");
(SQL_Int, "INT");
(SQL_BigInt, "BIGINT");
(SQL_Double, "DOUBLE");
(SQL_Float, "FLOAT");
(SQL_Decimal, "DECIMAL");
(SQL_Char, "CHAR");
(SQL_VarChar, "VARCHAR");
(SQL_TinyBlob, "TINYBLOB");
(SQL_Blob, "BLOB");
(SQL_MediumBlob, "MEDIUMBLOB");
(SQL_LongBlob, "LONGBLOB");
(SQL_TinyText, "TINYTEXT");
(SQL_Text, "TEXT");
(SQL_MediumText, "MEDIUMTEXT");
(SQL_LongText, "LONGTEXT")]
let numeric_opt_string_assoc =
[(SQL_db.NO_None, "");
(SQL_db.NO_Unsigned, "UNSIGNED");
(SQL_db.NO_UnsignedZeroFill, "UNSIGNED ZEROFILL")]
let kind_of_type = function
| SQL_db.TinyInt _ -> SQL_TinyInt
| SQL_db.MediumInt _ -> SQL_MediumInt
| SQL_db.Int _ -> SQL_Int
| SQL_db.BigInt _ -> SQL_BigInt
| SQL_db.Double _ -> SQL_Double
| SQL_db.Float _ -> SQL_Float
| SQL_db.Decimal _ -> SQL_Decimal
| SQL_db.Char _ -> SQL_Char
| SQL_db.VarChar _ -> SQL_VarChar
| SQL_db.TinyBlob -> SQL_TinyBlob
| SQL_db.Blob -> SQL_Blob
| SQL_db.MediumBlob -> SQL_MediumBlob
| SQL_db.LongBlob -> SQL_LongBlob
| SQL_db.TinyText -> SQL_TinyText
| SQL_db.Text -> SQL_Text
| SQL_db.MediumText -> SQL_MediumText
| SQL_db.LongText -> SQL_LongText
let string_of_kind =
fun ty -> List.assoc ty kind_string_assoc
let kind_of_string = fun s ->
fst (List.find (fun (_, s') -> s = s') kind_string_assoc)
let string_of_numeric_option =
fun opt -> List.assoc opt numeric_opt_string_assoc
let numeric_option_of_string = fun s ->
fst (List.find (fun (_, s') -> s = s') numeric_opt_string_assoc)
let class_of_kind = function
| SQL_TinyInt | SQL_MediumInt | SQL_Int | SQL_BigInt -> SQL_C_Int
| SQL_Double | SQL_Float | SQL_Decimal -> SQL_C_Real
| _ -> SQL_C_Char
let kind_uses_display_width = fun kind ->
match class_of_kind kind with
| SQL_C_Int | SQL_C_Real -> Dbf_misc.Maybe
| SQL_C_Char ->
match kind with
| SQL_Char | SQL_VarChar -> Dbf_misc.Yes
| _ -> Dbf_misc.No
let kind_uses_precision = fun kind ->
match class_of_kind kind with
| SQL_C_Real -> Dbf_misc.Maybe
| _ -> Dbf_misc.No
let options_of_kind = fun kind ->
match class_of_kind kind with
| SQL_C_Int | SQL_C_Real -> snd (List.split numeric_opt_string_assoc)
| _ -> []
let get_display_size = function
| SQL_db.TinyInt (iopt, _)
| SQL_db.MediumInt (iopt, _)
| SQL_db.Int (iopt, _)
| SQL_db.BigInt (iopt, _)
-> iopt
| SQL_db.Double (opt, _)
| SQL_db.Float (opt, _)
| SQL_db.Decimal (opt, _)
-> Dbf_misc.apply_opt fst opt
| SQL_db.Char i
| SQL_db.VarChar i
-> Some i
| _ -> None
let get_precision = function
| SQL_db.Double (opt, _)
| SQL_db.Float (opt, _)
| SQL_db.Decimal (opt, _)
-> Dbf_misc.apply_opt snd opt
| _ -> None
let get_options_as_string = function
| SQL_db.Double (_, opt)
| SQL_db.Float (_, opt)
| SQL_db.Decimal (_, opt)
-> Some (string_of_numeric_option opt)
| _ -> None
let type_of_string = fun ?dispsize ?precision ?(options = "") name ->
let kind =
try kind_of_string name
with Not_found -> raise (Invalid_type ("Unknown type: " ^ name))
in
begin
match (kind_uses_display_width kind, dispsize) with
| (No, Some _) -> raise (Invalid_type "Type doesn't support display size option")
| (Yes, None) -> raise (Invalid_type "Type requires display size option")
| _ -> ()
end; begin
match (kind_uses_precision kind, precision) with
| (No, Some _) -> raise (Invalid_type "Type doesn't support precision option")
| (Yes, None) -> raise (Invalid_type "Type requires precision option");
| _ -> ()
end;
let options_list = options_of_kind kind in
if options <> "" && not (List.mem options options_list) then begin
let msg = Printf.sprintf "Unknown options %s for type %s" options name in
raise (Invalid_type msg)
end;
let dispsize_and_precision_or_nothing = fun () ->
match (dispsize, precision) with
| (None, None) -> None
| (Some i1, Some i2) -> Some (i1, i2)
| _ ->
raise
(Invalid_type
"Need to give display size AND precision OR nothing at all")
in
let int_type = fun f_ty ->
f_ty dispsize (numeric_option_of_string options)
and real_type = fun f_ty ->
let opt1 = dispsize_and_precision_or_nothing ()
and opt2 = numeric_option_of_string options in
f_ty opt1 opt2
in
match name with
| "TINYINT" -> int_type (fun ds opt -> SQL_db.TinyInt (ds, opt))
| "MEDIUMINT" -> int_type (fun ds opt -> SQL_db.MediumInt (ds, opt))
| "INT" -> int_type (fun ds opt -> SQL_db.Int (ds, opt))
| "BIGINT" -> int_type (fun ds opt -> SQL_db.BigInt (ds, opt))
| "DOUBLE" -> real_type (fun iopt opt -> SQL_db.Double (iopt, opt))
| "FLOAT" -> real_type (fun iopt opt -> SQL_db.Float (iopt, opt))
| "DECIMAL" -> real_type (fun iopt opt -> SQL_db.Decimal (iopt, opt))
| "CHAR" -> SQL_db.Char (Dbf_misc.unopt dispsize)
| "VARCHAR" -> SQL_db.VarChar (Dbf_misc.unopt dispsize)
| "TINYBLOB" -> SQL_db.TinyBlob
| "BLOB" -> SQL_db.Blob
| "MEDIUMBLOB" -> SQL_db.MediumBlob
| "LONGBLOB" -> SQL_db.LongBlob
| "TINYTEXT" -> SQL_db.TinyText
| "TEXT" -> SQL_db.Text
| "MEDIUMTEXT" -> SQL_db.MediumText
| "LONGTEXT" -> SQL_db.LongText
| _ -> raise (Invalid_type name)
let string_of_type = fun ty -> string_of_kind (kind_of_type ty)
let string_of_type_options = fun ty ->
match ty with
| SQL_db.TinyInt (_, opt)
| SQL_db.MediumInt (_, opt)
| SQL_db.Int (_, opt)
| SQL_db.BigInt (_, opt)
-> Some (string_of_numeric_option opt)
| SQL_db.Double (_, opt)
| SQL_db.Float (_, opt)
| SQL_db.Decimal (_, opt)
-> Some (string_of_numeric_option opt)
| _ -> None
let fullstring_of_type = fun ty ->
let opt_of_string = fun s ->
if s = "" then None else Some s
and intopt_string = fun iopt ->
Dbf_misc.apply_opt (Printf.sprintf "(%d)") iopt
and int2opt_string = fun i2opt ->
Dbf_misc.apply_opt
(fun (i1, i2) -> Printf.sprintf "(%d, %d)" i1 i2) i2opt
in
match ty with
| SQL_db.TinyInt (i, opt)
| SQL_db.MediumInt (i, opt)
| SQL_db.Int (i, opt)
| SQL_db.BigInt (i, opt)
-> join_opt
([Some (string_of_type ty);
intopt_string (i);
opt_of_string (string_of_numeric_option opt)])
| SQL_db.Double (i, opt)
| SQL_db.Float (i, opt)
| SQL_db.Decimal (i, opt)
-> join_opt
([Some (string_of_type ty);
int2opt_string (i);
opt_of_string (string_of_numeric_option opt)])
| SQL_db.Char i
| SQL_db.VarChar i
-> join_opt
([Some (string_of_type ty);
Some (Printf.sprintf "(%d)" i)])
| SQL_db.TinyBlob -> string_of_type ty
| SQL_db.Blob -> string_of_type ty
| SQL_db.MediumBlob -> string_of_type ty
| SQL_db.LongBlob -> string_of_type ty
| SQL_db.TinyText -> string_of_type ty
| SQL_db.Text -> string_of_type ty
| SQL_db.MediumText -> string_of_type ty
| SQL_db.LongText -> string_of_type ty
end