Mercurial > urweb

annotate src/postgres.sml @ 1735:ec47f49c6aa3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
In simplifying constructors for error messages, unfold constructor synonyms from modules
author Adam Chlipala <adam@chlipala.net>
date Wed, 02 May 2012 08:23:30 -0400
parents ac141fbb313a
children 59b07fdae1ff
rev   line source
adam@1295 1 (* Copyright (c) 2008-2010, Adam Chlipala
adamc@866 2 * All rights reserved.
adamc@866 3 *
adamc@866 4 * Redistribution and use in source and binary forms, with or without
adamc@866 5 * modification, are permitted provided that the following conditions are met:
adamc@866 6 *
adamc@866 7 * - Redistributions of source code must retain the above copyright notice,
adamc@866 8 * this list of conditions and the following disclaimer.
adamc@866 9 * - Redistributions in binary form must reproduce the above copyright notice,
adamc@866 10 * this list of conditions and the following disclaimer in the documentation
adamc@866 11 * and/or other materials provided with the distribution.
adamc@866 12 * - The names of contributors may not be used to endorse or promote products
adamc@866 13 * derived from this software without specific prior written permission.
adamc@866 14 *
adamc@866 15 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
adamc@866 16 * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
adamc@866 17 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
adamc@866 18 * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
adam@1682 19 * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
adamc@866 20 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
adamc@866 21 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
adamc@866 22 * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
adamc@866 23 * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
adamc@866 24 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
adamc@866 25 * POSSIBILITY OF SUCH DAMAGE.
adamc@866 26 *)
adamc@866 27
adamc@866 28 structure Postgres :> POSTGRES = struct
adamc@866 29
adamc@866 30 open Settings
adamc@866 31 open Print.PD
adamc@866 32 open Print
adamc@866 33
adamc@870 34 val ident = String.translate (fn #"'" => "PRIME"
adamc@870 35 | ch => str ch)
adamc@870 36
adamc@873 37 fun p_sql_type t =
adamc@873 38 case t of
adamc@873 39 Int => "int8"
adamc@873 40 | Float => "float8"
adamc@873 41 | String => "text"
adamc@1011 42 | Char => "char"
adamc@873 43 | Bool => "bool"
adamc@873 44 | Time => "timestamp"
adamc@873 45 | Blob => "bytea"
adamc@873 46 | Channel => "int8"
adamc@873 47 | Client => "int4"
adamc@873 48 | Nullable t => p_sql_type t
adamc@873 49
adamc@870 50 fun p_sql_type_base t =
adamc@870 51 case t of
adamc@871 52 Int => "bigint"
adamc@871 53 | Float => "double precision"
adamc@870 54 | String => "text"
adamc@1011 55 | Char => "character"
adamc@871 56 | Bool => "boolean"
adamc@871 57 | Time => "timestamp without time zone"
adamc@870 58 | Blob => "bytea"
adamc@871 59 | Channel => "bigint"
adamc@871 60 | Client => "integer"
adamc@870 61 | Nullable t => p_sql_type_base t
adamc@870 62
adamc@872 63 fun checkRel (table, checkNullable) (s, xts) =
adamc@871 64 let
adamc@871 65 val sl = CharVector.map Char.toLower s
adamc@871 66
adamc@872 67 val q = "SELECT COUNT(*) FROM information_schema." ^ table ^ " WHERE table_name = '"
adamc@871 68 ^ sl ^ "'"
adamc@871 69
adamc@871 70 val q' = String.concat ["SELECT COUNT(*) FROM information_schema.columns WHERE table_name = '",
adamc@871 71 sl,
adamc@871 72 "' AND (",
adam@1600 73 case String.concatWith " OR "
adam@1600 74 (map (fn (x, t) =>
adam@1600 75 String.concat ["(column_name = 'uw_",
adam@1600 76 CharVector.map
adam@1600 77 Char.toLower (ident x),
adam@1600 78 (case p_sql_type_base t of
adam@1600 79 "bigint" =>
adam@1600 80 "' AND data_type IN ('bigint', 'numeric')"
adam@1600 81 | t =>
adam@1600 82 String.concat ["' AND data_type = '",
adam@1600 83 t,
adam@1600 84 "'"]),
adam@1600 85 if checkNullable then
adam@1600 86 (" AND is_nullable = '"
adam@1600 87 ^ (if isNotNull t then
adam@1600 88 "NO"
adam@1600 89 else
adam@1600 90 "YES")
adam@1600 91 ^ "'")
adam@1600 92 else
adam@1600 93 "",
adam@1600 94 ")"]) xts) of
adam@1600 95 "" => "FALSE"
adam@1600 96 | s => s,
adamc@871 97 ")"]
adamc@871 98
adamc@871 99 val q'' = String.concat ["SELECT COUNT(*) FROM information_schema.columns WHERE table_name = '",
adamc@871 100 sl,
adamc@871 101 "' AND column_name LIKE 'uw_%'"]
adamc@871 102 in
adamc@871 103 box [string "res = PQexec(conn, \"",
adamc@871 104 string q,
adamc@871 105 string "\");",
adamc@871 106 newline,
adamc@871 107 newline,
adamc@871 108 string "if (res == NULL) {",
adamc@871 109 newline,
adamc@871 110 box [string "PQfinish(conn);",
adamc@871 111 newline,
adamc@871 112 string "uw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
adamc@871 113 newline],
adamc@871 114 string "}",
adamc@871 115 newline,
adamc@871 116 newline,
adamc@871 117 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
adamc@871 118 newline,
adamc@871 119 box [string "char msg[1024];",
adamc@871 120 newline,
adamc@871 121 string "strncpy(msg, PQerrorMessage(conn), 1024);",
adamc@871 122 newline,
adamc@871 123 string "msg[1023] = 0;",
adamc@871 124 newline,
adamc@871 125 string "PQclear(res);",
adamc@871 126 newline,
adamc@871 127 string "PQfinish(conn);",
adamc@871 128 newline,
adamc@871 129 string "uw_error(ctx, FATAL, \"Query failed:\\n",
adamc@871 130 string q,
adamc@871 131 string "\\n%s\", msg);",
adamc@871 132 newline],
adamc@871 133 string "}",
adamc@871 134 newline,
adamc@871 135 newline,
adamc@871 136 string "if (strcmp(PQgetvalue(res, 0, 0), \"1\")) {",
adamc@871 137 newline,
adamc@871 138 box [string "PQclear(res);",
adamc@871 139 newline,
adamc@871 140 string "PQfinish(conn);",
adamc@871 141 newline,
adamc@871 142 string "uw_error(ctx, FATAL, \"Table '",
adamc@871 143 string s,
adamc@871 144 string "' does not exist.\");",
adamc@871 145 newline],
adamc@871 146 string "}",
adamc@871 147 newline,
adamc@871 148 newline,
adamc@871 149 string "PQclear(res);",
adamc@871 150 newline,
adamc@871 151
adamc@871 152 string "res = PQexec(conn, \"",
adamc@871 153 string q',
adamc@871 154 string "\");",
adamc@871 155 newline,
adamc@871 156 newline,
adamc@871 157 string "if (res == NULL) {",
adamc@871 158 newline,
adamc@871 159 box [string "PQfinish(conn);",
adamc@871 160 newline,
adamc@871 161 string "uw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
adamc@871 162 newline],
adamc@871 163 string "}",
adamc@871 164 newline,
adamc@871 165 newline,
adamc@871 166 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
adamc@871 167 newline,
adamc@871 168 box [string "char msg[1024];",
adamc@871 169 newline,
adamc@871 170 string "strncpy(msg, PQerrorMessage(conn), 1024);",
adamc@871 171 newline,
adamc@871 172 string "msg[1023] = 0;",
adamc@871 173 newline,
adamc@871 174 string "PQclear(res);",
adamc@871 175 newline,
adamc@871 176 string "PQfinish(conn);",
adamc@871 177 newline,
adamc@871 178 string "uw_error(ctx, FATAL, \"Query failed:\\n",
adamc@871 179 string q',
adamc@871 180 string "\\n%s\", msg);",
adamc@871 181 newline],
adamc@871 182 string "}",
adamc@871 183 newline,
adamc@871 184 newline,
adamc@871 185 string "if (strcmp(PQgetvalue(res, 0, 0), \"",
adamc@871 186 string (Int.toString (length xts)),
adamc@871 187 string "\")) {",
adamc@871 188 newline,
adamc@871 189 box [string "PQclear(res);",
adamc@871 190 newline,
adamc@871 191 string "PQfinish(conn);",
adamc@871 192 newline,
adamc@871 193 string "uw_error(ctx, FATAL, \"Table '",
adamc@871 194 string s,
adamc@871 195 string "' has the wrong column types.\");",
adamc@871 196 newline],
adamc@871 197 string "}",
adamc@871 198 newline,
adamc@871 199 newline,
adamc@871 200 string "PQclear(res);",
adamc@871 201 newline,
adamc@871 202 newline,
adamc@871 203
adamc@871 204 string "res = PQexec(conn, \"",
adamc@871 205 string q'',
adamc@871 206 string "\");",
adamc@871 207 newline,
adamc@871 208 newline,
adamc@871 209 string "if (res == NULL) {",
adamc@871 210 newline,
adamc@871 211 box [string "PQfinish(conn);",
adamc@871 212 newline,
adamc@871 213 string "uw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
adamc@871 214 newline],
adamc@871 215 string "}",
adamc@871 216 newline,
adamc@871 217 newline,
adamc@871 218 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
adamc@871 219 newline,
adamc@871 220 box [string "char msg[1024];",
adamc@871 221 newline,
adamc@871 222 string "strncpy(msg, PQerrorMessage(conn), 1024);",
adamc@871 223 newline,
adamc@871 224 string "msg[1023] = 0;",
adamc@871 225 newline,
adamc@871 226 string "PQclear(res);",
adamc@871 227 newline,
adamc@871 228 string "PQfinish(conn);",
adamc@871 229 newline,
adamc@871 230 string "uw_error(ctx, FATAL, \"Query failed:\\n",
adamc@871 231 string q'',
adamc@871 232 string "\\n%s\", msg);",
adamc@871 233 newline],
adamc@871 234 string "}",
adamc@871 235 newline,
adamc@871 236 newline,
adamc@871 237 string "if (strcmp(PQgetvalue(res, 0, 0), \"",
adamc@871 238 string (Int.toString (length xts)),
adamc@871 239 string "\")) {",
adamc@871 240 newline,
adamc@871 241 box [string "PQclear(res);",
adamc@871 242 newline,
adamc@871 243 string "PQfinish(conn);",
adamc@871 244 newline,
adamc@871 245 string "uw_error(ctx, FATAL, \"Table '",
adamc@871 246 string s,
adamc@871 247 string "' has extra columns.\");",
adamc@871 248 newline],
adamc@871 249 string "}",
adamc@871 250 newline,
adamc@871 251 newline,
adamc@871 252 string "PQclear(res);",
adamc@871 253 newline]
adamc@871 254 end
adamc@871 255
adamc@872 256 fun init {dbstring, prepared = ss, tables, views, sequences} =
adamc@866 257 box [if #persistent (currentProtocol ()) then
adamc@1094 258 box [string "static void uw_db_validate(uw_context ctx) {",
adamc@870 259 newline,
adamc@870 260 string "PGconn *conn = uw_get_db(ctx);",
adamc@870 261 newline,
adamc@870 262 string "PGresult *res;",
adamc@870 263 newline,
adamc@870 264 newline,
adamc@872 265 p_list_sep newline (checkRel ("tables", true)) tables,
adamc@872 266 p_list_sep newline (checkRel ("views", false)) views,
adamc@870 267
adamc@870 268 p_list_sep newline
adamc@870 269 (fn s =>
adamc@870 270 let
adamc@870 271 val sl = CharVector.map Char.toLower s
adamc@870 272
adamc@870 273 val q = "SELECT COUNT(*) FROM pg_class WHERE relname = '"
adamc@870 274 ^ sl ^ "' AND relkind = 'S'"
adamc@870 275 in
adamc@870 276 box [string "res = PQexec(conn, \"",
adamc@870 277 string q,
adamc@870 278 string "\");",
adamc@870 279 newline,
adamc@870 280 newline,
adamc@870 281 string "if (res == NULL) {",
adamc@870 282 newline,
adamc@870 283 box [string "PQfinish(conn);",
adamc@870 284 newline,
adamc@870 285 string "uw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
adamc@870 286 newline],
adamc@870 287 string "}",
adamc@870 288 newline,
adamc@870 289 newline,
adamc@870 290 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
adamc@870 291 newline,
adamc@870 292 box [string "char msg[1024];",
adamc@870 293 newline,
adamc@870 294 string "strncpy(msg, PQerrorMessage(conn), 1024);",
adamc@870 295 newline,
adamc@870 296 string "msg[1023] = 0;",
adamc@870 297 newline,
adamc@870 298 string "PQclear(res);",
adamc@870 299 newline,
adamc@870 300 string "PQfinish(conn);",
adamc@870 301 newline,
adamc@870 302 string "uw_error(ctx, FATAL, \"Query failed:\\n",
adamc@870 303 string q,
adamc@870 304 string "\\n%s\", msg);",
adamc@870 305 newline],
adamc@870 306 string "}",
adamc@870 307 newline,
adamc@870 308 newline,
adamc@870 309 string "if (strcmp(PQgetvalue(res, 0, 0), \"1\")) {",
adamc@870 310 newline,
adamc@870 311 box [string "PQclear(res);",
adamc@870 312 newline,
adamc@870 313 string "PQfinish(conn);",
adamc@870 314 newline,
adamc@870 315 string "uw_error(ctx, FATAL, \"Sequence '",
adamc@870 316 string s,
adamc@870 317 string "' does not exist.\");",
adamc@870 318 newline],
adamc@870 319 string "}",
adamc@870 320 newline,
adamc@870 321 newline,
adamc@870 322 string "PQclear(res);",
adamc@870 323 newline]
adamc@870 324 end) sequences,
adamc@870 325
adamc@870 326 string "}",
adamc@870 327
adamc@870 328 string "static void uw_db_prepare(uw_context ctx) {",
adamc@866 329 newline,
adamc@866 330 string "PGconn *conn = uw_get_db(ctx);",
adamc@866 331 newline,
adamc@866 332 string "PGresult *res;",
adamc@866 333 newline,
adamc@866 334 newline,
adamc@866 335
adamc@866 336 p_list_sepi newline (fn i => fn (s, n) =>
adamc@866 337 box [string "res = PQprepare(conn, \"uw",
adamc@866 338 string (Int.toString i),
adamc@866 339 string "\", \"",
adam@1656 340 string (Prim.toCString s),
adamc@866 341 string "\", ",
adamc@866 342 string (Int.toString n),
adamc@866 343 string ", NULL);",
adamc@866 344 newline,
adamc@866 345 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
adamc@866 346 newline,
adamc@866 347 box [string "char msg[1024];",
adamc@866 348 newline,
adamc@866 349 string "strncpy(msg, PQerrorMessage(conn), 1024);",
adamc@866 350 newline,
adamc@866 351 string "msg[1023] = 0;",
adamc@866 352 newline,
adamc@866 353 string "PQclear(res);",
adamc@866 354 newline,
adamc@866 355 string "PQfinish(conn);",
adamc@866 356 newline,
adamc@866 357 string "uw_error(ctx, FATAL, \"Unable to create prepared statement:\\n",
adam@1656 358 string (Prim.toCString s),
adamc@866 359 string "\\n%s\", msg);",
adamc@866 360 newline],
adamc@866 361 string "}",
adamc@866 362 newline,
adamc@866 363 string "PQclear(res);",
adamc@866 364 newline])
adamc@866 365 ss,
adamc@866 366
adamc@866 367 string "}",
adamc@866 368 newline,
adamc@866 369 newline]
adamc@866 370 else
adamc@870 371 box [string "static void uw_db_validate(uw_context ctx) { }",
adamc@870 372 newline,
adamc@870 373 string "static void uw_db_prepare(uw_context ctx) { }"],
adamc@870 374
adamc@1094 375 string "static void uw_client_init(void) {",
adamc@1094 376 newline,
adamc@1094 377 box [string "uw_sqlfmtInt = \"%lld::int8%n\";",
adamc@1094 378 newline,
adamc@1094 379 string "uw_sqlfmtFloat = \"%g::float8%n\";",
adamc@1094 380 newline,
adamc@1094 381 string "uw_Estrings = 1;",
adamc@1094 382 newline,
adamc@1094 383 string "uw_sqlsuffixString = \"::text\";",
adamc@1094 384 newline,
adamc@1094 385 string "uw_sqlsuffixChar = \"::char\";",
adamc@1094 386 newline,
adamc@1094 387 string "uw_sqlsuffixBlob = \"::bytea\";",
adamc@1094 388 newline,
adamc@1094 389 string "uw_sqlfmtUint4 = \"%u::int4%n\";",
adamc@1094 390 newline],
adamc@1094 391 string "}",
adamc@866 392 newline,
adamc@866 393 newline,
adamc@866 394
adamc@1094 395 string "static void uw_db_close(uw_context ctx) {",
adamc@1094 396 newline,
adamc@1094 397 string "PQfinish(uw_get_db(ctx));",
adamc@1094 398 newline,
adamc@1094 399 string "}",
adamc@1094 400 newline,
adamc@1094 401 newline,
adamc@1094 402
adamc@1094 403 string "static int uw_db_begin(uw_context ctx) {",
adamc@1094 404 newline,
adamc@1094 405 string "PGconn *conn = uw_get_db(ctx);",
adamc@1094 406 newline,
adamc@1094 407 string "PGresult *res = PQexec(conn, \"BEGIN ISOLATION LEVEL SERIALIZABLE\");",
adamc@1094 408 newline,
adamc@1094 409 newline,
adamc@1094 410 string "if (res == NULL) return 1;",
adamc@1094 411 newline,
adamc@1094 412 newline,
adamc@1094 413 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
adamc@1094 414 box [string "PQclear(res);",
adamc@1094 415 newline,
adamc@1094 416 string "return 1;",
adamc@1094 417 newline],
adamc@1094 418 string "}",
adamc@1094 419 newline,
adamc@1144 420 string "PQclear(res);",
adamc@1144 421 newline,
adamc@1094 422 string "return 0;",
adamc@1094 423 newline,
adamc@1094 424 string "}",
adamc@1094 425 newline,
adamc@1094 426 newline,
adamc@1094 427
adamc@1094 428 string "static int uw_db_commit(uw_context ctx) {",
adamc@1094 429 newline,
adamc@1094 430 string "PGconn *conn = uw_get_db(ctx);",
adamc@1094 431 newline,
adamc@1094 432 string "PGresult *res = PQexec(conn, \"COMMIT\");",
adamc@1094 433 newline,
adamc@1094 434 newline,
adamc@1094 435 string "if (res == NULL) return 1;",
adamc@1094 436 newline,
adamc@1094 437 newline,
adamc@1094 438 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
adamc@1094 439 box [string "PQclear(res);",
adamc@1094 440 newline,
adamc@1094 441 string "return 1;",
adamc@1094 442 newline],
adamc@1094 443 string "}",
adamc@1094 444 newline,
adamc@1144 445 string "PQclear(res);",
adamc@1144 446 newline,
adamc@1094 447 string "return 0;",
adamc@1094 448 newline,
adamc@1094 449 string "}",
adamc@1094 450 newline,
adamc@1094 451 newline,
adamc@1094 452
adamc@1094 453 string "static int uw_db_rollback(uw_context ctx) {",
adamc@1094 454 newline,
adamc@1094 455 string "PGconn *conn = uw_get_db(ctx);",
adamc@1094 456 newline,
adamc@1094 457 string "PGresult *res = PQexec(conn, \"ROLLBACK\");",
adamc@1094 458 newline,
adamc@1094 459 newline,
adamc@1094 460 string "if (res == NULL) return 1;",
adamc@1094 461 newline,
adamc@1094 462 newline,
adamc@1094 463 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
adamc@1094 464 box [string "PQclear(res);",
adamc@1094 465 newline,
adamc@1094 466 string "return 1;",
adamc@1094 467 newline],
adamc@1094 468 string "}",
adamc@1094 469 newline,
adamc@1144 470 string "PQclear(res);",
adamc@1144 471 newline,
adamc@1094 472 string "return 0;",
adamc@1094 473 newline,
adamc@1094 474 string "}",
adamc@1094 475
adamc@1094 476 newline,
adamc@1094 477 newline,
adamc@1094 478
adamc@1094 479 string "static void uw_db_init(uw_context ctx) {",
adamc@866 480 newline,
as@1564 481 string "char *env_db_str = getenv(\"URWEB_PQ_CON\");",
as@1564 482 newline,
as@1564 483 string "PGconn *conn = PQconnectdb(env_db_str == NULL ? \"",
adam@1656 484 string (Prim.toCString dbstring),
as@1564 485 string "\" : env_db_str);",
adamc@866 486 newline,
adamc@866 487 string "if (conn == NULL) uw_error(ctx, FATAL, ",
adamc@866 488 string "\"libpq can't allocate a connection.\");",
adamc@866 489 newline,
adamc@866 490 string "if (PQstatus(conn) != CONNECTION_OK) {",
adamc@866 491 newline,
adamc@866 492 box [string "char msg[1024];",
adamc@866 493 newline,
adamc@866 494 string "strncpy(msg, PQerrorMessage(conn), 1024);",
adamc@866 495 newline,
adamc@866 496 string "msg[1023] = 0;",
adamc@866 497 newline,
adamc@866 498 string "PQfinish(conn);",
adamc@866 499 newline,
adamc@866 500 string "uw_error(ctx, BOUNDED_RETRY, ",
adamc@866 501 string "\"Connection to Postgres server failed: %s\", msg);"],
adamc@866 502 newline,
adamc@866 503 string "}",
adamc@866 504 newline,
adamc@866 505 string "uw_set_db(ctx, conn);",
adamc@866 506 newline,
adamc@866 507 string "uw_db_validate(ctx);",
adamc@866 508 newline,
adamc@866 509 string "uw_db_prepare(ctx);",
adamc@866 510 newline,
adamc@866 511 string "}"]
adamc@866 512
adamc@880 513 fun p_getcol {loc, wontLeakStrings, col = i, typ = t} =
adamc@867 514 let
adamc@867 515 fun p_unsql t e eLen =
adamc@867 516 case t of
adamc@867 517 Int => box [string "uw_Basis_stringToInt_error(ctx, ", e, string ")"]
adamc@867 518 | Float => box [string "uw_Basis_stringToFloat_error(ctx, ", e, string ")"]
adamc@867 519 | String =>
adamc@867 520 if wontLeakStrings then
adamc@867 521 e
adamc@867 522 else
adamc@867 523 box [string "uw_strdup(ctx, ", e, string ")"]
adamc@1011 524 | Char => box [e, string "[0]"]
adamc@867 525 | Bool => box [string "uw_Basis_stringToBool_error(ctx, ", e, string ")"]
adamc@939 526 | Time => box [string "uw_Basis_unsqlTime(ctx, ", e, string ")"]
adamc@867 527 | Blob => box [string "uw_Basis_stringToBlob_error(ctx, ",
adamc@867 528 e,
adamc@867 529 string ", ",
adamc@867 530 eLen,
adamc@867 531 string ")"]
adamc@867 532 | Channel => box [string "uw_Basis_stringToChannel_error(ctx, ", e, string ")"]
adamc@867 533 | Client => box [string "uw_Basis_stringToClient_error(ctx, ", e, string ")"]
adamc@867 534
adamc@867 535 | Nullable _ => raise Fail "Postgres: Recursive Nullable"
adamc@867 536
adamc@867 537 fun getter t =
adamc@867 538 case t of
adamc@867 539 Nullable t =>
adamc@867 540 box [string "(PQgetisnull(res, i, ",
adamc@867 541 string (Int.toString i),
adamc@867 542 string ") ? NULL : ",
adamc@867 543 case t of
adamc@867 544 String => getter t
adamc@867 545 | _ => box [string "({",
adamc@867 546 newline,
adamc@874 547 string (p_sql_ctype t),
adamc@867 548 space,
adamc@867 549 string "*tmp = uw_malloc(ctx, sizeof(",
adamc@874 550 string (p_sql_ctype t),
adamc@867 551 string "));",
adamc@867 552 newline,
adamc@867 553 string "*tmp = ",
adamc@867 554 getter t,
adamc@867 555 string ";",
adamc@867 556 newline,
adamc@867 557 string "tmp;",
adamc@867 558 newline,
adamc@867 559 string "})"],
adamc@867 560 string ")"]
adamc@867 561 | _ =>
adamc@867 562 box [string "(PQgetisnull(res, i, ",
adamc@867 563 string (Int.toString i),
adamc@867 564 string ") ? ",
adamc@867 565 box [string "({",
adamc@874 566 string (p_sql_ctype t),
adamc@867 567 space,
adamc@867 568 string "tmp;",
adamc@867 569 newline,
adamc@880 570 string "uw_error(ctx, FATAL, \"",
adamc@880 571 string (ErrorMsg.spanToString loc),
adamc@880 572 string ": Unexpectedly NULL field #",
adamc@867 573 string (Int.toString i),
adamc@867 574 string "\");",
adamc@867 575 newline,
adamc@867 576 string "tmp;",
adamc@867 577 newline,
adamc@867 578 string "})"],
adamc@867 579 string " : ",
adamc@867 580 p_unsql t
adamc@867 581 (box [string "PQgetvalue(res, i, ",
adamc@867 582 string (Int.toString i),
adamc@867 583 string ")"])
adamc@867 584 (box [string "PQgetlength(res, i, ",
adamc@867 585 string (Int.toString i),
adamc@867 586 string ")"]),
adamc@867 587 string ")"]
adamc@867 588 in
adamc@867 589 getter t
adamc@867 590 end
adamc@867 591
adamc@873 592 fun queryCommon {loc, query, cols, doCols} =
adamc@867 593 box [string "int n, i;",
adamc@867 594 newline,
adamc@867 595 newline,
adamc@867 596
adamc@867 597 string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
adamc@867 598 newline,
adamc@867 599 newline,
adamc@867 600
adamc@867 601 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
adamc@867 602 newline,
adamc@867 603 box [string "PQclear(res);",
adamc@867 604 newline,
adamc@867 605 string "uw_error(ctx, FATAL, \"",
adamc@867 606 string (ErrorMsg.spanToString loc),
adamc@867 607 string ": Query failed:\\n%s\\n%s\", ",
adamc@867 608 query,
adamc@867 609 string ", PQerrorMessage(conn));",
adamc@867 610 newline],
adamc@867 611 string "}",
adamc@867 612 newline,
adamc@867 613 newline,
adamc@867 614
adamc@867 615 string "if (PQnfields(res) != ",
adamc@873 616 string (Int.toString (length cols)),
adamc@867 617 string ") {",
adamc@867 618 newline,
adamc@867 619 box [string "int nf = PQnfields(res);",
adamc@867 620 newline,
adamc@867 621 string "PQclear(res);",
adamc@867 622 newline,
adamc@867 623 string "uw_error(ctx, FATAL, \"",
adamc@867 624 string (ErrorMsg.spanToString loc),
adamc@867 625 string ": Query returned %d columns instead of ",
adamc@873 626 string (Int.toString (length cols)),
adamc@867 627 string ":\\n%s\\n%s\", nf, ",
adamc@867 628 query,
adamc@867 629 string ", PQerrorMessage(conn));",
adamc@867 630 newline],
adamc@867 631 string "}",
adamc@867 632 newline,
adamc@867 633 newline,
adamc@867 634
adamc@867 635 string "uw_end_region(ctx);",
adamc@867 636 newline,
adamc@867 637 string "uw_push_cleanup(ctx, (void (*)(void *))PQclear, res);",
adamc@867 638 newline,
adamc@867 639 string "n = PQntuples(res);",
adamc@867 640 newline,
adamc@867 641 string "for (i = 0; i < n; ++i) {",
adamc@867 642 newline,
adamc@867 643 doCols p_getcol,
adamc@867 644 string "}",
adamc@867 645 newline,
adamc@867 646 newline,
adamc@867 647 string "uw_pop_cleanup(ctx);",
adam@1682 648 newline]
adamc@867 649
adamc@873 650 fun query {loc, cols, doCols} =
adamc@867 651 box [string "PGconn *conn = uw_get_db(ctx);",
adamc@867 652 newline,
adamc@867 653 string "PGresult *res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);",
adamc@867 654 newline,
adamc@867 655 newline,
adamc@873 656 queryCommon {loc = loc, cols = cols, doCols = doCols, query = string "query"}]
adamc@867 657
adamc@867 658 fun p_ensql t e =
adamc@867 659 case t of
adamc@867 660 Int => box [string "uw_Basis_attrifyInt(ctx, ", e, string ")"]
adamc@867 661 | Float => box [string "uw_Basis_attrifyFloat(ctx, ", e, string ")"]
adamc@867 662 | String => e
adamc@1011 663 | Char => box [string "uw_Basis_attrifyChar(ctx, ", e, string ")"]
adamc@867 664 | Bool => box [string "(", e, string " ? \"TRUE\" : \"FALSE\")"]
adam@1364 665 | Time => box [string "uw_Basis_ensqlTime(ctx, ", e, string ")"]
adamc@867 666 | Blob => box [e, string ".data"]
adamc@867 667 | Channel => box [string "uw_Basis_attrifyChannel(ctx, ", e, string ")"]
adamc@867 668 | Client => box [string "uw_Basis_attrifyClient(ctx, ", e, string ")"]
adamc@867 669 | Nullable String => e
adamc@867 670 | Nullable t => box [string "(",
adamc@867 671 e,
adamc@867 672 string " == NULL ? NULL : ",
adamc@867 673 p_ensql t (box [string "(*", e, string ")"]),
adamc@867 674 string ")"]
adamc@867 675
adam@1431 676 fun makeParams inputs =
adam@1431 677 box [string "static const int paramFormats[] = { ",
adamc@867 678 p_list_sep (box [string ",", space])
adamc@867 679 (fn t => if isBlob t then string "1" else string "0") inputs,
adamc@867 680 string " };",
adamc@867 681 newline,
adam@1431 682 if List.exists isBlob inputs then
adam@1650 683 box [string "int *paramLengths = uw_malloc(ctx, ",
adam@1431 684 string (Int.toString (length inputs)),
adam@1431 685 string " * sizeof(int));",
adam@1431 686 newline,
adam@1431 687 p_list_sepi (box [])
adam@1431 688 (fn i => fn t =>
adam@1431 689 box [string "paramLengths[",
adam@1431 690 string (Int.toString i),
adam@1431 691 string "] = ",
adam@1431 692 case t of
adam@1431 693 Blob => string ("arg" ^ Int.toString (i + 1) ^ ".size")
adam@1431 694 | Nullable Blob => string ("arg" ^ Int.toString (i + 1)
adam@1431 695 ^ "?arg" ^ Int.toString (i + 1) ^ "->size:0")
adam@1431 696 | _ => string "0",
adam@1431 697 string ";",
adam@1431 698 newline]) inputs,
adam@1431 699 newline]
adam@1431 700 else
adam@1431 701 box [string "const int *paramLengths = paramFormats;",
adam@1431 702 newline],
adam@1431 703
adam@1431 704 string "const char **paramValues = uw_malloc(ctx, ",
adam@1431 705 string (Int.toString (length inputs)),
adam@1431 706 string " * sizeof(char*));",
adamc@867 707 newline,
adam@1431 708 p_list_sepi (box [])
adam@1431 709 (fn i => fn t => box [string "paramValues[",
adam@1431 710 string (Int.toString i),
adam@1431 711 string "] = ",
adam@1431 712 p_ensql t (box [string "arg",
adam@1431 713 string (Int.toString (i + 1))]),
adam@1431 714 string ";",
adam@1431 715 newline])
adamc@867 716 inputs,
adam@1431 717 newline]
adam@1431 718
adam@1431 719 fun queryPrepared {loc, id, query, inputs, cols, doCols, nested = _} =
adam@1431 720 box [string "PGconn *conn = uw_get_db(ctx);",
adamc@867 721 newline,
adam@1431 722
adam@1431 723 makeParams inputs,
adam@1431 724
adamc@867 725 newline,
adamc@867 726 string "PGresult *res = ",
adamc@867 727 if #persistent (Settings.currentProtocol ()) then
adamc@867 728 box [string "PQexecPrepared(conn, \"uw",
adamc@867 729 string (Int.toString id),
adamc@867 730 string "\", ",
adamc@867 731 string (Int.toString (length inputs)),
adamc@867 732 string ", paramValues, paramLengths, paramFormats, 0);"]
adamc@867 733 else
adamc@867 734 box [string "PQexecParams(conn, \"",
adam@1656 735 string (Prim.toCString query),
adamc@867 736 string "\", ",
adamc@867 737 string (Int.toString (length inputs)),
adamc@867 738 string ", NULL, paramValues, paramLengths, paramFormats, 0);"],
adamc@867 739 newline,
adamc@867 740 newline,
adamc@873 741 queryCommon {loc = loc, cols = cols, doCols = doCols, query = box [string "\"",
adam@1656 742 string (Prim.toCString query),
adamc@873 743 string "\""]}]
adamc@867 744
adam@1293 745 fun dmlCommon {loc, dml, mode} =
adamc@868 746 box [string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating DML result.\");",
adamc@868 747 newline,
adamc@868 748 newline,
adamc@868 749
adamc@868 750 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
adamc@868 751 newline,
adamc@868 752 box [string "if (!strcmp(PQresultErrorField(res, PG_DIAG_SQLSTATE), \"40001\")) {",
adamc@868 753 box [newline,
adamc@868 754 string "PQclear(res);",
adamc@868 755 newline,
adamc@868 756 string "uw_error(ctx, UNLIMITED_RETRY, \"Serialization failure\");",
adamc@868 757 newline],
adamc@868 758 string "}",
adamc@868 759 newline,
adam@1550 760 string "if (!strcmp(PQresultErrorField(res, PG_DIAG_SQLSTATE), \"40P01\")) {",
adam@1550 761 box [newline,
adam@1550 762 string "PQclear(res);",
adam@1550 763 newline,
adam@1550 764 string "uw_error(ctx, UNLIMITED_RETRY, \"Deadlock detected\");",
adam@1550 765 newline],
adam@1550 766 string "}",
adam@1550 767 newline,
adam@1293 768 case mode of
adam@1293 769 Settings.Error => box [string "PQclear(res);",
adam@1293 770 newline,
adam@1293 771 string "uw_error(ctx, FATAL, \"",
adam@1293 772 string (ErrorMsg.spanToString loc),
adam@1293 773 string ": DML failed:\\n%s\\n%s\", ",
adam@1293 774 dml,
adam@1293 775 string ", PQerrorMessage(conn));"]
adam@1295 776 | Settings.None => box [string "uw_set_error_message(ctx, PQerrorMessage(conn));",
adam@1295 777 newline,
adam@1295 778 newline,
adam@1295 779
adam@1295 780 string "res = PQexec(conn, \"ROLLBACK TO s\");",
adam@1295 781 newline,
adam@1295 782 string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating DML result.\");",
adam@1295 783 newline,
adam@1295 784 newline,
adam@1295 785
adam@1295 786 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
adam@1295 787 newline,
adam@1295 788 box [string "PQclear(res);",
adam@1295 789 newline,
adam@1295 790 string "uw_error(ctx, FATAL, \"",
adam@1295 791 string (ErrorMsg.spanToString loc),
adam@1295 792 string ": ROLLBACK TO failed:\\n%s\\n%s\", ",
adam@1295 793 dml,
adam@1295 794 string ", PQerrorMessage(conn));",
adam@1295 795 newline,
adam@1295 796 string "}"],
adam@1295 797 newline,
adam@1295 798
adam@1295 799 string "PQclear(res);",
adam@1295 800 newline],
adamc@868 801 newline],
adamc@868 802 string "}",
adamc@868 803
adam@1295 804 case mode of
adam@1295 805 Error => box [newline,
adam@1295 806 newline,
adam@1295 807 string "PQclear(res);",
adam@1295 808 newline]
adam@1295 809 | None => box[string " else {",
adam@1295 810 newline,
adam@1295 811 box [string "PQclear(res);",
adam@1295 812 newline,
adam@1295 813 string "res = PQexec(conn, \"RELEASE s\");",
adam@1295 814 newline,
adam@1295 815 string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating DML result.\");",
adam@1295 816 newline,
adam@1295 817 newline,
adam@1295 818
adam@1295 819 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
adam@1295 820 newline,
adam@1295 821 box [string "PQclear(res);",
adam@1295 822 newline,
adam@1295 823 string "uw_error(ctx, FATAL, \"",
adam@1295 824 string (ErrorMsg.spanToString loc),
adam@1295 825 string ": RELEASE failed:\\n%s\\n%s\", ",
adam@1295 826 dml,
adam@1295 827 string ", PQerrorMessage(conn));",
adam@1295 828 newline],
adam@1295 829 string "}",
adam@1295 830 newline,
adam@1295 831 string "PQclear(res);",
adam@1295 832 newline],
adam@1295 833 string "}",
adam@1295 834 newline]]
adam@1295 835
adam@1295 836 fun makeSavepoint mode =
adam@1295 837 case mode of
adam@1295 838 Error => box []
adam@1295 839 | None => box [string "res = PQexec(conn, \"SAVEPOINT s\");",
adam@1295 840 newline,
adam@1295 841 string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating DML result.\");",
adam@1295 842 newline,
adam@1295 843 newline,
adam@1295 844 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
adam@1295 845 box [newline,
adam@1295 846 string "PQclear(res);",
adam@1295 847 newline,
adam@1295 848 string "uw_error(ctx, FATAL, \"Error creating SAVEPOINT\");",
adam@1295 849 newline],
adam@1295 850 string "}",
adam@1295 851 newline,
adam@1295 852 string "PQclear(res);",
adam@1295 853 newline,
adam@1295 854 newline]
adamc@868 855
adam@1293 856 fun dml (loc, mode) =
adamc@868 857 box [string "PGconn *conn = uw_get_db(ctx);",
adamc@868 858 newline,
adam@1295 859 string "PGresult *res;",
adam@1295 860 newline,
adam@1295 861
adam@1295 862 makeSavepoint mode,
adam@1295 863
adam@1295 864 string "res = PQexecParams(conn, dml, 0, NULL, NULL, NULL, NULL, 0);",
adamc@868 865 newline,
adamc@868 866 newline,
adam@1293 867 dmlCommon {loc = loc, dml = string "dml", mode = mode}]
adamc@868 868
adam@1293 869 fun dmlPrepared {loc, id, dml, inputs, mode} =
adamc@868 870 box [string "PGconn *conn = uw_get_db(ctx);",
adamc@868 871 newline,
adam@1431 872
adam@1431 873 makeParams inputs,
adam@1431 874
adamc@868 875 newline,
adam@1295 876 string "PGresult *res;",
adam@1295 877 newline,
adam@1295 878 newline,
adam@1295 879
adam@1295 880 makeSavepoint mode,
adam@1295 881
adam@1295 882 string "res = ",
adamc@868 883 if #persistent (Settings.currentProtocol ()) then
adamc@868 884 box [string "PQexecPrepared(conn, \"uw",
adamc@868 885 string (Int.toString id),
adamc@868 886 string "\", ",
adamc@868 887 string (Int.toString (length inputs)),
adamc@868 888 string ", paramValues, paramLengths, paramFormats, 0);"]
adamc@868 889 else
adamc@868 890 box [string "PQexecParams(conn, \"",
adam@1656 891 string (Prim.toCString dml),
adamc@868 892 string "\", ",
adamc@868 893 string (Int.toString (length inputs)),
adamc@868 894 string ", NULL, paramValues, paramLengths, paramFormats, 0);"],
adamc@868 895 newline,
adamc@868 896 newline,
adamc@868 897 dmlCommon {loc = loc, dml = box [string "\"",
adam@1656 898 string (Prim.toCString dml),
adam@1293 899 string "\""], mode = mode}]
adamc@868 900
adamc@869 901 fun nextvalCommon {loc, query} =
adamc@869 902 box [string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating nextval result.\");",
adamc@869 903 newline,
adamc@869 904 newline,
adamc@869 905
adamc@869 906 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
adamc@869 907 newline,
adamc@869 908 box [string "PQclear(res);",
adamc@869 909 newline,
adamc@869 910 string "uw_error(ctx, FATAL, \"",
adamc@869 911 string (ErrorMsg.spanToString loc),
adamc@869 912 string ": Query failed:\\n%s\\n%s\", ",
adamc@869 913 query,
adamc@869 914 string ", PQerrorMessage(conn));",
adamc@869 915 newline],
adamc@869 916 string "}",
adamc@869 917 newline,
adamc@869 918 newline,
adamc@869 919
adamc@869 920 string "n = PQntuples(res);",
adamc@869 921 newline,
adamc@869 922 string "if (n != 1) {",
adamc@869 923 newline,
adamc@869 924 box [string "PQclear(res);",
adamc@869 925 newline,
adamc@869 926 string "uw_error(ctx, FATAL, \"",
adamc@869 927 string (ErrorMsg.spanToString loc),
adamc@869 928 string ": Wrong number of result rows:\\n%s\\n%s\", ",
adamc@869 929 query,
adamc@869 930 string ", PQerrorMessage(conn));",
adamc@869 931 newline],
adamc@869 932 string "}",
adamc@869 933 newline,
adamc@869 934 newline,
adamc@869 935
adamc@869 936 string "n = uw_Basis_stringToInt_error(ctx, PQgetvalue(res, 0, 0));",
adamc@869 937 newline,
adamc@869 938 string "PQclear(res);",
adamc@869 939 newline]
adamc@869 940
adamc@878 941 open Cjr
adamc@878 942
adamc@878 943 fun nextval {loc, seqE, seqName} =
adamc@878 944 let
adamc@878 945 val query = case seqName of
adamc@878 946 SOME s =>
adamc@879 947 string ("\"SELECT NEXTVAL('" ^ s ^ "')\"")
adamc@878 948 | _ => box [string "uw_Basis_strcat(ctx, \"SELECT NEXTVAL('\", uw_Basis_strcat(ctx, ",
adamc@878 949 seqE,
adamc@878 950 string ", \"')\"))"]
adamc@878 951 in
adamc@878 952 box [string "char *query = ",
adamc@878 953 query,
adamc@878 954 string ";",
adamc@878 955 newline,
adamc@878 956 string "PGconn *conn = uw_get_db(ctx);",
adamc@878 957 newline,
adamc@878 958 string "PGresult *res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);",
adamc@878 959 newline,
adamc@878 960 newline,
adamc@878 961 nextvalCommon {loc = loc, query = string "query"}]
adamc@878 962 end
adamc@869 963
adamc@869 964 fun nextvalPrepared {loc, id, query} =
adamc@869 965 box [string "PGconn *conn = uw_get_db(ctx);",
adamc@869 966 newline,
adamc@869 967 newline,
adamc@869 968 string "PGresult *res = ",
adamc@869 969 if #persistent (Settings.currentProtocol ()) then
adamc@869 970 box [string "PQexecPrepared(conn, \"uw",
adamc@869 971 string (Int.toString id),
adamc@869 972 string "\", 0, NULL, NULL, NULL, 0);"]
adamc@869 973 else
adamc@869 974 box [string "PQexecParams(conn, \"",
adam@1656 975 string (Prim.toCString query),
adamc@869 976 string "\", 0, NULL, NULL, NULL, NULL, 0);"],
adamc@869 977 newline,
adamc@869 978 newline,
adamc@869 979 nextvalCommon {loc = loc, query = box [string "\"",
adam@1656 980 string (Prim.toCString query),
adamc@869 981 string "\""]}]
adamc@869 982
adamc@1073 983 fun setvalCommon {loc, query} =
adamc@1073 984 box [string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating setval result.\");",
adamc@1073 985 newline,
adamc@1073 986 newline,
adamc@1073 987
adamc@1073 988 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
adamc@1073 989 newline,
adamc@1073 990 box [string "PQclear(res);",
adamc@1073 991 newline,
adamc@1073 992 string "uw_error(ctx, FATAL, \"",
adamc@1073 993 string (ErrorMsg.spanToString loc),
adamc@1073 994 string ": Query failed:\\n%s\\n%s\", ",
adamc@1073 995 query,
adamc@1073 996 string ", PQerrorMessage(conn));",
adamc@1073 997 newline],
adamc@1073 998 string "}",
adamc@1073 999 newline,
adamc@1073 1000 newline,
adamc@1073 1001
adamc@1073 1002 string "PQclear(res);",
adamc@1073 1003 newline]
adamc@1073 1004
adamc@1073 1005 fun setval {loc, seqE, count} =
adamc@1073 1006 let
adamc@1073 1007 val query = box [string "uw_Basis_strcat(ctx, \"SELECT SETVAL('\", uw_Basis_strcat(ctx, ",
adamc@1073 1008 seqE,
adamc@1073 1009 string ", uw_Basis_strcat(ctx, \"', \", uw_Basis_strcat(ctx, uw_Basis_sqlifyInt(ctx, ",
adamc@1073 1010 count,
adamc@1073 1011 string "), \")\"))))"]
adamc@1073 1012 in
adamc@1073 1013 box [string "char *query = ",
adamc@1073 1014 query,
adamc@1073 1015 string ";",
adamc@1073 1016 newline,
adamc@1073 1017 string "PGconn *conn = uw_get_db(ctx);",
adamc@1073 1018 newline,
adamc@1073 1019 string "PGresult *res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);",
adamc@1073 1020 newline,
adamc@1073 1021 newline,
adamc@1073 1022 setvalCommon {loc = loc, query = string "query"}]
adamc@1073 1023 end
adamc@1073 1024
adamc@874 1025 fun sqlifyString s = "E'" ^ String.translate (fn #"'" => "\\'"
adamc@874 1026 | #"\\" => "\\\\"
adamc@874 1027 | ch =>
adamc@874 1028 if Char.isPrint ch then
adamc@874 1029 str ch
adamc@874 1030 else
adamc@874 1031 "\\" ^ StringCvt.padLeft #"0" 3
adamc@874 1032 (Int.fmt StringCvt.OCT (ord ch)))
adam@1656 1033 (Prim.toCString s) ^ "'::text"
adamc@874 1034
adamc@874 1035 fun p_cast (s, t) = s ^ "::" ^ p_sql_type t
adamc@874 1036
adamc@874 1037 fun p_blank (n, t) = p_cast ("$" ^ Int.toString n, t)
adamc@874 1038
adamc@866 1039 val () = addDbms {name = "postgres",
adam@1682 1040 randomFunction = "RANDOM",
adam@1464 1041 header = Config.pgheader,
adamc@866 1042 link = "-lpq",
adamc@873 1043 p_sql_type = p_sql_type,
adamc@867 1044 init = init,
adamc@867 1045 query = query,
adamc@868 1046 queryPrepared = queryPrepared,
adamc@868 1047 dml = dml,
adamc@869 1048 dmlPrepared = dmlPrepared,
adamc@869 1049 nextval = nextval,
adamc@874 1050 nextvalPrepared = nextvalPrepared,
adamc@1073 1051 setval = setval,
adamc@874 1052 sqlifyString = sqlifyString,
adamc@874 1053 p_cast = p_cast,
adamc@874 1054 p_blank = p_blank,
adamc@877 1055 supportsDeleteAs = true,
adamc@886 1056 supportsUpdateAs = true,
adamc@877 1057 createSequence = fn s => "CREATE SEQUENCE " ^ s,
adamc@878 1058 textKeysNeedLengths = false,
adamc@879 1059 supportsNextval = true,
adamc@882 1060 supportsNestedPrepared = true,
adamc@890 1061 sqlPrefix = "",
adamc@1014 1062 supportsOctetLength = true,
adamc@1014 1063 trueString = "TRUE",
adamc@1196 1064 falseString = "FALSE",
adamc@1196 1065 onlyUnion = false,
adamc@1196 1066 nestedRelops = true}
adamc@874 1067
adamc@866 1068 val () = setDbms "postgres"
adamc@866 1069
adamc@866 1070 end