Mercurial > urweb

comparison src/cjr_print.sml @ 2211:ef766ef6e242

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merge.
author Ziv Scully <ziv@mit.edu>
date Sat, 13 Sep 2014 19:16:07 -0400
parents 0ca11d57c175 a9159911c3ba
children 388ba4dc7c96
comparison
equal deleted inserted replaced
2210:69c0f36255cb 2211:ef766ef6e242
1 (* Copyright (c) 2008-2012, Adam Chlipala 1 (* Copyright (c) 2008-2014, Adam Chlipala
2 * All rights reserved. 2 * All rights reserved.
3 * 3 *
4 * Redistribution and use in source and binary forms, with or without 4 * Redistribution and use in source and binary forms, with or without
5 * modification, are permitted provided that the following conditions are met: 5 * modification, are permitted provided that the following conditions are met:
6 * 6 *
201 string "==", 201 string "==",
202 space, 202 space,
203 Prim.p_t_GCC (Prim.Int n), 203 Prim.p_t_GCC (Prim.Int n),
204 string ")"] 204 string ")"]
205 | PPrim (Prim.String s) => box [string ("!strcmp(" ^ disc), 205 | PPrim (Prim.String s) => box [string ("!strcmp(" ^ disc),
206 string ",", 206 string ",",
207 space, 207 space,
208 Prim.p_t_GCC (Prim.String s), 208 Prim.p_t_GCC (Prim.String s),
209 string ")"] 209 string ")"]
210 | PPrim (Prim.Char ch) => box [string ("(" ^ disc), 210 | PPrim (Prim.Char ch) => box [string ("(" ^ disc),
211 space, 211 space,
212 string "==", 212 string "==",
213 space, 213 space,
214 Prim.p_t_GCC (Prim.Char ch), 214 Prim.p_t_GCC (Prim.Char ch),
501 | EFfiApp ("Basis", "sqlifyChannel", [(e, _)]) => [(e, Channel)] 501 | EFfiApp ("Basis", "sqlifyChannel", [(e, _)]) => [(e, Channel)]
502 | EFfiApp ("Basis", "sqlifyClient", [(e, _)]) => [(e, Client)] 502 | EFfiApp ("Basis", "sqlifyClient", [(e, _)]) => [(e, Client)]
503 503
504 | ECase (e, 504 | ECase (e,
505 [((PNone _, _), 505 [((PNone _, _),
506 (EPrim (Prim.String "NULL"), _)), 506 (EPrim (Prim.String (_, "NULL")), _)),
507 ((PSome (_, (PVar _, _)), _), 507 ((PSome (_, (PVar _, _)), _),
508 (EFfiApp (m, x, [((ERel 0, _), _)]), _))], 508 (EFfiApp (m, x, [((ERel 0, _), _)]), _))],
509 {disc = t, ...}) => map (fn (x, y) => (x, Nullable y)) (getPargs (EFfiApp (m, x, [(e, t)]), #2 e)) 509 {disc = t, ...}) => map (fn (x, y) => (x, Nullable y)) (getPargs (EFfiApp (m, x, [(e, t)]), #2 e))
510 510
511 | ECase (e, 511 | ECase (e,
512 [((PCon (_, PConFfi {mod = "Basis", con = "True", ...}, _), _), 512 [((PCon (_, PConFfi {mod = "Basis", con = "True", ...}, _), _),
513 (EPrim (Prim.String "TRUE"), _)), 513 (EPrim (Prim.String (_, "TRUE")), _)),
514 ((PCon (_, PConFfi {mod = "Basis", con = "False", ...}, _), _), 514 ((PCon (_, PConFfi {mod = "Basis", con = "False", ...}, _), _),
515 (EPrim (Prim.String "FALSE"), _))], 515 (EPrim (Prim.String (_, "FALSE")), _))],
516 _) => [(e, Bool)] 516 _) => [(e, Bool)]
517 517
518 | _ => raise Fail "CjrPrint: getPargs" 518 | _ => raise Fail "CjrPrint: getPargs"
519 519
520 val notLeakies = SS.fromList ["int", "float", "char", "time", "bool", "unit", "client", "channel", 520 val notLeakies = SS.fromList ["int", "float", "char", "time", "bool", "unit", "client", "channel",
2216 2216
2217 case prepared of 2217 case prepared of
2218 NONE => #nextval (Settings.currentDbms ()) {loc = loc, 2218 NONE => #nextval (Settings.currentDbms ()) {loc = loc,
2219 seqE = p_exp' false false env seq, 2219 seqE = p_exp' false false env seq,
2220 seqName = case #1 seq of 2220 seqName = case #1 seq of
2221 EPrim (Prim.String s) => SOME s 2221 EPrim (Prim.String (_, s)) => SOME s
2222 | _ => NONE} 2222 | _ => NONE}
2223 | SOME {id, query} => #nextvalPrepared (Settings.currentDbms ()) {loc = loc, 2223 | SOME {id, query} => #nextvalPrepared (Settings.currentDbms ()) {loc = loc,
2224 id = id, 2224 id = id,
2225 query = query}, 2225 query = query},
2226 newline, 2226 newline,
2632 [("1", t'), ("2", _)] => flatFields [] t' 2632 [("1", t'), ("2", _)] => flatFields [] t'
2633 | _ => raise Fail "CjrPrint: Bad struct for TList" 2633 | _ => raise Fail "CjrPrint: Bad struct for TList"
2634 end 2634 end
2635 | _ => NONE 2635 | _ => NONE
2636 2636
2637 val fields = foldl (fn ((ek, _, _, ts, _, _, _), fields) => 2637 val fields = foldl (fn ((ek, _, _, ts, _, _, _, _), fields) =>
2638 case ek of 2638 case ek of
2639 Action eff => 2639 Action eff =>
2640 (case List.nth (ts, length ts - 2) of 2640 (case List.nth (ts, length ts - 2) of
2641 (TRecord i, loc) => 2641 (TRecord i, loc) =>
2642 let 2642 let
2954 scripts 2954 scripts
2955 ^ "<script type=\\\"text/javascript\\\" src=\\\"" ^ x ^ "\\\"></script>\\n") 2955 ^ "<script type=\\\"text/javascript\\\" src=\\\"" ^ x ^ "\\\"></script>\\n")
2956 scripts (Settings.getScripts ()) 2956 scripts (Settings.getScripts ())
2957 end 2957 end
2958 2958
2959 fun p_page (ek, s, n, ts, ran, side, tellSig) = 2959 fun p_page (ek, s, n, ts, ran, side, dbmode, tellSig) =
2960 let 2960 let
2961 val (ts, defInputs, inputsVar, fields) = 2961 val (ts, defInputs, inputsVar, fields) =
2962 case ek of 2962 case ek of
2963 Core.Action _ => 2963 Core.Action _ =>
2964 (case List.nth (ts, length ts - 2) of 2964 (case List.nth (ts, length ts - 2) of
3104 newline]), 3104 newline]),
3105 string "uw_set_could_write_db(ctx, ", 3105 string "uw_set_could_write_db(ctx, ",
3106 string (if couldWriteDb ek then "1" else "0"), 3106 string (if couldWriteDb ek then "1" else "0"),
3107 string ");", 3107 string ");",
3108 newline, 3108 newline,
3109 string "uw_set_at_most_one_query(ctx, ",
3110 string (case dbmode of OneQuery => "1" | _ => "0"),
3111 string ");",
3112 newline,
3109 string "uw_set_needs_push(ctx, ", 3113 string "uw_set_needs_push(ctx, ",
3110 string (case side of 3114 string (case side of
3111 ServerAndPullAndPush => "1" 3115 ServerAndPullAndPush => "1"
3112 | _ => "0"), 3116 | _ => "0"),
3113 string ");", 3117 string ");",
3291 val onError = ListUtil.search (fn (DOnError n, _) => SOME n | _ => NONE) ds 3295 val onError = ListUtil.search (fn (DOnError n, _) => SOME n | _ => NONE) ds
3292 3296
3293 val now = Time.now () 3297 val now = Time.now ()
3294 val nowD = Date.fromTimeUniv now 3298 val nowD = Date.fromTimeUniv now
3295 val rfcFmt = "%a, %d %b %Y %H:%M:%S GMT" 3299 val rfcFmt = "%a, %d %b %Y %H:%M:%S GMT"
3300
3301 fun hexifyByte (b : Word8.word) : string =
3302 let
3303 val s = Int.fmt StringCvt.HEX (Word8.toInt b)
3304 in
3305 "\\x" ^ (if size s < 2 then "0" else "") ^ s
3306 end
3307
3308 fun hexify (v : Word8Vector.vector) : string =
3309 String.concat (Word8Vector.foldr (fn (b, ls) =>
3310 hexifyByte b :: ls) [] v)
3296 in 3311 in
3297 box [string "#include \"", 3312 box [string "#include \"",
3298 string (OS.Path.joinDirFile {dir = !Settings.configInclude, 3313 string (OS.Path.joinDirFile {dir = !Settings.configInclude,
3299 file = "config.h"}), 3314 file = "config.h"}),
3300 string "\"", 3315 string "\"",
3518 string "return;", 3533 string "return;",
3519 newline], 3534 newline],
3520 string "}", 3535 string "}",
3521 newline, 3536 newline,
3522 newline, 3537 newline,
3523 string "uw_write_header(ctx, \"Content-type: text/javascript\\r\\n\");", 3538 string "uw_write_header(ctx, \"Content-Type: text/javascript\\r\\n\");",
3524 newline, 3539 newline,
3525 string ("uw_write_header(ctx, \"Last-modified: " ^ Date.fmt rfcFmt nowD ^ "\\r\\n\");"), 3540 string ("uw_write_header(ctx, \"Last-Modified: " ^ Date.fmt rfcFmt nowD ^ "\\r\\n\");"),
3526 newline, 3541 newline,
3527 string ("uw_write_header(ctx, \"Cache-Control: max-age=31536000, public\\r\\n\");"), 3542 string ("uw_write_header(ctx, \"Cache-Control: max-age=31536000, public\\r\\n\");"),
3528 newline, 3543 newline,
3529 string "uw_write(ctx, jslib);", 3544 string "uw_write(ctx, jslib);",
3530 newline, 3545 newline,
3531 string "return;", 3546 string "return;",
3532 newline], 3547 newline],
3533 string "}", 3548 string "}",
3549 newline,
3550 newline,
3551
3552 p_list_sep newline (fn r =>
3553 box [string "if (!strcmp(request, \"",
3554 string (String.toCString (#Uri r)),
3555 string "\")) {",
3556 newline,
3557 box [(case #ContentType r of
3558 NONE => box []
3559 | SOME ct => box [string "uw_write_header(ctx, \"Content-Type: ",
3560 string (String.toCString ct),
3561 string "\\r\\n\");",
3562 newline]),
3563 string ("uw_write_header(ctx, \"Last-Modified: " ^ Date.fmt rfcFmt (Date.fromTimeUniv (#LastModified r)) ^ "\\r\\n\");"),
3564 newline,
3565 string ("uw_write_header(ctx, \"Content-Length: " ^ Int.toString (Word8Vector.length (#Bytes r)) ^ "\\r\\n\");"),
3566 newline,
3567 string ("uw_write_header(ctx, \"Cache-Control: max-age=31536000, public\\r\\n\");"),
3568 newline,
3569 string "uw_replace_page(ctx, \"",
3570 string (hexify (#Bytes r)),
3571 string "\", ",
3572 string (Int.toString (Word8Vector.length (#Bytes r))),
3573 string ");",
3574 newline,
3575 string "return;",
3576 newline],
3577 string "};",
3578 newline]) (Settings.listFiles ()),
3579
3534 newline, 3580 newline,
3535 p_list_sep newline (fn x => x) pds', 3581 p_list_sep newline (fn x => x) pds',
3536 newline, 3582 newline,
3537 string "uw_clear_headers(ctx);", 3583 string "uw_clear_headers(ctx);",
3538 newline, 3584 newline,