Ur/Web: src/cjr_print.sml comparison

comparison src/cjr_print.sml @ 737:d049d31a1966

Initial support for blobs and upload

author	Adam Chlipala <adamc@hcoop.net>
date	Sat, 25 Apr 2009 13:59:11 -0400
parents	796e42c93c48
children	7fa4871e8272

comparison

equal deleted inserted replaced

-:796e42c93c48
+:d049d31a1966
 | TFfi ("Basis", "float") => box [string "uw_Basis_stringToFloat_error(ctx, ", e, string ")"]
 | TFfi ("Basis", "string") =>
 if wontLeakStrings then
 e
 else
-box [string "uw_Basis_strdup(ctx, ", e, string ")"]
+box [string "uw_strdup(ctx, ", e, string ")"]
 | TFfi ("Basis", "bool") => box [string "uw_Basis_stringToBool_error(ctx, ", e, string ")"]
 | TFfi ("Basis", "time") => box [string "uw_Basis_stringToTime_error(ctx, ", e, string ")"]
 | TFfi ("Basis", "channel") => box [string "uw_Basis_stringToChannel_error(ctx, ", e, string ")"]
 | TFfi ("Basis", "client") => box [string "uw_Basis_stringToClient_error(ctx, ", e, string ")"]
 Int
 | Float
 | String
 | Bool
 | Time
+| Blob
 | Channel
 | Client
 | Nullable of sql_type
+fun isBlob Blob = true
+| isBlob (Nullable t) = isBlob t
+| isBlob _ = false
+fun isFiles (t : typ) =
+case #1 t of
+TFfi ("Basis", "files") => 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 ^ "*"
 | EFfiApp ("Basis", "sqlifyInt", [e]) => [(e, Int)]
 | EFfiApp ("Basis", "sqlifyFloat", [e]) => [(e, Float)]
 | EFfiApp ("Basis", "sqlifyString", [e]) => [(e, String)]
 | EFfiApp ("Basis", "sqlifyBool", [e]) => [(e, Bool)]
 | EFfiApp ("Basis", "sqlifyTime", [e]) => [(e, Time)]
+| EFfiApp ("Basis", "sqlifyBlob", [e]) => [(e, Blob)]
 | EFfiApp ("Basis", "sqlifyChannel", [e]) => [(e, Channel)]
 | EFfiApp ("Basis", "sqlifyClient", [e]) => [(e, Client)]
 | ECase (e,
 [((PNone _, _),
 Int => box [string "uw_Basis_attrifyInt(ctx, ", e, string ")"]
 | Float => box [string "uw_Basis_attrifyFloat(ctx, ", e, string ")"]
 | String => e
 | Bool => box [string "(", e, string " ? \"TRUE\" : \"FALSE\")"]
 | Time => box [string "uw_Basis_attrifyTime(ctx, ", e, string ")"]
+| Blob => box [e, string ".data"]
 | Channel => box [string "uw_Basis_attrifyChannel(ctx, ", e, string ")"]
 | Client => box [string "uw_Basis_attrifyClient(ctx, ", e, string ")"]
 | Nullable String => e
 | Nullable t => box [string "(",
 e,
 List.all (fn (_, _, to) => case to of
 NONE => true
 | SOME t => nl ok' t) cons
 end)
 | TFfi ("Basis", "string") => false
+| TFfi ("Basis", "blob") => false
 | TFfi _ => true
 | TOption t => allowHeapAllocated andalso nl ok t
 in
 nl IS.empty
 end
 string ";"])
 ets,
 newline,
 newline,
+string "const int paramFormats[] = { ",
+p_list_sep (box [string ",", space])
+(fn (_, t) => if isBlob t then string "1" else string "0") ets,
+string " };",
+newline,
+string "const int paramLengths[] = { ",
+p_list_sepi (box [string ",", space])
+(fn i => fn (_, Blob) => string ("arg" ^ Int.toString (i + 1) ^ ".size")
+| (_, Nullable Blob) => string ("arg" ^ Int.toString (i + 1)
+^ "?arg" ^ Int.toString (i + 1) ^ "->size:0")
+| _ => string "0") ets,
+string " };",
+newline,
 string "const char *paramValues[] = { ",
 p_list_sepi (box [string ",", space])
 (fn i => fn (_, t) => p_ensql t (box [string "arg",
 string (Int.toString (i + 1))]))
 ets,
 NONE => string "PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);"
 | SOME n => box [string "PQexecPrepared(conn, \"uw",
 string (Int.toString n),
 string "\", ",
 string (Int.toString (length (getPargs query))),
-string ", paramValues, NULL, NULL, 0);"],
+string ", paramValues, paramLengths, paramFormats, 0);"],
 newline,
 newline,
 string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
 newline,
 newline,
 string "})"]
 in
 box [string "({",
 newline,
-string "uw_Basis_string request = uw_Basis_maybe_strdup(ctx, ",
+string "uw_Basis_string request = uw_maybe_strdup(ctx, ",
 p_exp env e,
 string ");",
 newline,
 newline,
 string "(request ? ",
 TFfi ("Basis", "int") => "int8"
 | TFfi ("Basis", "float") => "float8"
 | TFfi ("Basis", "string") => "text"
 | TFfi ("Basis", "bool") => "bool"
 | TFfi ("Basis", "time") => "timestamp"
+| TFfi ("Basis", "blob") => "bytea"
 | TFfi ("Basis", "channel") => "int8"
 | TFfi ("Basis", "client") => "int4"
 | _ => (ErrorMsg.errorAt loc "Don't know SQL equivalent of type";
 Print.eprefaces' [("Type", p_typ env tAll)];
 "ERROR")
 val f = case t of
 (TFfi ("Basis", "bool"), _) => "optional_"
 | _ => ""
 in
-box [string "request = uw_get_",
+if isFiles t then
-string f,
+box [string "uw_input_",
-string "input(ctx, ",
+p_ident x,
-string (Int.toString n),
+space,
-string ");",
+string "=",
-newline,
+space,
-string "if (request == NULL)",
+string "uw_get_file_input(ctx, ",
-newline,
+string (Int.toString n),
-box [string "uw_error(ctx, FATAL, \"Missing input ",
+string ");",
-string x,
+newline]
-string "\");"],
+else
-newline,
+box [string "request = uw_get_",
-string "uw_input_",
+string f,
-p_ident x,
+string "input(ctx, ",
-space,
+string (Int.toString n),
-string "=",
+string ");",
-space,
+newline,
-unurlify env t,
+string "if (request == NULL)",
-string ";",
+newline,
-newline]
+box [string "uw_error(ctx, FATAL, \"Missing input ",
+string x,
+string "\");"],
+newline,
+string "uw_input_",
+p_ident x,
+space,
+string "=",
+space,
+unurlify env t,
+string ";",
+newline]
 end) xts),
 string "struct __uws_",
 string (Int.toString i),
 space,
 string "uw_inputs",

Mercurial > urweb

comparison src/cjr_print.sml @ 737:d049d31a1966