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)