summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-10-22 16:15:56 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-10-22 16:15:56 -0400
commit7e1e019f3fef4c229c06ba2c0c2aa3ec021eedad (patch)
treea765ee0cd11f8b42d77606fa4d133daceefff056
parentc4becb5fa4357e7a27e6536f3a20e3d5d6136cb0 (diff)
Initial support for char in SQL
Diffstat
-rw-r--r--demo/more/conference.ur26
-rw-r--r--demo/more/conference.urp1
-rw-r--r--demo/more/conference.urs1
-rw-r--r--demo/more/conference1.ur2
-rw-r--r--demo/more/conferenceFields.ur19
-rw-r--r--demo/more/conferenceFields.urs3
-rw-r--r--demo/more/meta.ur12
-rw-r--r--demo/more/meta.urs3
-rw-r--r--include/urweb.h4
-rw-r--r--lib/ur/basis.urs1
-rw-r--r--src/c/urweb.c87
-rw-r--r--src/cjr_print.sml16
-rw-r--r--src/mono_opt.sml26
-rw-r--r--src/monoize.sml4
-rw-r--r--src/mysql.sml5
-rw-r--r--src/postgres.sml6
-rw-r--r--src/settings.sig1
-rw-r--r--src/settings.sml2
-rw-r--r--src/sqlite.sml9
19 files changed, 206 insertions, 22 deletions
diff --git a/demo/more/conference.ur b/demo/more/conference.ur
index 8e408d2f..72750248 100644
--- a/demo/more/conference.ur
+++ b/demo/more/conference.ur
@@ -9,6 +9,7 @@ functor Make(M : sig
con review :: {(Type * Type)}
constraint [Paper, User] ~ review
val review : $(map meta review)
+ val reviewFolder : folder review
val submissionDeadline : time
val summarizePaper : $(map fst paper) -> xbody
@@ -26,7 +27,7 @@ functor Make(M : sig
table authorship : {Paper : int, User : int}
PRIMARY KEY (Paper, User),
- CONSTRAINT Paper FOREIGN KEY Paper REFERENCES paper(Id),
+ CONSTRAINT Paper FOREIGN KEY Paper REFERENCES paper(Id) ON DELETE CASCADE,
CONSTRAINT User FOREIGN KEY User REFERENCES user(Id)
con review = [Paper = int, User = int] ++ map fst M.review
@@ -249,6 +250,7 @@ functor Make(M : sig
</body></xml>
and one id =
+ me <- getLogin;
checkPaper id;
ro <- oneOrNoRows (SELECT paper.{{map fst M.paper}}, octet_length(paper.Document) AS N
FROM paper
@@ -258,6 +260,10 @@ functor Make(M : sig
JOIN user ON authorship.User = user.Id
WHERE authorship.Paper = {[id]})
(fn r => <xml><li>{[r.User.Nam]}</li></xml>);
+ myReview <- oneOrNoRows1 (SELECT review.{{map fst M.review}}
+ FROM review
+ WHERE review.User = {[me.Id]}
+ AND review.Paper = {[id]});
case ro of
None => error <xml>Paper not found!</xml>
| Some r => return <xml><body>
@@ -274,6 +280,24 @@ functor Make(M : sig
<xml><div>No paper uploaded yet.</div></xml>
else
<xml><a link={download id}>Download paper</a> ({[r.N]} bytes)</xml>}
+
+ <hr/>
+
+ {case myReview of
+ None => <xml>
+ <h2>Add Your Review</h2>
+
+ <form>
+ {allWidgets M.review M.reviewFolder}
+ </form>
+ </xml>
+ | Some myReview => <xml>
+ <h2>Edit Your Review</h2>
+
+ <form>
+ {allPopulated M.review myReview M.reviewFolder}
+ </form>
+ </xml>}
</body></xml>
and download id =
diff --git a/demo/more/conference.urp b/demo/more/conference.urp
index 42d51ba9..0fd67b8a 100644
--- a/demo/more/conference.urp
+++ b/demo/more/conference.urp
@@ -1,5 +1,6 @@
allow mime application/pdf
+$/string
$/option
$/list
meta
diff --git a/demo/more/conference.urs b/demo/more/conference.urs
index 04e8e298..53fd478d 100644
--- a/demo/more/conference.urs
+++ b/demo/more/conference.urs
@@ -7,6 +7,7 @@ functor Make(M : sig
con review :: {(Type * Type)}
constraint [Paper, User] ~ review
val review : $(map Meta.meta review)
+ val reviewFolder : folder review
val submissionDeadline : time
val summarizePaper : $(map fst paper) -> xbody
diff --git a/demo/more/conference1.ur b/demo/more/conference1.ur
index d52de976..b6867728 100644
--- a/demo/more/conference1.ur
+++ b/demo/more/conference1.ur
@@ -3,7 +3,7 @@ open ConferenceFields
open Conference.Make(struct
val paper = {Title = title,
Abstract = abstract}
- val review = {}
+ val review = {Rating = dropdown "Rating" (#"A" :: #"B" :: #"C" :: #"D" :: [])}
val submissionDeadline = readError "2009-10-22 23:59:59"
diff --git a/demo/more/conferenceFields.ur b/demo/more/conferenceFields.ur
index be0843af..ae9ed5a7 100644
--- a/demo/more/conferenceFields.ur
+++ b/demo/more/conferenceFields.ur
@@ -2,3 +2,22 @@ open Meta
val title = string "Title"
val abstract = textarea "Abstract"
+
+fun charIn s =
+ if String.length s = 0 then
+ error <xml>Impossible: Empty option value</xml>
+ else
+ String.sub s 0
+
+con dropdown = (char, string)
+fun dropdown name opts = {Nam = name,
+ Show = txt,
+ Widget = fn [nm :: Name] => <xml><select{nm}>
+ {List.mapX (fn x => <xml><option>{[x]}</option></xml>) opts}
+ </select></xml>,
+ WidgetPopulated = fn [nm :: Name] v => <xml><select{nm}>
+ {List.mapX (fn x => <xml><option selected={x = v}>{[x]}</option></xml>) opts}
+ </select></xml>,
+ Parse = charIn,
+ Inject = _}
+
diff --git a/demo/more/conferenceFields.urs b/demo/more/conferenceFields.urs
index 8352071d..d235ec4c 100644
--- a/demo/more/conferenceFields.urs
+++ b/demo/more/conferenceFields.urs
@@ -1,2 +1,5 @@
val title : Meta.meta (string, string)
val abstract : Meta.meta (string, string)
+
+con dropdown :: (Type * Type)
+val dropdown : string -> list char -> Meta.meta dropdown
diff --git a/demo/more/meta.ur b/demo/more/meta.ur
index 9470eea0..74b5004f 100644
--- a/demo/more/meta.ur
+++ b/demo/more/meta.ur
@@ -52,6 +52,18 @@ fun allWidgets [ts ::: {(Type * Type)}] (r : $(map meta ts)) (fl : folder ts) =
<xml/>
[_] fl r
+fun allPopulated [ts ::: {(Type * Type)}] (r : $(map meta ts)) (vs : $(map fst ts)) (fl : folder ts) =
+ foldR2 [meta] [fst] [fn cols :: {(Type * Type)} =>
+ xml form [] (map snd cols)]
+ (fn [nm :: Name] [p :: (Type * Type)] [rest :: {(Type * Type)}] [[nm] ~ rest]
+ (m : meta p) v (acc : xml form [] (map snd rest)) =>
+ <xml>
+ {[m.Nam]}: {m.WidgetPopulated [nm] v}<br/>
+ {useMore acc}
+ </xml>)
+ <xml/>
+ [_] fl r vs
+
fun allPopulatedTr [ts ::: {(Type * Type)}] (r : $(map meta ts)) (vs : $(map fst ts)) (fl : folder ts) =
foldR2 [meta] [fst] [fn cols :: {(Type * Type)} =>
xml [Body, Form, Tr] [] (map snd cols)]
diff --git a/demo/more/meta.urs b/demo/more/meta.urs
index 90c4e17e..0d3422af 100644
--- a/demo/more/meta.urs
+++ b/demo/more/meta.urs
@@ -18,6 +18,9 @@ val allContent : ts ::: {(Type * Type)} -> $(map meta ts) -> $(map fst ts) -> fo
val allWidgets : ts ::: {(Type * Type)} -> $(map meta ts) -> folder ts
-> xml form [] (map snd ts)
+val allPopulated : ts ::: {(Type * Type)} -> $(map meta ts) -> $(map fst ts) -> folder ts
+ -> xml form [] (map snd ts)
+
val allPopulatedTr : ts ::: {(Type * Type)} -> $(map meta ts) -> $(map fst ts) -> folder ts
-> xml ([Tr] ++ form) [] (map snd ts)
diff --git a/include/urweb.h b/include/urweb.h
index 87350dc5..359ba037 100644
--- a/include/urweb.h
+++ b/include/urweb.h
@@ -88,6 +88,7 @@ uw_unit uw_Basis_htmlifyTime_w(uw_context, uw_Basis_time);
char *uw_Basis_attrifyInt(uw_context, uw_Basis_int);
char *uw_Basis_attrifyFloat(uw_context, uw_Basis_float);
char *uw_Basis_attrifyString(uw_context, uw_Basis_string);
+char *uw_Basis_attrifyChar(uw_context, uw_Basis_char);
char *uw_Basis_attrifyTime(uw_context, uw_Basis_time);
char *uw_Basis_attrifyChannel(uw_context, uw_Basis_channel);
char *uw_Basis_attrifyClient(uw_context, uw_Basis_client);
@@ -96,6 +97,7 @@ char *uw_Basis_attrifyCss_class(uw_context, uw_Basis_css_class);
uw_unit uw_Basis_attrifyInt_w(uw_context, uw_Basis_int);
uw_unit uw_Basis_attrifyFloat_w(uw_context, uw_Basis_float);
uw_unit uw_Basis_attrifyString_w(uw_context, uw_Basis_string);
+uw_unit uw_Basis_attrifyChar_w(uw_context, uw_Basis_char);
char *uw_Basis_urlifyInt(uw_context, uw_Basis_int);
char *uw_Basis_urlifyFloat(uw_context, uw_Basis_float);
@@ -133,6 +135,7 @@ char *uw_memdup(uw_context, const char *, size_t);
uw_Basis_string uw_Basis_sqlifyInt(uw_context, uw_Basis_int);
uw_Basis_string uw_Basis_sqlifyFloat(uw_context, uw_Basis_float);
uw_Basis_string uw_Basis_sqlifyString(uw_context, uw_Basis_string);
+uw_Basis_string uw_Basis_sqlifyChar(uw_context, uw_Basis_char);
uw_Basis_string uw_Basis_sqlifyBool(uw_context, uw_Basis_bool);
uw_Basis_string uw_Basis_sqlifyTime(uw_context, uw_Basis_time);
uw_Basis_string uw_Basis_sqlifyBlob(uw_context, uw_Basis_blob);
@@ -216,6 +219,7 @@ extern char *uw_sqlfmtInt;
extern char *uw_sqlfmtFloat;
extern int uw_Estrings;
extern char *uw_sqlsuffixString;
+extern char *uw_sqlsuffixChar;
extern char *uw_sqlsuffixBlob;
extern char *uw_sqlfmtUint4;
diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs
index 6536dc3f..0f70fa14 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -165,6 +165,7 @@ val sql_bool : sql_injectable_prim bool
val sql_int : sql_injectable_prim int
val sql_float : sql_injectable_prim float
val sql_string : sql_injectable_prim string
+val sql_char : sql_injectable_prim char
val sql_time : sql_injectable_prim time
val sql_blob : sql_injectable_prim blob
val sql_channel : t ::: Type -> sql_injectable_prim (channel t)
diff --git a/src/c/urweb.c b/src/c/urweb.c
index 139a2507..7dd6d222 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -1388,6 +1388,32 @@ char *uw_Basis_attrifyString(uw_context ctx, uw_Basis_string s) {
return result;
}
+char *uw_Basis_attrifyChar(uw_context ctx, uw_Basis_char c) {
+ char *result, *p;
+ uw_check_heap(ctx, 7);
+
+ result = p = ctx->heap.front;
+
+ if (c == '"') {
+ strcpy(p, "&quot;");
+ p += 6;
+ } else if (c == '&') {
+ strcpy(p, "&amp;");
+ p += 5;
+ }
+ else if (isprint(c))
+ *p++ = c;
+ else {
+ int len2;
+ sprintf(p, "&#%d;%n", c, &len2);
+ p += len2;
+ }
+
+ *p++ = 0;
+ ctx->heap.front = p;
+ return result;
+}
+
char *uw_Basis_attrifyCss_class(uw_context ctx, uw_Basis_css_class s) {
return s;
}
@@ -1438,6 +1464,24 @@ uw_unit uw_Basis_attrifyString_w(uw_context ctx, uw_Basis_string s) {
return uw_unit_v;
}
+uw_unit uw_Basis_attrifyChar_w(uw_context ctx, uw_Basis_char c) {
+ uw_check(ctx, 6);
+
+ if (c == '"')
+ uw_write_unsafe(ctx, "&quot;");
+ else if (c == '&')
+ uw_write_unsafe(ctx, "&amp;");
+ else if (isprint(c))
+ uw_writec_unsafe(ctx, c);
+ else {
+ uw_write_unsafe(ctx, "&#");
+ uw_Basis_attrifyInt_w_unsafe(ctx, c);
+ uw_writec_unsafe(ctx, ';');
+ }
+
+ return uw_unit_v;
+}
+
char *uw_Basis_urlifyInt(uw_context ctx, uw_Basis_int n) {
int len;
@@ -1988,6 +2032,7 @@ char *uw_Basis_sqlifyFloatN(uw_context ctx, uw_Basis_float *n) {
int uw_Estrings = 1;
char *uw_sqlsuffixString = "::text";
+char *uw_sqlsuffixChar = "::char";
uw_Basis_string uw_Basis_sqlifyString(uw_context ctx, uw_Basis_string s) {
char *r, *s2;
@@ -2035,6 +2080,48 @@ uw_Basis_string uw_Basis_sqlifyString(uw_context ctx, uw_Basis_string s) {
return r;
}
+uw_Basis_string uw_Basis_sqlifyChar(uw_context ctx, uw_Basis_char c) {
+ char *r, *s2;
+
+ uw_check_heap(ctx, 5 + uw_Estrings + strlen(uw_sqlsuffixChar));
+
+ r = s2 = ctx->heap.front;
+ if (uw_Estrings)
+ *s2++ = 'E';
+ *s2++ = '\'';
+
+ switch (c) {
+ case '\'':
+ if (uw_Estrings)
+ strcpy(s2, "\\'");
+ else
+ strcpy(s2, "''");
+ s2 += 2;
+ break;
+ case '\\':
+ if (uw_Estrings) {
+ strcpy(s2, "\\\\");
+ s2 += 2;
+ } else
+ *s2++ = '\\';
+ break;
+ default:
+ if (isprint(c))
+ *s2++ = c;
+ else if (uw_Estrings) {
+ sprintf(s2, "\\%03o", c);
+ s2 += 4;
+ }
+ else
+ uw_error(ctx, FATAL, "Non-printable character %u in char to SQLify", c);
+ }
+
+ *s2++ = '\'';
+ strcpy(s2, uw_sqlsuffixChar);
+ ctx->heap.front = s2 + 1 + strlen(uw_sqlsuffixChar);
+ return r;
+}
+
char *uw_sqlsuffixBlob = "::bytea";
uw_Basis_string uw_Basis_sqlifyBlob(uw_context ctx, uw_Basis_blob b) {
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 25666d97..d63c9099 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -491,20 +491,7 @@ fun isFile (t : typ) =
TFfi ("Basis", "file") => true
| _ => false
-fun p_sql_type' t =
- case t of
- Int => "uw_Basis_int"
- | Float => "uw_Basis_float"
- | String => "uw_Basis_string"
- | Bool => "uw_Basis_bool"
- | Time => "uw_Basis_time"
- | Blob => "uw_Basis_blob"
- | Channel => "uw_Basis_channel"
- | Client => "uw_Basis_client"
- | Nullable String => "uw_Basis_string"
- | Nullable t => p_sql_type' t ^ "*"
-
-fun p_sql_type t = string (p_sql_type' t)
+fun p_sql_type t = string (Settings.p_sql_ctype t)
fun getPargs (e, _) =
case e of
@@ -1308,6 +1295,7 @@ fun sql_type_in env (tAll as (t, loc)) =
TFfi ("Basis", "int") => Int
| TFfi ("Basis", "float") => Float
| TFfi ("Basis", "string") => String
+ | TFfi ("Basis", "char") => Char
| TFfi ("Basis", "bool") => Bool
| TFfi ("Basis", "time") => Time
| TFfi ("Basis", "blob") => Blob
diff --git a/src/mono_opt.sml b/src/mono_opt.sml
index 9b9308be..78754082 100644
--- a/src/mono_opt.sml
+++ b/src/mono_opt.sml
@@ -45,12 +45,16 @@ fun attrifyFloat n =
else
Real.toString n
-val attrifyString = String.translate (fn #"\"" => "&quot;"
- | #"&" => "&amp;"
- | ch => if Char.isPrint ch then
- str ch
- else
- "&#" ^ Int.toString (ord ch) ^ ";")
+fun attrifyChar ch =
+ case ch of
+ #"\"" => "&quot;"
+ | #"&" => "&amp;"
+ | ch => if Char.isPrint ch then
+ str ch
+ else
+ "&#" ^ Int.toString (ord ch) ^ ";"
+
+val attrifyString = String.translate attrifyChar
val urlifyInt = attrifyInt
val urlifyFloat = attrifyFloat
@@ -95,6 +99,7 @@ fun sqlifyInt n = #p_cast (Settings.currentDbms ()) (attrifyInt n, Settings.Int)
fun sqlifyFloat n = #p_cast (Settings.currentDbms ()) (attrifyFloat n, Settings.Float)
fun sqlifyString s = #sqlifyString (Settings.currentDbms ()) s
+fun sqlifyChar ch = #sqlifyString (Settings.currentDbms ()) (str ch)
fun unAs s =
let
@@ -260,6 +265,13 @@ fun exp e =
| EWrite (EFfiApp ("Basis", "attrifyString", [e]), _) =>
EFfiApp ("Basis", "attrifyString_w", [e])
+ | EFfiApp ("Basis", "attrifyChar", [(EPrim (Prim.Char s), _)]) =>
+ EPrim (Prim.String (attrifyChar s))
+ | EWrite (EFfiApp ("Basis", "attrifyChar", [(EPrim (Prim.Char s), _)]), loc) =>
+ EWrite (EPrim (Prim.String (attrifyChar s)), loc)
+ | EWrite (EFfiApp ("Basis", "attrifyChar", [e]), _) =>
+ EFfiApp ("Basis", "attrifyChar_w", [e])
+
| EFfiApp ("Basis", "attrifyCss_class", [(EPrim (Prim.String s), _)]) =>
EPrim (Prim.String s)
| EWrite (EFfiApp ("Basis", "attrifyCss_class", [(EPrim (Prim.String s), _)]), loc) =>
@@ -318,6 +330,8 @@ fun exp e =
result = (TFfi ("Basis", "string"), loc)}), loc)
| EFfiApp ("Basis", "sqlifyString", [(EPrim (Prim.String n), _)]) =>
EPrim (Prim.String (sqlifyString n))
+ | EFfiApp ("Basis", "sqlifyChar", [(EPrim (Prim.Char n), _)]) =>
+ EPrim (Prim.String (sqlifyChar n))
| EWrite (ECase (discE, pes, {disc, ...}), loc) =>
optExp (ECase (discE,
diff --git a/src/monoize.sml b/src/monoize.sml
index a01f953f..6512eb1e 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -1921,6 +1921,10 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
((L'.EAbs ("x", (L'.TFfi ("Basis", "string"), loc), (L'.TFfi ("Basis", "string"), loc),
(L'.EFfiApp ("Basis", "sqlifyString", [(L'.ERel 0, loc)]), loc)), loc),
fm)
+ | L.EFfi ("Basis", "sql_char") =>
+ ((L'.EAbs ("x", (L'.TFfi ("Basis", "char"), loc), (L'.TFfi ("Basis", "string"), loc),
+ (L'.EFfiApp ("Basis", "sqlifyChar", [(L'.ERel 0, loc)]), loc)), loc),
+ fm)
| L.EFfi ("Basis", "sql_time") =>
((L'.EAbs ("x", (L'.TFfi ("Basis", "time"), loc), (L'.TFfi ("Basis", "string"), loc),
(L'.EFfiApp ("Basis", "sqlifyTime", [(L'.ERel 0, loc)]), loc)), loc),
diff --git a/src/mysql.sml b/src/mysql.sml
index 2941186c..d4db8710 100644
--- a/src/mysql.sml
+++ b/src/mysql.sml
@@ -36,6 +36,7 @@ fun p_sql_type t =
Int => "bigint"
| Float => "double"
| String => "longtext"
+ | Char => "char"
| Bool => "bool"
| Time => "timestamp"
| Blob => "longblob"
@@ -48,6 +49,7 @@ fun p_buffer_type t =
Int => "MYSQL_TYPE_LONGLONG"
| Float => "MYSQL_TYPE_DOUBLE"
| String => "MYSQL_TYPE_STRING"
+ | Char => "MYSQL_TYPE_TINY"
| Bool => "MYSQL_TYPE_LONG"
| Time => "MYSQL_TYPE_TIMESTAMP"
| Blob => "MYSQL_TYPE_BLOB"
@@ -60,6 +62,7 @@ fun p_sql_type_base t =
Int => "bigint"
| Float => "double"
| String => "longtext"
+ | Char => "char"
| Bool => "tinyint"
| Time => "timestamp"
| Blob => "longblob"
@@ -386,6 +389,8 @@ fun init {dbstring, prepared = ss, tables, views, sequences} =
newline,
string "uw_sqlsuffixString = \"\";",
newline,
+ string "uw_sqlsuffixChar = \"\";",
+ newline,
string "uw_sqlsuffixBlob = \"\";",
newline,
string "uw_sqlfmtUint4 = \"%u%n\";",
diff --git a/src/postgres.sml b/src/postgres.sml
index f3942db4..12142fe2 100644
--- a/src/postgres.sml
+++ b/src/postgres.sml
@@ -39,6 +39,7 @@ fun p_sql_type t =
Int => "int8"
| Float => "float8"
| String => "text"
+ | Char => "char"
| Bool => "bool"
| Time => "timestamp"
| Blob => "bytea"
@@ -51,6 +52,7 @@ fun p_sql_type_base t =
Int => "bigint"
| Float => "double precision"
| String => "text"
+ | Char => "character"
| Bool => "boolean"
| Time => "timestamp without time zone"
| Blob => "bytea"
@@ -257,6 +259,8 @@ fun init {dbstring, prepared = ss, tables, views, sequences} =
newline,
string "uw_sqlsuffixString = \"::text\";",
newline,
+ string "uw_sqlsuffixChar = \"::char\";",
+ newline,
string "uw_sqlsuffixBlob = \"::bytea\";",
newline,
string "uw_sqlfmtUint4 = \"%u::int4%n\";",
@@ -505,6 +509,7 @@ fun p_getcol {loc, wontLeakStrings, col = i, typ = t} =
e
else
box [string "uw_strdup(ctx, ", e, string ")"]
+ | Char => box [e, string "[0]"]
| Bool => box [string "uw_Basis_stringToBool_error(ctx, ", e, string ")"]
| Time => box [string "uw_Basis_unsqlTime(ctx, ", e, string ")"]
| Blob => box [string "uw_Basis_stringToBlob_error(ctx, ",
@@ -643,6 +648,7 @@ fun p_ensql t e =
Int => box [string "uw_Basis_attrifyInt(ctx, ", e, string ")"]
| Float => box [string "uw_Basis_attrifyFloat(ctx, ", e, string ")"]
| String => e
+ | Char => box [string "uw_Basis_attrifyChar(ctx, ", e, string ")"]
| Bool => box [string "(", e, string " ? \"TRUE\" : \"FALSE\")"]
| Time => box [string "uw_Basis_attrifyTime(ctx, ", e, string ")"]
| Blob => box [e, string ".data"]
diff --git a/src/settings.sig b/src/settings.sig
index 1da58193..f07477e5 100644
--- a/src/settings.sig
+++ b/src/settings.sig
@@ -105,6 +105,7 @@ signature SETTINGS = sig
Int
| Float
| String
+ | Char
| Bool
| Time
| Blob
diff --git a/src/settings.sml b/src/settings.sml
index bed027a3..05a9e5da 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -282,6 +282,7 @@ datatype sql_type =
Int
| Float
| String
+ | Char
| Bool
| Time
| Blob
@@ -298,6 +299,7 @@ fun p_sql_ctype t =
Int => "uw_Basis_int"
| Float => "uw_Basis_float"
| String => "uw_Basis_string"
+ | Char => "uw_Basis_char"
| Bool => "uw_Basis_bool"
| Time => "uw_Basis_time"
| Blob => "uw_Basis_blob"
diff --git a/src/sqlite.sml b/src/sqlite.sml
index b1252b95..f0ebac2f 100644
--- a/src/sqlite.sml
+++ b/src/sqlite.sml
@@ -36,6 +36,7 @@ fun p_sql_type t =
Int => "integer"
| Float => "real"
| String => "text"
+ | Char => "integer"
| Bool => "integer"
| Time => "text"
| Blob => "blob"
@@ -165,6 +166,8 @@ fun init {dbstring, prepared = ss, tables, views, sequences} =
newline,
string "uw_sqlsuffixString = \"\";",
newline,
+ string "uw_sqlsuffixChar = \"\";",
+ newline,
string "uw_sqlsuffixBlob = \"\";",
newline,
string "uw_sqlfmtUint4 = \"%u%n\";",
@@ -370,6 +373,7 @@ fun p_getcol {loc, wontLeakStrings, col = i, typ = t} =
box [string "sqlite3_column_text(stmt, ", string (Int.toString i), string ")"]
else
box [string "uw_strdup(ctx, sqlite3_column_text(stmt, ", string (Int.toString i), string "))"]
+ | Char => box [string "sqlite3_column_int(stmt, ", string (Int.toString i), string ")"]
| Bool => box [string "(uw_Basis_bool)sqlite3_column_int(stmt, ", string (Int.toString i), string ")"]
| Time => box [string "uw_Basis_stringToTime_error(ctx, sqlite3_column_text(stmt, ", string (Int.toString i), string "))"]
| Blob => box [string "({",
@@ -523,6 +527,11 @@ fun p_inputs loc =
string ", ",
arg,
string ", -1, SQLITE_TRANSIENT)"]
+ | Char => box [string "sqlite3_bind_int(stmt, ",
+ string (Int.toString (i + 1)),
+ string ", ",
+ arg,
+ string ")"]
| Bool => box [string "sqlite3_bind_int(stmt, ",
string (Int.toString (i + 1)),
string ", ",
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-17 06:03:26 +0000