Merge remote-tracking branch 'upstream/master'

.gitignore

@@ -1,10 +1,14 @@
 .DS_Store
-*.pyc
-installs/
+installs
 *.log
-*.lock
 node_modules/
-*.war
+
+# eclipse
+.classpath
+.project
+.settings
+
+# maven
 target/
 *.out
 *.class
@@ -12,10 +16,51 @@ mods/
 /.settings
 /.buildpath
 /.project
+*/src/main/java/META-INF/
+*.versionsBackup
+bin/
+
+# common junk
+*.log
+*.swp
+*.diff
+*.patch
+
+# intellij
 *.iml
+*.ipr
+*.iws
 .idea/
 .hsenv/
 azure.err
 php-kohana/application/logs/
 php-fuel/fuel/app/logs/
 results/
+benchmark.cfg
+
+# Mac filesystem dust
+.DS_Store
+
+# pmd
+.pmdruleset
+.pmd
+
+# netbeans
+/nbproject
+
+# vim
+.*.sw[a-p]
+
+# merge tooling
+*.orig
+
+# maven
+*.versionsBackup
+*.releaseBackup
+
+# python-isms
+*.pyc
+
+# java / ruby stuff
+*.lock
+*.war

UrWeb/README.md

@@ -0,0 +1,14 @@
+TechEmpower Framework Benchmark: Ur/Web
+=======================================
+
+http://www.impredicative.com/ur/
+
+To compile a standalone executable running on port 8080, run `urweb bench`.
+
+`bench.ur` is the main source file. `bench.urs` is the signature file which describes the module's exported functions. `bench.urp` is the project file which gives compilation directives.
+
+`fortune.sql` and `world.sql` are for the creation and population of the `uw_Bench_fortune` and `uw_Bench_world` tables. As part of its strong security guarantees, Ur/Web follows a certain naming convention for SQL tables which is incompatible with the default table names of `fortune` and `world`.
+
+`benchmark_config` and `source_code` include metadata for the framework comparison.
+
+`__init__.py` and `setup.py` are for starting and stopping the Ur/Web server.

UrWeb/bench.ur

@@ -0,0 +1,81 @@
+open Json
+
+fun addHeaders () =
+  n <- now;
+  setHeader (blessResponseHeader "Date") (timef "%a, %d %b %Y %H:%M:%S GMT" n);
+  setHeader (blessResponseHeader "Server") "Ur/Web"
+fun clamp n =
+  (n % 10000) + 1
+fun parseQueries oqs : int =
+  let
+    val qt = case oqs of
+        None => Some ("queries", "1")
+      | Some qs => String.split (show qs) #"="
+    val on = case qt of
+        Some ("queries", x) => read x
+      | _ => Some 1
+  in
+    case on of
+      None => 1
+    | Some x => if x > 500 then 500
+                else if x < 1 then 1
+                else x
+  end
+fun returnJson [a] (_ : json a) (j : a) : transaction page =
+  addHeaders ();
+  returnBlob (textBlob (toJson j)) (blessMime "application/json")
+fun returnText (t : string) : transaction page =
+  addHeaders ();
+  returnBlob (textBlob t) (blessMime "text/plain")
+
+val hello = "Hello, World!"
+fun plaintext () =
+  returnText hello
+
+type json_t = {Message : string}
+val json_conversion : json json_t = json_record {Message = "message"}
+val hello_json = {Message = hello}
+fun json () =
+    returnJson hello_json
+
+table world : {Id : int, RandomNumber : int} PRIMARY KEY Id
+type world_t = {Id : int, RandomNumber : int}
+val world_conversion : json world_t = json_record {Id = "id", RandomNumber = "randomNumber"}
+fun world_find n =
+  oneRow1 (SELECT World.Id, World.RandomNumber FROM world WHERE World.Id = {[n]})
+
+fun db () =
+  n <- rand;
+  row <- world_find (clamp n);
+  returnJson row
+
+fun queries oqs =
+  rows <- List.tabulateM (fn _ => n <- rand; world_find (clamp n)) (parseQueries oqs);
+  returnJson rows
+
+fun updates oqs =
+  rows <- List.tabulateM (fn _ => n <- rand; world_find (clamp n)) (parseQueries oqs);
+  rows' <- List.mapM (fn r => n <- rand; return (r -- #RandomNumber ++ {RandomNumber = clamp n})) rows;
+  u <- List.mapM (fn r => dml (UPDATE world SET RandomNumber = {[r.RandomNumber]} WHERE Id = {[r.Id]})) rows';
+  returnJson rows'
+
+table fortune : {Id : int, Message : string} PRIMARY KEY Id
+type fortune_t = {Id : int, Message : string}
+val fortune_conversion : json fortune_t = json_record {Id = "id", Message = "message"}
+val new_fortune : fortune_t = {Id = 0, Message = "Additional fortune added at request time"}
+fun fortunes () =
+  fs <- queryL1 (SELECT Fortune.Id, Fortune.Message FROM fortune);
+  let
+    val fs' = List.sort (fn x y => x.Message > y.Message ) (new_fortune :: fs)
+  in
+    addHeaders ();
+    return <xml>
+             <head><title>Fortunes</title></head>
+             <body><table>
+               <tr><th>id</th><th>message</th></tr>
+               {List.mapX (fn f => <xml><tr>
+                 <td>{[f.Id]}</td><td>{[f.Message]}</td>
+               </tr></xml>) fs'}
+             </table></body>
+           </xml>
+  end

UrWeb/bench.urp

@@ -0,0 +1,13 @@
+library meta
+database dbname=hello_world user=benchmarkdbuser password=benchmarkdbpass host=localhost
+minHeap 16384
+rewrite url Bench/*
+allow responseHeader Date
+allow responseHeader Server
+allow mime application/json
+allow mime text/plain
+safeGet updates
+
+$/list
+$/string
+bench

UrWeb/bench.urs

@@ -0,0 +1,6 @@
+val json : unit -> transaction page
+val plaintext : unit -> transaction page
+val db : unit -> transaction page
+val queries: option queryString -> transaction page
+val fortunes: unit -> transaction page
+val updates: option queryString -> transaction page

UrWeb/benchmark_config

@@ -0,0 +1,26 @@
+{
+  "framework": "urweb",
+  "tests": [{
+    "default": {
+      "setup_file": "setup",
+      "json_url": "/json",
+      "db_url": "/db",
+      "query_url": "/queries?queries=",
+      "fortune_url": "/fortunes",
+      "update_url": "/updates?queries=",
+      "plaintext_url": "/plaintext",
+      "port": 8080,
+      "approach": "Realistic",
+      "classification": "Full",
+      "database": "Postgres",
+      "framework": "Ur/Web",
+      "language": "Ur",
+      "orm": "Micro",
+      "platform": "Ur/Web",
+      "webserver": "None",
+      "os": "Linux",
+      "database_os": "Linux",
+      "display_name": "Ur/Web"
+    }
+  }]
+}

UrWeb/create-postgres.sql

@@ -0,0 +1,28 @@
+DROP TABLE IF EXISTS uw_Bench_world;
+
+CREATE TABLE uw_Bench_world AS
+SELECT uw_id::int8, trunc(random()*9999+1)::int8 AS uw_randomnumber
+FROM generate_series(1,10000) AS uw_id;
+
+ALTER TABLE uw_Bench_world ADD PRIMARY KEY (uw_id);
+ALTER TABLE uw_Bench_world ALTER COLUMN uw_randomnumber SET NOT NULL;
+
+DROP TABLE IF EXISTS uw_Bench_fortune;
+CREATE TABLE uw_Bench_fortune (
+  uw_id int8 NOT NULL,
+  uw_message text NOT NULL,
+  PRIMARY KEY (uw_id)
+);
+
+INSERT INTO uw_Bench_fortune (uw_id, uw_message) VALUES (11, '<script>alert("This should not be displayed in a browser alert box.")</script>');
+INSERT INTO uw_Bench_fortune (uw_id, uw_message) VALUES (4, 'A bad random number generator: 1, 1, 1, 1, 1, 4.33e+67, 1, 1, 1');
+INSERT INTO uw_Bench_fortune (uw_id, uw_message) VALUES (5, 'A computer program does what you tell it to do, not what you want it to do.');
+INSERT INTO uw_Bench_fortune (uw_id, uw_message) VALUES (2, 'A computer scientist is someone who fixes things that aren''t broken.');
+INSERT INTO uw_Bench_fortune (uw_id, uw_message) VALUES (8, 'A list is only as strong as its weakest link. — Donald Knuth');
+INSERT INTO uw_Bench_fortune (uw_id, uw_message) VALUES (3, 'After enough decimal places, nobody gives a damn.');
+INSERT INTO uw_Bench_fortune (uw_id, uw_message) VALUES (7, 'Any program that runs right is obsolete.');
+INSERT INTO uw_Bench_fortune (uw_id, uw_message) VALUES (10, 'Computers make very fast, very accurate mistakes.');
+INSERT INTO uw_Bench_fortune (uw_id, uw_message) VALUES (6, 'Emacs is a nice operating system, but I prefer UNIX. — Tom Christaensen');
+INSERT INTO uw_Bench_fortune (uw_id, uw_message) VALUES (9, 'Feature: A bug with seniority.');
+INSERT INTO uw_Bench_fortune (uw_id, uw_message) VALUES (1, 'fortune: No such file or directory');
+INSERT INTO uw_Bench_fortune (uw_id, uw_message) VALUES (12, 'フレームワークのベンチマーク');

UrWeb/fortune.sql

@@ -0,0 +1,14 @@
+CREATE TABLE uw_Bench_fortune(uw_id int8 NOT NULL, uw_message text NOT NULL,
+  PRIMARY KEY (uw_id));
+INSERT INTO uw_Bench_fortune (uw_id, uw_message) VALUES (11, '<script>alert("This should not be displayed in a browser alert box.")</script>');
+INSERT INTO uw_Bench_fortune (uw_id, uw_message) VALUES (4, 'A bad random number generator: 1, 1, 1, 1, 1, 4.33e+67, 1, 1, 1');
+INSERT INTO uw_Bench_fortune (uw_id, uw_message) VALUES (5, 'A computer program does what you tell it to do, not what you want it to do.');
+INSERT INTO uw_Bench_fortune (uw_id, uw_message) VALUES (2, 'A computer scientist is someone who fixes things that aren''t broken.');
+INSERT INTO uw_Bench_fortune (uw_id, uw_message) VALUES (8, 'A list is only as strong as its weakest link. — Donald Knuth');
+INSERT INTO uw_Bench_fortune (uw_id, uw_message) VALUES (3, 'After enough decimal places, nobody gives a damn.');
+INSERT INTO uw_Bench_fortune (uw_id, uw_message) VALUES (7, 'Any program that runs right is obsolete.');
+INSERT INTO uw_Bench_fortune (uw_id, uw_message) VALUES (10, 'Computers make very fast, very accurate mistakes.');
+INSERT INTO uw_Bench_fortune (uw_id, uw_message) VALUES (6, 'Emacs is a nice operating system, but I prefer UNIX. — Tom Christaensen');
+INSERT INTO uw_Bench_fortune (uw_id, uw_message) VALUES (9, 'Feature: A bug with seniority.');
+INSERT INTO uw_Bench_fortune (uw_id, uw_message) VALUES (1, 'fortune: No such file or directory');
+INSERT INTO uw_Bench_fortune (uw_id, uw_message) VALUES (12, 'フレームワークのベンチマーク');

UrWeb/meta/LICENSE

@@ -0,0 +1,25 @@
+Copyright (c) 2009-2010, Adam Chlipala
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+- Redistributions of source code must retain the above copyright notice,
+  this list of conditions and the following disclaimer.
+- Redistributions in binary form must reproduce the above copyright notice,
+  this list of conditions and the following disclaimer in the documentation
+  and/or other materials provided with the distribution.
+- The names of contributors may not be used to endorse or promote products
+  derived from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.

UrWeb/meta/eq.ur

@@ -0,0 +1,76 @@
+con eq = K ==> fn (t1 :: K) (t2 :: K) => f :: (K -> Type) -> f t1 -> f t2
+
+val refl [K] [t ::: K] : eq t t = fn [f :: (K -> Type)] x => x
+
+fun sym [K] [t1 ::: K] [t2 ::: K] (e : eq t1 t2) : eq t2 t1 =
+    e [fn t => eq t t1] refl
+
+fun trans [K] [t1 ::: K] [t2 ::: K] [t3 ::: K] (e1 : eq t1 t2) (e2 : eq t2 t3) : eq t1 t3 =
+    (sym e1) [fn t => eq t t3] e2
+
+fun cast [K] [t1 ::: K] [t2 ::: K] (e : eq t1 t2) = e
+
+fun fold [K] [tf :: {K} -> Type] [r ::: {K}]
+         (f : pre :: {K} -> nm :: Name -> v :: K -> post :: {K} -> [pre ~ post] => [[nm] ~ pre ++ post] =>
+          eq r (pre ++ [nm = v] ++ post) -> tf post -> tf ([nm = v] ++ post))
+    (i : tf []) (fl : folder r) : tf r =
+    @@Top.fold [fn post => pre :: {K} -> [pre ~ post] => eq r (pre ++ post) -> tf post]
+     (fn [nm :: Name] [t :: K] [rest :: {K}] [[nm] ~ rest]
+                      (acc : pre :: {K} -> [pre ~ rest] => eq r (pre ++ rest) -> tf rest)
+                      [pre :: {K}] [pre ~ [nm = t] ++ rest] pf =>
+         f [pre] [nm] [t] [rest] pf (acc [[nm = t] ++ pre] pf))
+     (fn [pre :: {K}] [pre ~ []] _ => i) [r] fl [[]] ! refl
+
+fun foldUR [tr :: Type] [tf :: {Unit} -> Type] [r ::: {Unit}]
+    (f : pre :: {Unit} -> nm :: Name -> post :: {Unit} -> [pre ~ post] => [[nm] ~ pre ++ post] =>
+     eq r (pre ++ [nm] ++ post) -> tr -> tf post -> tf ([nm] ++ post))
+    (i : tf []) (fl : folder r) (r : $(mapU tr r)) : tf r =
+    @@fold [fn r' => $(mapU tr r') -> tf r'] [r]
+      (fn [pre :: {Unit}] [nm :: Name] [u :: Unit] [post :: {Unit}] [pre ~ post] [[nm] ~ pre ++ post] pf acc r =>
+          f [pre] [nm] [post] pf r.nm (acc (r -- nm)))
+      (fn _ => i) fl r
+
+fun foldR [K] [tr :: K -> Type] [tf :: {K} -> Type] [r ::: {K}]
+    (f : pre :: {K} -> nm :: Name -> t :: K -> post :: {K} -> [pre ~ post] => [[nm] ~ pre ++ post] =>
+     eq r (pre ++ [nm = t] ++ post) -> tr t -> tf post -> tf ([nm = t] ++ post))
+    (i : tf []) (fl : folder r) (r : $(map tr r)) : tf r =
+    @@fold [fn r' => $(map tr r') -> tf r'] [r]
+      (fn [pre :: {K}] [nm :: Name] [t :: K] [post :: {K}] [pre ~ post] [[nm] ~ pre ++ post] pf acc r =>
+          f [pre] [nm] [t] [post] pf r.nm (acc (r -- nm)))
+      (fn _ => i) fl r
+
+fun foldR2 [K] [tr1 :: K -> Type] [tr2 :: K -> Type] [tf :: {K} -> Type] [r ::: {K}]
+    (f : pre :: {K} -> nm :: Name -> t :: K -> post :: {K} -> [pre ~ post] => [[nm] ~ pre ++ post] =>
+     eq r (pre ++ [nm = t] ++ post) -> tr1 t -> tr2 t -> tf post -> tf ([nm = t] ++ post))
+    (i : tf []) (fl : folder r) (r1 : $(map tr1 r)) (r2 : $(map tr2 r)) : tf r =
+    @@fold [fn r' => $(map tr1 r') -> $(map tr2 r') -> tf r'] [r]
+      (fn [pre :: {K}] [nm :: Name] [t :: K] [post :: {K}] [pre ~ post] [[nm] ~ pre ++ post] pf acc r1 r2 =>
+          f [pre] [nm] [t] [post] pf r1.nm r2.nm (acc (r1 -- nm) (r2 -- nm)))
+      (fn _ _ => i) fl r1 r2
+
+fun foldR3 [K] [tr1 :: K -> Type] [tr2 :: K -> Type] [tr3 :: K -> Type] [tf :: {K} -> Type] [r ::: {K}]
+    (f : pre :: {K} -> nm :: Name -> t :: K -> post :: {K} -> [pre ~ post] => [[nm] ~ pre ++ post] =>
+     eq r (pre ++ [nm = t] ++ post) -> tr1 t -> tr2 t -> tr3 t -> tf post -> tf ([nm = t] ++ post))
+    (i : tf []) (fl : folder r) (r1 : $(map tr1 r)) (r2 : $(map tr2 r)) (r3 : $(map tr3 r)) : tf r =
+    @@fold [fn r' => $(map tr1 r') -> $(map tr2 r') -> $(map tr3 r') -> tf r'] [r]
+      (fn [pre :: {K}] [nm :: Name] [t :: K] [post :: {K}] [pre ~ post] [[nm] ~ pre ++ post] pf acc r1 r2 r3 =>
+          f [pre] [nm] [t] [post] pf r1.nm r2.nm r3.nm (acc (r1 -- nm) (r2 -- nm) (r3 -- nm)))
+      (fn _ _ _ => i) fl r1 r2 r3
+
+fun foldR4 [K] [tr1 :: K -> Type] [tr2 :: K -> Type] [tr3 :: K -> Type] [tr4 :: K -> Type] [tf :: {K} -> Type] [r ::: {K}]
+    (f : pre :: {K} -> nm :: Name -> t :: K -> post :: {K} -> [pre ~ post] => [[nm] ~ pre ++ post] =>
+     eq r (pre ++ [nm = t] ++ post) -> tr1 t -> tr2 t -> tr3 t -> tr4 t -> tf post -> tf ([nm = t] ++ post))
+    (i : tf []) (fl : folder r) (r1 : $(map tr1 r)) (r2 : $(map tr2 r)) (r3 : $(map tr3 r)) (r4 : $(map tr4 r)) : tf r =
+    @@fold [fn r' => $(map tr1 r') -> $(map tr2 r') -> $(map tr3 r') -> $(map tr4 r') -> tf r'] [r]
+      (fn [pre :: {K}] [nm :: Name] [t :: K] [post :: {K}] [pre ~ post] [[nm] ~ pre ++ post] pf acc r1 r2 r3 r4 =>
+          f [pre] [nm] [t] [post] pf r1.nm r2.nm r3.nm r4.nm (acc (r1 -- nm) (r2 -- nm) (r3 -- nm) (r4 -- nm)))
+      (fn _ _ _ _ => i) fl r1 r2 r3 r4
+
+fun mp [K] [tr :: K -> Type] [tf :: K -> Type] [r ::: {K}]
+       (f : nm :: Name -> t :: K -> rest :: {K} -> [[nm] ~ rest] =>
+        eq r ([nm = t] ++ rest) -> tr t -> tf t)
+    (fl : folder r) (r : $(map tr r)) : $(map tf r) =
+  @@foldR [tr] [fn r => $(map tf r)] [r]
+      (fn [pre :: {K}] [nm :: Name] [t :: K] [post :: {K}] [pre ~ post] [[nm] ~ pre ++ post] pf r acc =>
+          {nm = f [nm] [t] [pre ++ post] pf r} ++ acc)
+      {} fl r

UrWeb/meta/eq.urs

@@ -0,0 +1,44 @@
+(** A constructor equality predicate *)
+
+con eq :: K --> K -> K -> Type
+
+val refl : K --> t ::: K -> eq t t
+val sym : K --> t1 ::: K -> t2 ::: K -> eq t1 t2 -> eq t2 t1
+val trans : K --> t1 ::: K -> t2 ::: K -> t3 ::: K -> eq t1 t2 -> eq t2 t3 -> eq t1 t3
+
+val cast : K --> t1 ::: K -> t2 ::: K -> eq t1 t2 -> f :: (K -> Type) -> f t1 -> f t2
+
+val fold : K --> tf :: ({K} -> Type) -> r ::: {K}
+           -> (pre :: {K} -> nm :: Name -> v :: K -> post :: {K} -> [pre ~ post] => [[nm] ~ pre ++ post] =>
+               eq r (pre ++ [nm = v] ++ post) -> tf post -> tf ([nm = v] ++ post))
+           -> tf [] -> folder r -> tf r
+
+val foldUR : tr :: Type -> tf :: ({Unit} -> Type) -> r ::: {Unit}
+           -> (pre :: {Unit} -> nm :: Name -> post :: {Unit} -> [pre ~ post] => [[nm] ~ pre ++ post] =>
+               eq r (pre ++ [nm] ++ post) -> tr -> tf post -> tf ([nm] ++ post))
+           -> tf [] -> folder r -> $(mapU tr r) -> tf r
+
+val foldR : K --> tr :: (K -> Type) -> tf :: ({K} -> Type) -> r ::: {K}
+           -> (pre :: {K} -> nm :: Name -> t :: K -> post :: {K} -> [pre ~ post] => [[nm] ~ pre ++ post] =>
+               eq r (pre ++ [nm = t] ++ post) -> tr t -> tf post -> tf ([nm = t] ++ post))
+           -> tf [] -> folder r -> $(map tr r) -> tf r
+
+val foldR2 : K --> tr1 :: (K -> Type) -> tr2 :: (K -> Type) -> tf :: ({K} -> Type) -> r ::: {K}
+             -> (pre :: {K} -> nm :: Name -> t :: K -> post :: {K} -> [pre ~ post] => [[nm] ~ pre ++ post] =>
+                 eq r (pre ++ [nm = t] ++ post) -> tr1 t -> tr2 t -> tf post -> tf ([nm = t] ++ post))
+             -> tf [] -> folder r -> $(map tr1 r) -> $(map tr2 r) -> tf r
+
+val foldR3 : K --> tr1 :: (K -> Type) -> tr2 :: (K -> Type) -> tr3 :: (K -> Type) -> tf :: ({K} -> Type) -> r ::: {K}
+             -> (pre :: {K} -> nm :: Name -> t :: K -> post :: {K} -> [pre ~ post] => [[nm] ~ pre ++ post] =>
+                 eq r (pre ++ [nm = t] ++ post) -> tr1 t -> tr2 t -> tr3 t -> tf post -> tf ([nm = t] ++ post))
+             -> tf [] -> folder r -> $(map tr1 r) -> $(map tr2 r) -> $(map tr3 r) -> tf r
+
+val foldR4 : K --> tr1 :: (K -> Type) -> tr2 :: (K -> Type) -> tr3 :: (K -> Type) -> tr4 :: (K -> Type) -> tf :: ({K} -> Type) -> r ::: {K}
+             -> (pre :: {K} -> nm :: Name -> t :: K -> post :: {K} -> [pre ~ post] => [[nm] ~ pre ++ post] =>
+                 eq r (pre ++ [nm = t] ++ post) -> tr1 t -> tr2 t -> tr3 t -> tr4 t -> tf post -> tf ([nm = t] ++ post))
+             -> tf [] -> folder r -> $(map tr1 r) -> $(map tr2 r) -> $(map tr3 r) -> $(map tr4 r) -> tf r
+
+val mp : K --> tr :: (K -> Type) -> tf :: (K -> Type) -> r ::: {K}
+         -> (nm :: Name -> t :: K -> rest :: {K} -> [[nm] ~ rest] =>
+             eq r ([nm = t] ++ rest) -> tr t -> tf t)
+         -> folder r -> $(map tr r) -> $(map tf r)

UrWeb/meta/html.ur

@@ -0,0 +1,144 @@
+open Parse
+
+con attribute = fn t => {Nam : string,
+                         Parse : string -> option t}
+
+con tag = fn ts => {Nam : string,
+                    Attributes : $(map attribute ts),
+                    Folder : folder ts,
+                    Construct : ctx ::: {Unit} -> [[Body] ~ ctx] => $ts
+                                -> xml ([Body] ++ ctx) [] [] -> xml ([Body] ++ ctx) [] []}
+
+fun tag [use] [ignore] [use ~ ignore] (fl : folder use) (name : string) (attrs : $(map attribute use))
+        (construct : ctx ::: {Unit} -> [[Body] ~ ctx] => Basis.tag (use ++ ignore) ([Body] ++ ctx) ([Body] ++ ctx) [] []) =
+    {Nam = name,
+     Attributes = attrs,
+     Folder = fl,
+     Construct = fn [ctx] [[Body] ~ ctx] (ats : $use) (inner : xml ([Body] ++ ctx) [] []) =>
+                    Basis.tag null None noStyle None ats construct inner}
+
+fun simpleTag [ignore] name (bt : bodyTag ignore) : tag [] =
+    @@tag [[]] [ignore] ! _ name {} (fn [ctx] [[Body] ~ ctx] => bt ())
+
+fun simpleTag' [use] [ignore] [use ~ ignore] (fl : folder use)
+               name (bt : bodyTag (use ++ ignore)) (ats : $(map attribute use)) : tag use =
+    @@tag [use] [ignore] ! fl name ats (fn [ctx] [[Body] ~ ctx] => bt ())
+
+fun url name = {Nam = name,
+                Parse = checkUrl}
+
+datatype error a =
+         Good of a
+       | Bad of string
+
+fun format [tags] (fl : folder tags) (tags : $(map tag tags)) [ctx] [[Body] ~ ctx] s =
+    let
+        fun loop s : error (xml ([Body] ++ ctx) [] [] * string) =
+            case String.msplit {Haystack = s, Needle = "&<"} of
+                None => Good (cdata s, "")
+              | Some (pre, ch, post) =>
+                case ch of
+                    #"&" =>
+                    (case String.split post #";" of
+                         None => Bad "No ';' after '&'"
+                       | Some (code, post) =>
+                         let
+                             val xml = 
+                                 case code of
+                                     "lt" => <xml>&lt;</xml>
+                                   | "gt" => <xml>&gt;</xml>
+                                   | "amp" => <xml>&amp;</xml>
+                                   | _ => <xml/>
+                         in
+                             case loop post of
+                                 Good (after, post) => Good (<xml>{[pre]}{xml}{after}</xml>, post)
+                               | x => x
+                         end)
+                  | _ =>
+                    if String.length post > 0 && String.sub post 0 = #"/" then
+                        case String.split post #"\x3E" of
+                            None => Bad "No '>' after '</'"
+                          | Some (_, post) => Good (<xml>{[pre]}</xml>, post)
+                    else
+                        case String.msplit {Haystack = post, Needle = " >"} of
+                            None => Bad "No '>' after '<'"
+                          | Some (tname, ch, post) =>
+                            @foldR [tag] [fn _ => unit -> error (xml ([Body] ++ ctx) [] [] * string)]
+                            (fn [nm :: Name] [ts :: {Type}] [r :: {{Type}}] [[nm] ~ r] (meta : tag ts) acc () =>
+                                if meta.Nam = tname then
+                                    let
+                                        fun doAttrs (ch, post, ats : $(map option ts)) =
+                                            if String.length post > 0 && Char.isSpace (String.sub post 0) then
+                                                doAttrs (ch, String.substring post {Start = 1,
+                                                                                    Len = String.length post - 1},
+                                                         ats)
+                                            else 
+                                                case ch of
+                                                    #"\x3E" => Good (ats, post)
+                                                  | _ =>
+                                                    case String.split post #"=" of
+                                                        None =>
+                                                        (case String.split post #"\x3E" of
+                                                             None => Bad "No tag ender '\x3E'"
+                                                           | Some (_, post) => Good (ats, post))
+                                                      | Some (aname, post) =>
+                                                        if String.length post >= 1 && String.sub post 0 = #"\"" then
+                                                            case String.split (String.substring post
+                                                                                                {Start = 1,
+                                                                                                 Len = String.length post
+                                                                                                       - 1})
+                                                                              #"\"" of
+                                                                None => Bad "No '\"' to end attribute value"
+                                                              | Some (aval, post) =>
+                                                                let
+                                                                    val ats =
+                                                                        @map2 [attribute] [option] [option]
+                                                                         (fn [t] meta v =>
+                                                                             if aname = meta.Nam then
+                                                                                 meta.Parse aval
+                                                                             else
+                                                                                 v)
+                                                                         meta.Folder meta.Attributes ats
+                                                                in
+                                                                    doAttrs (#" ", post, ats)
+                                                                end
+                                                        else
+                                                            Bad "Attribute value doesn't begin with quote"
+                                    in
+                                        case doAttrs (ch, post, @map0 [option] (fn [t :: Type] => None)
+                                                                 meta.Folder) of
+                                            Good (ats, post) =>
+                                            let
+                                                val ats =
+                                                    @map2 [attribute] [option] [ident]
+                                                     (fn [t] meta v =>
+                                                         case v of
+                                                             None => error <xml>Missing attribute {[meta.Nam]}
+                                                               for {[tname]}</xml>
+                                                           | Some v => v)
+                                                     meta.Folder meta.Attributes ats
+                                            in
+                                                case loop post of
+                                                    Good (inner, post) =>
+                                                    (case loop post of
+                                                         Good (after, post) =>
+                                                         Good (<xml>{[pre]}{meta.Construct [ctx] !
+                                                                                           ats inner}{after}</xml>, post)
+                                                       | x => x)
+                                                  | x => x
+                                            end
+                                          | Bad s => Bad s
+                                    end
+                                else
+                                    acc ())
+                            (fn () => Bad ("Unknown HTML tag " ^ tname)) fl tags ()
+    in
+        case loop s of
+            Bad msg => Failure msg
+          | Good (xml, _) => Success xml
+    end
+
+val b = simpleTag "b" @@b
+val i = simpleTag "i" @@i
+val a = simpleTag' "a" @@a {Href = url "href"}
+

UrWeb/meta/html.urs

@@ -0,0 +1,29 @@
+(** Safe HTML parsing *)
+
+con attribute = fn t => {Nam : string,
+                         Parse : string -> option t}
+
+con tag = fn ts => {Nam : string,
+                    Attributes : $(map attribute ts),
+                    Folder : folder ts,
+                    Construct : ctx ::: {Unit} -> [[Body] ~ ctx] => $ts
+                                -> xml ([Body] ++ ctx) [] [] -> xml ([Body] ++ ctx) [] []}
+
+val tag : use ::: {Type} -> ignore ::: {Type} -> [use ~ ignore] => folder use -> string
+          -> $(map attribute use)
+          -> (ctx ::: {Unit} -> [[Body] ~ ctx] => Basis.tag (use ++ ignore) ([Body] ++ ctx) ([Body] ++ ctx) [] [])
+          -> tag use
+
+val simpleTag : ignore ::: {Type} -> string -> bodyTag ignore -> tag []
+val simpleTag' : use ::: {Type} -> ignore ::: {Type} -> [use ~ ignore] => folder use
+    -> string -> bodyTag (use ++ ignore) -> $(map attribute use) -> tag use
+
+val url : string -> attribute url
+
+val format : tags ::: {{Type}} -> folder tags -> $(map tag tags)
+             -> ctx ::: {Unit} -> [[Body] ~ ctx] => string
+             -> Parse.parse (xml ([Body] ++ ctx) [] [])
+
+val b : tag []
+val i : tag []
+val a : tag [Href = url]

UrWeb/meta/incl.ur

@@ -0,0 +1,40 @@
+con incl' = K ==> fn (r1 :: {K}) (r2 :: {K}) (r' :: {K}) =>
+                     [r1 ~ r'] => {Expose : f :: ({K} -> Type) -> f r2 -> f (r1 ++ r'),
+                                   Hide : f :: ({K} -> Type) -> f (r1 ++ r') -> f r2}
+
+con incl = K ==> fn (r1 :: {K}) (r2 :: {K}) =>
+                    tp :: Type -> (r' :: {K} -> [r1 ~ r'] => incl' r1 r2 r' -> tp) -> tp
+
+fun incl [K] [r1 :: {K}] [r2 :: {K}] [r1 ~ r2] =
+ fn [tp :: Type] (f : r' :: {K} -> [r1 ~ r'] => incl' r1 (r1 ++ r2) r' -> tp) =>
+    f [r2] (fn [r1 ~ r2] => {Expose = fn [f :: ({K} -> Type)] x => x,
+                             Hide = fn [f :: ({K} -> Type)] x => x})
+    
+fun proj [r1 ::: {Type}] [r2 ::: {Type}] (i : incl r1 r2) (r : $r2) =
+    i [$r1] (fn [r' :: {Type}] [r1 ~ r'] (i' : incl' r1 r2 r') =>
+                i'.Expose [fn r => $r] r --- r')
+
+fun inv1 [K] [nm :: Name] [t :: K] [r :: {K}] [r' :: {K}] [[nm] ~ r]
+         [f :: Name -> K -> {K} -> Type]
+         (i : incl ([nm = t] ++ r) r')
+         (f : nm :: Name -> t :: K -> r :: {K} -> [[nm] ~ r] => f nm t ([nm = t] ++ r)) =
+    i [f nm t r'] (fn [r'' :: {K}] [[nm = t] ++ r ~ r''] (i' : incl' ([nm = t] ++ r) r' r'') =>
+                      i'.Hide [f nm t] (f [nm] [t] [r ++ r'']))
+
+fun inv2 [K] [nm :: Name] [t :: K] [r :: {K}] [r' :: {K}] [[nm] ~ r]
+         (i : incl ([nm = t] ++ r) r') =
+    i [incl r r'] (fn [r'' :: {K}] [[nm = t] ++ r ~ r''] (i' : incl' ([nm = t] ++ r) r' r'') =>
+                   fn [tp :: Type] (f : r''' :: {K} -> [r ~ r'''] => incl' r r' r''' -> tp) =>
+                      f [[nm = t] ++ r''] (fn [r ~ [nm = t] ++ r''] =>
+                                              {Expose = fn [f :: ({K} -> Type)] (x : f r') => i'.Expose [f] x,
+                                               Hide = fn [f :: ({K} -> Type)] x => i'.Hide [f] x}))
+
+fun fold [K] [tf :: {K} -> Type] [r ::: {K}]
+         (f : nm :: Name -> v :: K -> r' :: {K}
+              -> [[nm] ~ r'] => incl ([nm = v] ++ r') r -> tf r' -> tf ([nm = v] ++ r'))
+         (i : tf []) (fl : folder r) =
+    @Top.fold [fn r' => incl r' r -> tf r']
+     (fn [nm :: Name] [v :: K] [r' :: {K}] [[nm] ~ r'] acc i =>
+         f [nm] [v] [r'] i (acc (inv2 [nm] [v] [r'] [r] i)))
+     (fn _ => i)
+     fl (incl [r] [[]])

UrWeb/meta/incl.urs

@@ -0,0 +1,22 @@
+(** A record inclusion predicate *)
+
+con incl :: K --> {K} -> {K} -> Type
+
+val incl : K --> r1 :: {K} -> r2 :: {K} -> [r1 ~ r2] => incl r1 (r1 ++ r2)
+val proj : r1 ::: {Type} -> r2 ::: {Type} -> incl r1 r2 -> $r2 -> $r1
+
+val inv1 : K --> nm :: Name -> t :: K -> r :: {K} -> r' :: {K}
+           -> [[nm] ~ r] =>
+    f :: (Name -> K -> {K} -> Type)
+    -> incl ([nm = t] ++ r) r'
+    -> (nm :: Name -> t :: K -> r :: {K} -> [[nm] ~ r] => f nm t ([nm = t] ++ r))
+    -> f nm t r'
+val inv2 : K --> nm :: Name -> t :: K -> r :: {K} -> r' :: {K}
+           -> [[nm] ~ r] =>
+    incl ([nm = t] ++ r) r' -> incl r r'
+
+val fold : K --> tf :: ({K} -> Type) -> r ::: {K}
+           -> (nm :: Name -> v :: K -> r' :: {K}
+               -> [[nm] ~ r'] => incl ([nm = v] ++ r') r -> tf r' -> tf ([nm = v] ++ r'))
+           -> tf []
+           -> folder r -> tf r

UrWeb/meta/json.ur

@@ -0,0 +1,339 @@
+con json a = {ToJson : a -> string,
+              FromJson : string -> a * string}
+
+fun mkJson [a] (x : {ToJson : a -> string,
+                     FromJson : string -> a * string}) = x
+
+fun skipSpaces s =
+    let
+        val len = String.length s
+
+        fun skip i =
+            if i >= len then
+                ""
+            else
+                let
+                    val ch = String.sub s i
+                in
+                    if Char.isSpace ch then
+                        skip (i+1)
+                    else
+                        String.substring s {Start = i, Len = len-i}
+                end
+    in
+        skip 0
+    end
+
+fun toJson [a] (j : json a) : a -> string = j.ToJson
+fun fromJson' [a] (j : json a) : string -> a * string = j.FromJson
+
+fun fromJson [a] (j : json a) (s : string) : a =
+    let
+        val (v, s') = j.FromJson (skipSpaces s)
+    in
+        if String.all Char.isSpace s' then
+            v
+        else
+            error <xml>Extra content at end of JSON record: {[s']}</xml>
+    end
+
+fun escape s =
+    let
+        val len = String.length s
+
+        fun esc i =
+            if i >= len then
+                "\""
+            else
+                let
+                    val ch = String.sub s i
+                in
+                    (if ch = #"\"" || ch = #"\\" then
+                         "\\" ^ String.str ch
+                     else
+                         String.str ch) ^ esc (i+1)
+                end
+    in
+        "\"" ^ esc 0
+    end
+
+fun unescape s =
+    let
+        val len = String.length s
+
+        fun findEnd i =
+            if i >= len then
+                error <xml>JSON unescape: string ends before quote: {[s]}</xml>
+            else
+                let
+                    val ch = String.sub s i
+                in
+                    case ch of
+                        #"\"" => i
+                      | #"\\" =>
+                        if i+1 >= len then
+                            error <xml>JSON unescape: Bad escape sequence: {[s]}</xml>
+                        else
+                            findEnd (i+2)
+                      | _ => findEnd (i+1)
+                end
+
+        val last = findEnd 1
+
+        fun unesc i =
+            if i >= last then
+                ""
+            else
+                let
+                    val ch = String.sub s i
+                in
+                    case ch of
+                        #"\\" =>
+                        if i+1 >= len then
+                            error <xml>JSON unescape: Bad escape sequence: {[s]}</xml>
+                        else
+                            String.str (String.sub s (i+1)) ^ unesc (i+2)
+                      | _ => String.str ch ^ unesc (i+1)
+                end
+    in
+        if len = 0 || String.sub s 0 <> #"\"" then
+            error <xml>JSON unescape: String doesn't start with double quote: {[s]}</xml>
+        else
+            (unesc 1, String.substring s {Start = last+1, Len = len-last-1})
+    end
+
+val json_string = {ToJson = escape,
+                   FromJson = unescape}
+
+fun numIn [a] (_ : read a) s : a * string =
+    let
+        val len = String.length s
+
+        fun findEnd i =
+            if i >= len then
+                i
+            else
+                let
+                    val ch = String.sub s i
+                in
+                    if Char.isDigit ch || ch = #"-" || ch = #"." || ch = #"E" || ch = #"e" then
+                        findEnd (i+1)
+                    else
+                        i
+                end
+
+        val last = findEnd 0
+    in
+        (readError (String.substring s {Start = 0, Len = last}), String.substring s {Start = last, Len = len-last})
+    end
+
+fun json_num [a] (_ : show a) (_ : read a) : json a = {ToJson = show,
+                                                       FromJson = numIn}
+
+val json_int = json_num
+val json_float = json_num
+
+val json_bool = {ToJson = fn b => if b then "true" else "false",
+                 FromJson = fn s => if String.isPrefix {Full = s, Prefix = "true"} then
+                                        (True, String.substring s {Start = 4, Len = String.length s - 4})
+                                    else if String.isPrefix {Full = s, Prefix = "false"} then
+                                        (False, String.substring s {Start = 5, Len = String.length s - 5})
+                                    else
+                                        error <xml>JSON: bad boolean string: {[s]}</xml>}
+
+fun json_option [a] (j : json a) : json (option a) =
+    {ToJson = fn v => case v of
+                          None => "null"
+                        | Some v => j.ToJson v,
+     FromJson = fn s => if String.isPrefix {Full = s, Prefix = "null"} then
+                            (None, String.substring s {Start = 4, Len = String.length s - 4})
+                        else
+                            let
+                                val (v, s') = j.FromJson s
+                            in
+                                (Some v, s')
+                            end}
+
+fun json_list [a] (j : json a) : json (list a) =
+    let
+        fun toJ' (ls : list a) : string =
+            case ls of
+                [] => ""
+              | x :: ls => "," ^ toJson j x ^ toJ' ls
+
+        fun toJ (x : list a) : string =
+            case x of
+                [] => "[]"
+              | x :: [] => "[" ^ toJson j x ^ "]"
+              | x :: ls => "[" ^ toJson j x ^ toJ' ls ^ "]"
+
+        fun fromJ (s : string) : list a * string =
+            let
+                fun fromJ' (s : string) : list a * string =
+                    if String.length s = 0 then
+                        error <xml>JSON list doesn't end with ']'</xml>
+                    else
+                        let
+                            val ch = String.sub s 0
+                        in
+                            case ch of
+                                #"]" => ([], String.substring s {Start = 1, Len = String.length s - 1})
+                              | _ =>
+                                let
+                                    val (x, s') = j.FromJson s
+                                    val s' = skipSpaces s'
+                                    val s' = if String.length s' = 0 then
+                                                 error <xml>JSON list doesn't end with ']'</xml>
+                                             else if String.sub s' 0 = #"," then
+                                                 skipSpaces (String.substring s' {Start = 1, Len = String.length s' - 1})
+                                             else
+                                                 s'
+
+                                    val (ls, s'') = fromJ' s'
+                                in
+                                    (x :: ls, s'')
+                                end
+                        end
+            in
+                if String.length s = 0 || String.sub s 0 <> #"[" then
+                    error <xml>JSON list doesn't start with '[': {[s]}</xml>
+                else
+                    fromJ' (skipSpaces (String.substring s {Start = 1, Len = String.length s - 1}))
+            end
+    in
+        {ToJson = toJ,
+         FromJson = fromJ}
+    end
+
+fun json_record [ts ::: {Type}] (fl : folder ts) (jss : $(map json ts)) (names : $(map (fn _ => string) ts)) : json $ts =
+    {ToJson = fn r => "{" ^ @foldR3 [json] [fn _ => string] [ident] [fn _ => string]
+                             (fn [nm ::_] [t ::_] [r ::_] [[nm] ~ r] (j : json t) name v acc =>
+                                 escape name ^ ":" ^ j.ToJson v ^ (case acc of
+                                                                       "" => ""
+                                                                     | _ => "," ^ acc))
+                             "" fl jss names r ^ "}",
+     FromJson = fn s =>
+                   let
+                       fun fromJ s (r : $(map option ts)) : $(map option ts) * string =
+                           if String.length s = 0 then
+                               error <xml>JSON object doesn't end in brace</xml>
+                           else if String.sub s 0 = #"}" then
+                               (r, String.substring s {Start = 1, Len = String.length s - 1})
+                           else let
+                                   val (name, s') = unescape s
+                                   val s' = skipSpaces s'
+                                   val s' = if String.length s' = 0 || String.sub s' 0 <> #":" then
+                                                error <xml>No colon after JSON object field name</xml>
+                                            else
+                                                skipSpaces (String.substring s' {Start = 1, Len = String.length s' - 1})
+
+                                   val (r, s') = @foldR2 [json] [fn _ => string] [fn ts => $(map option ts) -> $(map option ts) * string]
+                                                  (fn [nm ::_] [t ::_] [r ::_] [[nm] ~ r] (j : json t) name' acc r =>
+                                                      if name = name' then
+                                                          let
+                                                              val (v, s') = j.FromJson s'
+                                                          in
+                                                              (r -- nm ++ {nm = Some v}, s')
+                                                          end
+                                                      else
+                                                          let
+                                                              val (r', s') = acc (r -- nm)
+                                                          in
+                                                              (r' ++ {nm = r.nm}, s')
+                                                          end)
+                                                  (fn _ => error <xml>Unknown JSON object field name {[name]}</xml>)
+                                                  fl jss names r
+
+                                   val s' = skipSpaces s'
+                                   val s' = if String.length s' <> 0 && String.sub s' 0 = #"," then
+                                                skipSpaces (String.substring s' {Start = 1, Len = String.length s' - 1})
+                                            else
+                                                s'
+                               in
+                                   fromJ s' r
+                               end
+                   in
+                       if String.length s = 0 || String.sub s 0 <> #"{" then
+                           error <xml>JSON record doesn't begin with brace</xml>
+                       else
+                           let
+                               val (r, s') = fromJ (skipSpaces (String.substring s {Start = 1, Len = String.length s - 1}))
+                                                   (@map0 [option] (fn [t ::_] => None) fl)
+                           in
+                               (@map2 [option] [fn _ => string] [ident] (fn [t] (v : option t) name =>
+                                                                            case v of
+                                                                                None => error <xml>Missing JSON object field {[name]}</xml>
+                                                                              | Some v => v) fl r names, s')
+                           end
+                   end}
+
+fun json_variant [ts ::: {Type}] (fl : folder ts) (jss : $(map json ts)) (names : $(map (fn _ => string) ts)) : json (variant ts) =
+    {ToJson = fn r => let val jnames = @map2 [json] [fn _ => string] [fn x => json x * string]
+                                     (fn [t] (j : json t) (name : string) => (j, name)) fl jss names
+                      in @Variant.destrR [ident] [fn x => json x * string]
+                          (fn [p ::_] (v : p) (j : json p, name : string) =>
+                            "{" ^ escape name ^ ":" ^ j.ToJson v ^ "}") fl r jnames
+                      end,
+     FromJson = fn s =>
+                   if String.length s = 0 || String.sub s 0 <> #"{" then
+                       error <xml>JSON variant doesn't begin with brace</xml>
+                   else
+                       let
+                           val (name, s') = unescape (skipSpaces (String.suffix s 1))
+                           val s' = skipSpaces s'
+                           val s' = if String.length s' = 0 || String.sub s' 0 <> #":" then
+                                        error <xml>No colon after JSON object field name</xml>
+                                    else
+                                        skipSpaces (String.substring s' {Start = 1, Len = String.length s' - 1})
+
+                           val (r, s') = (@foldR2 [json] [fn _ => string]
+                                            [fn ts => ts' :: {Type} -> [ts ~ ts'] => variant (ts ++ ts') * string]
+                                            (fn [nm ::_] [t ::_] [rest ::_] [[nm] ~ rest] (j : json t) name'
+                                             (acc : ts' :: {Type} -> [rest ~ ts'] => variant (rest ++ ts') * string) [fwd ::_] [[nm = t] ++ rest ~ fwd] =>
+                                                if name = name'
+                                                    then
+                                                        let val (v, s') = j.FromJson s'
+                                                        in (make [nm] v, s')
+                                                        end
+                                                    else acc [fwd ++ [nm = t]]
+                                            )
+                                            (fn [fwd ::_] [[] ~ fwd] => error <xml>Unknown JSON object variant name {[name]}</xml>)
+                                            fl jss names) [[]] !
+
+                           val s' = skipSpaces s'
+                           val s' = if String.length s' <> 0 && String.sub s' 0 = #"," then
+                                        skipSpaces (String.substring s' {Start = 1, Len = String.length s' - 1})
+                                    else
+                                        s'
+                       in
+                           if String.length s' = 0 then
+                               error <xml>JSON object doesn't end in brace</xml>
+                           else if String.sub s' 0 = #"}" then
+                               (r, String.substring s' {Start = 1, Len = String.length s' - 1})
+                           else error <xml>Junk after JSON value in object</xml>
+                       end
+                   }
+
+val json_unit : json unit = json_record {} {}
+
+functor Recursive (M : sig
+                       con t :: Type -> Type
+                       val json_t : a ::: Type -> json a -> json (t a)
+                   end) = struct
+    open M
+
+    datatype r = Rec of t r
+
+    fun rTo (Rec x) = (json_t {ToJson = rTo,
+                               FromJson = fn _ => error <xml>Tried to FromJson in ToJson!</xml>}).ToJson x
+
+    fun rFrom s =
+        let
+            val (x, s') = (json_t {ToJson = fn _ => error <xml>Tried to ToJson in FromJson!</xml>,
+                                   FromJson = rFrom}).FromJson s
+        in
+            (Rec x, s')
+        end
+
+    val json_r = {ToJson = rTo, FromJson = rFrom}
+end

UrWeb/meta/json.urs

@@ -0,0 +1,31 @@
+(** The JSON text-based serialization format *)
+
+class json
+
+val toJson : a ::: Type -> json a -> a -> string
+val fromJson : a ::: Type -> json a -> string -> a
+val fromJson' : a ::: Type -> json a -> string -> a * string
+
+val mkJson : a ::: Type -> {ToJson : a -> string,
+                            FromJson : string -> a * string} -> json a
+
+val json_string : json string
+val json_int : json int
+val json_float : json float
+val json_bool : json bool
+val json_option : a ::: Type -> json a -> json (option a)
+val json_list : a ::: Type -> json a -> json (list a)
+
+val json_record : ts ::: {Type} -> folder ts -> $(map json ts) -> $(map (fn _ => string) ts) -> json $ts
+val json_variant : ts ::: {Type} -> folder ts -> $(map json ts) -> $(map (fn _ => string) ts) -> json (variant ts)
+
+val json_unit : json unit
+
+functor Recursive (M : sig
+                       con t :: Type -> Type
+                       val json_t : a ::: Type -> json a -> json (t a)
+                   end) : sig
+    datatype r = Rec of M.t r
+
+    val json_r : json r
+end

UrWeb/meta/lib.urp

@@ -0,0 +1,12 @@
+$/char
+$/string
+$/option
+incl
+mem
+eq
+record
+variant
+json
+sql
+parse
+html

UrWeb/meta/mem.ur

@@ -0,0 +1,38 @@
+con mem' = K ==> fn (nm :: Name) (t :: K) (r :: {K}) (r' :: {K}) =>
+    [[nm] ~ r'] => {Expose : f :: ({K} -> Type) -> f r -> f ([nm = t] ++ r'),
+                    Hide : f :: ({K} -> Type) -> f ([nm = t] ++ r') -> f r}
+
+con mem = K ==> fn (nm :: Name) (t :: K) (r :: {K}) =>
+                   tp :: Type -> (r' :: {K} -> [[nm] ~ r'] => mem' nm t r r' -> tp) -> tp
+
+fun mem [K] [nm :: Name] [t :: K] [r :: {K}] [[nm] ~ r] =
+    fn [tp :: Type] (f : r' :: {K} -> [[nm] ~ r'] => mem' nm t ([nm = t] ++ r) r' -> tp) =>
+       f [r] (fn [[nm] ~ r] => {Expose = fn [f :: {K} -> Type] x => x,
+                                Hide = fn [f :: {K} -> Type] x => x})
+
+fun mp [K] [K2] [f :: K -> K2] [nm ::: Name] [t ::: K] [r ::: {K}] (m : mem nm t r) =
+    m [mem nm (f t) (map f r)] (fn [r' :: {K}] [[nm] ~ r'] (m' : mem' nm t r r') =>
+                                fn [tp :: Type] (f : r' :: {K2} -> [[nm] ~ r'] =>
+                                                 mem' nm (f t) (map f r) r' -> tp) =>
+                                   f [map f r'] (fn [[nm] ~ map f r'] =>
+                                                    {Expose = fn [f' :: {K2} -> Type] x =>
+                                                                 m'.Expose [fn r => f' (map f r)] x,
+                                                     Hide = fn [f' :: {K2} -> Type] x =>
+                                                               m'.Hide [fn r => f' (map f r)] x}))
+
+fun proj [nm ::: Name] [t ::: Type] [r ::: {Type}] (m : mem nm t r) (r : $r) =
+    m [t] (fn [r' :: {Type}] [[nm] ~ r'] (m' : mem' nm t r r') =>
+              (m'.Expose [fn r => $r] r).nm)
+
+fun replace [nm ::: Name] [t ::: Type] [r ::: {Type}] (m : mem nm t r) (r : $r) (v : t) =
+    m [$r] (fn [r' :: {Type}] [[nm] ~ r'] (m' : mem' nm t r r') =>
+               m'.Hide [fn r => $r] (m'.Expose [fn r => $r] r -- nm ++ {nm = v}))
+
+fun fold [K] [tf :: ({K} -> Type)] [r ::: {K}]
+    (f : nm :: Name -> v :: K -> r' :: {K} -> [[nm] ~ r']
+     => mem nm v r -> tf r' -> tf ([nm = v] ++ r'))
+    (i : tf []) (fl : folder r) =
+    @@Incl.fold [tf] [r]
+      (fn [nm :: Name] [v :: K] [r' :: {K}] [[nm] ~ r'] (i : Incl.incl ([nm = v] ++ r') r) acc =>
+          f [nm] [v] [r'] (Incl.inv1 [nm] [v] [r'] [r] [mem] i mem) acc)
+      i fl

UrWeb/meta/mem.urs

@@ -0,0 +1,15 @@
+(** A record membership predicate *)
+
+con mem :: K --> Name -> K -> {K} -> Type
+
+val mem : K --> nm :: Name -> t :: K -> r :: {K} -> [[nm] ~ r] => mem nm t ([nm = t] ++ r)
+val mp : K --> K2 --> f :: (K -> K2) -> nm ::: Name -> t ::: K -> r ::: {K} -> mem nm t r -> mem nm (f t) (map f r)
+
+val proj : nm ::: Name -> t ::: Type -> r ::: {Type} -> mem nm t r -> $r -> t
+val replace : nm ::: Name -> t ::: Type -> r ::: {Type} -> mem nm t r -> $r -> t -> $r
+
+val fold : K --> tf :: ({K} -> Type) -> r ::: {K}
+           -> (nm :: Name -> v :: K -> r' :: {K} -> [[nm] ~ r']
+               => mem nm v r -> tf r' -> tf ([nm = v] ++ r'))
+           -> tf []
+           -> folder r -> tf r

UrWeb/meta/parse.ur

@@ -0,0 +1,5 @@
+(** Datatypes for describing parse results *)
+
+datatype parse a =
+         Success of a
+       | Failure of string

UrWeb/meta/record.ur

@@ -0,0 +1,18 @@
+fun numFields [r ::: {Type}] (fl : folder r) (r : $r) : int =
+    @fold [fn _ => int] (fn [nm ::_] [u ::_] [r ::_] [[nm] ~ r] acc => acc+1) 0 fl
+
+fun mem [a ::: Type] [ns ::: {Unit}] (_ : eq a) (fl : folder ns) (x : a) (r : $(mapU a ns)) : bool =
+    @foldUR [a] [fn _ => bool]
+     (fn [nm ::_] [r ::_] [[nm] ~ r] y acc =>
+         acc || x = y)
+     False fl r
+
+fun equal [ts ::: {Type}] (eqs : $(map eq ts)) (fl : folder ts) (r1 : $ts) (r2 : $ts) : bool =
+    @foldR3 [eq] [ident] [ident] [fn _ => bool]
+     (fn [nm ::_] [t ::_] [r ::_] [[nm] ~ r] isEq x y acc =>
+         acc && @eq isEq x y)
+     True fl eqs r1 r2
+
+fun ap [K] [tf1 :: K -> Type] [tf2 :: K -> Type]
+       [r ::: {K}] (fl : folder r) (fs : $(map (fn t => tf1 t -> tf2 t) r)) (xs : $(map tf1 r))
+  = @map2 [fn t => tf1 t -> tf2 t] [fn t => tf1 t] [tf2] (fn [t] f x => f x) fl fs xs

UrWeb/meta/record.urs

@@ -0,0 +1,14 @@
+val numFields : r ::: {Type} -> folder r -> $r -> int
+
+val mem : a ::: Type -> ns ::: {Unit} -> eq a -> folder ns -> a -> $(mapU a ns) -> bool
+(* Is a value found in a record? *)
+
+val equal : ts ::: {Type} -> $(map eq ts) -> folder ts -> $ts -> $ts -> bool
+(* Are two records equal? *)
+
+(* Analogous to applicative ap e.g. <*>, of type [f (a -> b) -> f a -> f b] *)
+val ap : K --> tf1 :: (K -> Type) -> tf2 :: (K -> Type)
+         -> r ::: {K} -> folder r
+         -> $(map (fn t => tf1 t -> tf2 t) r)
+         -> $(map tf1 r)
+         -> $(map tf2 r)

UrWeb/meta/sql.ur

@@ -0,0 +1,75 @@
+fun sqexps [env] [fields] (fl : folder fields) (inj : $(map sql_injectable fields)) (r : $fields) =
+    @map2 [sql_injectable] [ident] [sql_exp env [] []]
+     (fn [t] => @sql_inject)
+     fl inj r
+
+fun selector [tn :: Name] [fs] [ofs] [fs ~ ofs] (fl : folder fs) (m : $(map sql_injectable fs)) (r : $fs)
+    : sql_exp [tn = ofs ++ fs] [] [] bool =
+    @foldR2 [sql_injectable] [ident]
+     [fn key => rest :: {Type} -> [rest ~ key] => sql_exp [tn = key ++ rest] [] [] bool]
+     (fn [nm :: Name] [t :: Type] [key :: {Type}] [[nm] ~ key]
+                      (inj : sql_injectable t) (v : t)
+                      (exp : rest :: {Type} -> [rest ~ key] => sql_exp [tn = key ++ rest] [] [] bool)
+                      [rest :: {Type}] [rest ~ [nm = t] ++ key] =>
+         (WHERE {{tn}}.{nm} = {@sql_inject inj v} AND {exp [[nm = t] ++ rest]}))
+     (fn [rest :: {Type}] [rest ~ []] => (WHERE TRUE))
+     fl m r [_] !
+
+fun joiner [tn1 :: Name] [tn2 :: Name] [fs] [ofs1] [ofs2] [[tn1] ~ [tn2]] [fs ~ ofs1] [fs ~ ofs2]
+           (fl : folder fs) : sql_exp [tn1 = ofs1 ++ fs, tn2 = ofs2 ++ fs] [] [] bool =
+    @fold
+     [fn key => rest1 :: {Type} -> rest2 :: {Type} -> [rest1 ~ key] => [rest2 ~ key] => sql_exp [tn1 = key ++ rest1, tn2 = key ++ rest2] [] [] bool]
+     (fn [nm :: Name] [t :: Type] [key :: {Type}] [[nm] ~ key]
+                      (exp : rest1 :: {Type} -> rest2 :: {Type} -> [rest1 ~ key] => [rest2 ~ key]
+                       => sql_exp [tn1 = key ++ rest1, tn2 = key ++ rest2] [] [] bool)
+                      [rest1 :: {Type}] [rest2 :: {Type}] [rest1 ~ [nm = t] ++ key] [rest2 ~ [nm = t] ++ key] =>
+         (WHERE {{tn1}}.{nm} = {{tn2}}.{nm} AND {exp [[nm = t] ++ rest1] [[nm = t] ++ rest2]}))
+     (fn [rest1 :: {Type}] [rest2 :: {Type}] [rest1 ~ []] [rest2 ~ []] => (WHERE TRUE))
+     fl [_] [_] ! !
+
+fun insertIfMissing [keyCols ::: {Type}] [otherCols ::: {Type}] [otherKeys ::: {{Unit}}]
+                    [keyCols ~ otherCols] [[Pkey] ~ otherKeys]
+                    (kfl : folder keyCols) (kinj : $(map sql_injectable keyCols))
+                    (ofl : folder otherCols) (oinj : $(map sql_injectable otherCols))
+                    (t : sql_table (keyCols ++ otherCols) ([Pkey = map (fn _ => ()) keyCols] ++ otherKeys))
+                    (vs : $(keyCols ++ otherCols))
+    : transaction bool =
+    alreadyThere <- oneRowE1 (SELECT COUNT( * ) > 0
+                              FROM t
+                              WHERE {@selector [#T] ! kfl kinj (vs --- _)});
+    if alreadyThere then
+        return False
+    else
+        dml (insert t (@sqexps kfl kinj (vs --- _)
+                        ++ @sqexps ofl oinj (vs --- _)));
+        return True
+
+fun deleteByKey [keyCols ::: {Type}] [otherCols ::: {Type}] [otherKeys ::: {{Unit}}]
+    [keyCols ~ otherCols] [[Pkey] ~ otherKeys]
+    (kfl : folder keyCols) (kinj : $(map sql_injectable keyCols))
+    (t : sql_table (keyCols ++ otherCols) ([Pkey = map (fn _ => ()) keyCols] ++ otherKeys))
+    (vs : $keyCols) =
+    dml (delete t (@selector [#T] ! kfl kinj vs))
+
+fun lookup [keyCols ::: {Type}] [otherCols ::: {Type}] [otherKeys ::: {{Unit}}]
+           [keyCols ~ otherCols] [[Pkey] ~ otherKeys]
+           (kfl : folder keyCols) (kinj : $(map sql_injectable keyCols))
+           (t : sql_table (keyCols ++ otherCols) ([Pkey = map (fn _ => ()) keyCols] ++ otherKeys))
+           (vs : $keyCols)
+    : transaction (option $otherCols) =
+      oneOrNoRows1 (SELECT t.{{otherCols}}
+                    FROM t
+                    WHERE {@selector [#T] ! kfl kinj (vs --- _)})
+
+fun listify [lead :: Name] [cols ::: {Type}] [rest ::: {{Type}}] [[lead] ~ rest]
+    (fl : folder cols) (eqs : $(map eq cols)) (q : sql_query [] [] ([lead = cols] ++ rest) []) =
+    query q
+    (fn r acc =>
+        return (case acc of
+                    [] => (r.lead, (r -- lead) :: []) :: []
+                  | (key, ls) :: acc' =>
+                    if @Record.equal eqs fl r.lead key then
+                        (key, (r -- lead) :: ls) :: acc'
+                    else
+                        (r.lead, (r -- lead) :: []) :: acc))
+    []

UrWeb/meta/sql.urs

@@ -0,0 +1,47 @@
+(** Common metaprogramming patterns for SQL syntax construction *)
+
+val sqexps : env ::: {{Type}} -> fields ::: {Type} -> folder fields -> $(map sql_injectable fields)
+             -> $fields -> $(map (sql_exp env [] []) fields)
+(* Convert a record of Ur values into a record of SQL expressions *)
+
+val selector : tn :: Name -> fs ::: {Type} -> ofs ::: {Type} -> [fs ~ ofs]
+               => folder fs -> $(map sql_injectable fs) -> $fs
+               -> sql_exp [tn = ofs ++ fs] [] [] bool
+(* Build a boolean SQL expression expressing equality of some fields of a table
+ * row with a record of Ur values *)
+
+val joiner : tn1 :: Name -> tn2 :: Name -> fs ::: {Type} -> ofs1 ::: {Type} -> ofs2 ::: {Type}
+             -> [[tn1] ~ [tn2]] => [fs ~ ofs1] => [fs ~ ofs2]
+               => folder fs
+               -> sql_exp [tn1 = ofs1 ++ fs, tn2 = ofs2 ++ fs] [] [] bool
+(* Declare equality of same-named columns from two tables. *)
+
+val insertIfMissing : keyCols ::: {Type} -> otherCols ::: {Type} -> otherKeys ::: {{Unit}}
+                      -> [keyCols ~ otherCols] => [[Pkey] ~ otherKeys]
+                      => folder keyCols -> $(map sql_injectable keyCols)
+                      -> folder otherCols -> $(map sql_injectable otherCols)
+                      -> sql_table (keyCols ++ otherCols) ([Pkey = map (fn _ => ()) keyCols] ++ otherKeys)
+                      -> $(keyCols ++ otherCols)
+                      -> transaction bool
+(* Insert a row into an SQL table if its key isn't already present, returning [False] iff the key was already present *)
+
+val deleteByKey : keyCols ::: {Type} -> otherCols ::: {Type} -> otherKeys ::: {{Unit}}
+                  -> [keyCols ~ otherCols] => [[Pkey] ~ otherKeys]
+                  => folder keyCols -> $(map sql_injectable keyCols)
+                  -> sql_table (keyCols ++ otherCols) ([Pkey = map (fn _ => ()) keyCols] ++ otherKeys)
+                  -> $keyCols
+                  -> transaction {}
+(* Delete a row from a table by matching its primary key against a given record. *)
+
+val lookup : keyCols ::: {Type} -> otherCols ::: {Type} -> otherKeys ::: {{Unit}}
+             -> [keyCols ~ otherCols] => [[Pkey] ~ otherKeys]
+             => folder keyCols -> $(map sql_injectable keyCols)
+             -> sql_table (keyCols ++ otherCols) ([Pkey = map (fn _ => ()) keyCols] ++ otherKeys)
+             -> $keyCols -> transaction (option $otherCols)
+(* Get the further columns associated with a table key. *)
+
+val listify : lead :: Name -> cols ::: {Type} -> rest ::: {{Type}} -> [[lead] ~ rest]
+              => folder cols -> $(map eq cols)
+              -> sql_query [] [] ([lead = cols] ++ rest) []
+              -> transaction (list ($cols * list $(map (fn ts => $ts) rest)))
+(* Shrink a set of table rows by summarizing into lists, keyed off of a lead table *)

UrWeb/meta/variant.ur

@@ -0,0 +1,145 @@
+fun read [r ::: {Unit}] [t ::: Type] (fl : folder r) (r : $(mapU t r)) (v : variant (mapU {} r)) : t =
+    match v
+    (@fold [fn r => r' :: {Unit} -> [r ~ r'] => $(mapU t (r ++ r')) -> $(mapU ({} -> t) r)]
+     (fn [nm :: Name] [u::_] [us::_] [[nm] ~ us] (cs : r' :: {Unit} -> [us ~ r'] => $(mapU t (us ++ r')) -> _) [r'::_] [[nm = u] ++ us ~ r'] r =>
+         {nm = fn () => r.nm} ++ cs [[nm = u] ++ r'] r)
+     (fn [r'::_] [[] ~ r'] _ => {}) fl [[]] ! r)
+
+fun write [r ::: {Unit}] [t ::: Type] (fl : folder r) (r : $(mapU t r)) (v : variant (mapU {} r)) (x : t) : $(mapU t r) =
+    match v
+    (@fold [fn r => r' :: {Unit} -> [r ~ r'] => $(mapU t (r ++ r')) -> $(mapU ({} -> $(mapU t (r ++ r'))) r)]
+      (fn [nm :: Name] [u::_] [us::_] [[nm] ~ us]
+          (cs : r' :: {Unit} -> [us ~ r'] => $(mapU t (us ++ r')) -> $(mapU ({} -> $(mapU t (us ++ r'))) us))
+          [r'::_] [[nm = u] ++ us ~ r'] r =>
+          {nm = fn () => r -- nm ++ {nm = x}} ++ cs [[nm = u] ++ r'] r)
+      (fn [r'::_] [[] ~ r'] _ => {}) fl [[]] ! r)
+
+fun search [r] [t] (f : variant (mapU {} r) -> option t) (fl : folder r) : option t =
+    @fold [fn r => r' :: {Unit} -> [r ~ r'] => (variant (mapU {} (r ++ r')) -> option t) -> option t]
+    (fn [nm :: Name] [u ::_] [r ::_] [[nm] ~ r]
+                     (acc : r' :: {Unit} -> [r ~ r'] => (variant (mapU {} (r ++ r')) -> option t) -> option t)
+                     [r' ::_] [[nm] ++ r ~ r'] f' =>
+        case f' (make [nm] {}) of
+            None => acc [[nm] ++ r'] f'
+          | v => v)
+    (fn [r' ::_] [[] ~ r'] _ => None) fl [[]] ! f
+
+fun find [r] (f : variant (mapU {} r) -> bool) (fl : folder r) : option (variant (mapU {} r)) =
+    @search (fn v => if f v then Some v else None) fl
+
+fun test [nm :: Name] [t ::: Type] [ts ::: {Type}] [[nm] ~ ts] (fl : folder ([nm = t] ++ ts))
+          (v : variant ([nm = t] ++ ts)) : option t =
+    match v ({nm = Some}
+                 ++ (@map0 [fn t' => t' -> option t] (fn [t' :: Type] _ => None) fl -- nm))
+
+fun testLess [nm :: Name] [t ::: Type] [ts ::: {Type}] [[nm] ~ ts] (fl : folder ts) (v : variant ([nm = t] ++ ts)) : option t =
+    match v ({nm = Some}
+                 ++ @map0 [fn t' => t' -> option t] (fn [t' :: Type] _ => None) fl)
+
+fun weaken [r1 ::: {Type}] [r2 ::: {Type}] [r1 ~ r2] (fl : folder r1) (v : variant r1) : variant (r1 ++ r2) =
+    match v
+    (@fold [fn r => r' :: {Type} -> [r ~ r'] => $(map (fn t => t -> variant (r ++ r')) r)]
+      (fn [nm :: Name] [t ::_] [r ::_] [[nm] ~ r] (acc : r' :: {Type} -> [r ~ r'] => $(map (fn t => t -> variant (r ++ r')) r)) [r'::_] [[nm = t] ++ r ~ r'] =>
+          {nm = make [nm]} ++ acc [[nm = t] ++ r'])
+      (fn [r'::_] [[] ~ r'] => {}) fl [r2] !)
+
+fun eq [r] (fl : folder r) (v1 : variant (mapU {} r)) (v2 : variant (mapU {} r)) : bool =
+    match v1
+    (@fold [fn r => r' :: {Unit} -> [r ~ r'] => folder (r ++ r') -> variant (mapU {} (r ++ r')) -> $(mapU ({} -> bool) r)]
+     (fn [nm ::_] [u ::_] [r ::_] [[nm] ~ r]
+         (acc : r' :: {Unit} -> [r ~ r'] => folder (r ++ r') -> variant (mapU {} (r ++ r')) -> $(mapU ({} -> bool) r))
+         [r' ::_] [[nm] ++ r ~ r'] (fl' : folder ([nm] ++ r ++ r')) v =>
+         {nm = fn () => Option.isSome (@test [nm] ! (@Folder.mp fl') v)}
+             ++ @acc [[nm] ++ r'] ! fl' v)
+     (fn [r' ::_] [[] ~ r'] _ _ => {}) fl [[]] ! fl v2)
+
+fun fold [r] [t] (fl : folder r) (f : variant (mapU {} r) -> t -> t) : t -> t =
+    @Top.fold [fn r => r' :: {Unit} -> [r ~ r'] => (variant (mapU {} (r ++ r')) -> t -> t) -> t -> t]
+    (fn [nm :: Name] [u ::_] [r ::_] [[nm] ~ r]
+                     (acc : r' :: {Unit} -> [r ~ r'] => (variant (mapU {} (r ++ r')) -> t -> t) -> t -> t)
+                     [r' ::_] [[nm] ++ r ~ r'] f' acc' =>
+        f' (make [nm] {}) (acc [[nm] ++ r'] f' acc'))
+    (fn [r' ::_] [[] ~ r'] _ x => x) fl [[]] ! f
+
+fun mp [r ::: {Unit}] [t ::: Type] (fl : folder r) (f : variant (mapU {} r) -> t) : $(mapU t r) =
+    @Top.fold [fn r => r' :: {Unit} -> [r ~ r'] => (variant (mapU {} (r ++ r')) -> t) -> $(mapU t r)]
+    (fn [nm :: Name] [u ::_] [r ::_] [[nm] ~ r]
+                     (acc : r' :: {Unit} -> [r ~ r'] => (variant (mapU {} (r ++ r')) -> t) -> $(mapU t r))
+                     [r' ::_] [[nm] ++ r ~ r'] f' =>
+        {nm = f' (make [nm] {})} ++ acc [[nm] ++ r'] f')
+    (fn [r' ::_] [[] ~ r'] _ => {}) fl [[]] ! f
+
+fun foldR [tr] [r] [t] (fl : folder r) (f : variant (mapU {} r) -> tr -> t -> t) (record : $(mapU tr r)) : t -> t =
+    @Top.foldUR [tr] [fn r => r' :: {Unit} -> [r ~ r'] => (variant (mapU {} (r ++ r')) -> tr -> t -> t) -> t -> t]
+    (fn [nm :: Name] [r ::_] [[nm] ~ r] (v : tr)
+                     (acc : r' :: {Unit} -> [r ~ r'] => (variant (mapU {} (r ++ r')) -> tr -> t -> t) -> t -> t)
+                     [r' ::_] [[nm] ++ r ~ r'] f' acc' =>
+        f' (make [nm] {}) v (acc [[nm] ++ r'] f' acc'))
+    (fn [r' ::_] [[] ~ r'] _ x => x) fl record [[]] ! f
+
+fun appR [m] (_ : monad m) [tr] [r] (fl : folder r) (f : variant (mapU {} r) -> tr -> m {}) (record : $(mapU tr r)) : m {} =
+    @foldR fl (fn var this acc => f var this; acc) record (return ())
+
+fun mapR [tr] [t] [r] (fl : folder r) (f : variant (mapU {} r) -> tr -> t) (record : $(mapU tr r)) : $(mapU t r) =
+    @Top.fold [fn r => r' :: {Unit} -> [r ~ r'] => (variant (mapU {} (r ++ r')) -> tr -> t) -> $(mapU tr r) -> $(mapU t r)]
+    (fn [nm :: Name] [u ::_] [r ::_] [[nm] ~ r]
+                     (acc : r' :: {Unit} -> [r ~ r'] => (variant (mapU {} (r ++ r')) -> tr -> t) -> $(mapU tr r) -> $(mapU t r))
+                     [r' ::_] [[nm] ++ r ~ r'] f' vs =>
+        {nm = f' (make [nm] {}) vs.nm} ++ acc [[nm] ++ r'] f' (vs -- nm))
+    (fn [r' ::_] [[] ~ r'] _ _ => {}) fl [[]] ! f record
+
+fun destrR [K] [f :: K -> Type] [fr :: K -> Type] [t ::: Type]
+    (f : p :: K -> f p -> fr p -> t)
+    [r ::: {K}] (fl : folder r) (v : variant (map f r)) (r : $(map fr r)) : t =
+    match v
+    (@Top.mp [fr] [fn p => f p -> t]
+     (fn [p] (m : fr p) (v : f p) => f [p] v m)
+     fl r)
+
+fun destr2R [K] [f1 :: K -> Type] [f2 :: K -> Type] [fr :: K -> Type] [t ::: Type]
+    (f : p :: K -> f1 p -> f2 p -> fr p -> t)
+    [r ::: {K}] (fl : folder r) (v1 : variant (map f1 r)) (v2 : variant (map f2 r)) (r : $(map fr r)) : option t =
+    match v1
+    (@Top.foldR [fr] [fn r => others :: {K} -> [others ~ r] =>
+                     folder (r ++ others)
+                     -> variant (map f2 (r ++ others))
+                     -> $(map (fn p => f1 p -> option t) r)]
+     (fn [nm ::_] [p ::_] [r ::_] [[nm] ~ r] (meta : fr p)
+         (acc : others :: {K} -> [others ~ r] =>
+          folder (r ++ others)
+          -> variant (map f2 (r ++ others))
+          -> $(map (fn p => f1 p -> option t) r))
+         [others :: {K}] [others ~ [nm = p] ++ r]
+         (fl : folder ([nm = p] ++ r ++ others))
+         (v2 : variant (map f2 ([nm = p] ++ r ++ others))) =>
+         {nm = fn x1 => match v2
+                        ({nm = fn x2 => Some (f [p] x1 x2 meta)}
+                             ++ (@map0 [fn p => f2 p -> option t] (fn [p' ::_] _ => None) fl -- nm))}
+             ++ @acc [[nm = p] ++ others] ! fl v2)
+     (fn [others ::_] [others ~ []] _ _ => {})
+     fl r [[]] ! fl v2)
+
+fun testEq [K] [f :: K -> Type] [nm :: Name] [t ::: K] [ts ::: {K}] [r ::: {K}] [[nm] ~ ts]
+    (pf : Eq.eq r ([nm = t] ++ ts)) (fl : folder r) (v : variant (map f r)) : option (f t) =
+  @test [nm] ! (@Folder.mp (@Eq.cast pf [folder] fl))
+   (Eq.cast pf [fn r => variant (map f r)] v)
+
+fun makeEq [K] [f :: K -> Type] [nm :: Name] [t ::: K] [ts ::: {K}] [r ::: {K}] [[nm] ~ ts]
+    (pf : Eq.eq r ([nm = t] ++ ts)) (x : f t) : variant (map f r) =
+  Eq.cast (Eq.sym pf) [fn r => variant (map f r)] (make [nm] x)
+
+con variantMake ts' ts = $(map (fn t => t -> variant ts') ts)
+con mkLabelsAccum r = s :: {Type} -> [r ~ s] => variantMake (r ++ s) r
+fun mkLabels [ts ::: {Type}] (fl : folder ts) : variantMake ts ts
+  = @Top.fold [mkLabelsAccum]
+          (fn [nm::_] [v::_] [r::_] [[nm] ~ r]
+              (k : mkLabelsAccum r)
+              [s::_] [[nm = v] ++ r ~ s] => k [[nm = v] ++ s] ++ {nm = make [nm]})
+          (fn [s::_] [[] ~ s] => {}) fl [[]] !
+
+con type_case ts t a = (a -> variant ts) -> a -> t
+
+fun declareCase [ts] [t] [a] (f : (a -> variant ts) -> a -> t) : type_case ts t a = f
+fun typeCase [ts] [t] (v : variant ts) (dstrs : $(map (type_case ts t) ts)) (fl : folder ts) : t
+(* Ur/Web not clever enough to calculate these folders, it seems *)
+  = match v (@Record.ap [fn a => a -> variant ts] [fn a => a -> t] fl dstrs (@mkLabels fl))

UrWeb/meta/variant.urs

@@ -0,0 +1,83 @@
+(** Derived functions dealing with polymorphic variants *)
+
+val read : r ::: {Unit} -> t ::: Type -> folder r -> $(mapU t r) -> variant (mapU {} r) -> t
+val write : r ::: {Unit} -> t ::: Type -> folder r -> $(mapU t r) -> variant (mapU {} r) -> t -> $(mapU t r)
+
+val search : r ::: {Unit} -> t ::: Type -> (variant (mapU {} r) -> option t) -> folder r -> option t
+val find : r ::: {Unit} -> (variant (mapU {} r) -> bool) -> folder r -> option (variant (mapU {} r))
+
+val test : nm :: Name -> t ::: Type -> ts ::: {Type} -> [[nm] ~ ts] => folder ([nm = t] ++ ts)
+                                                                    -> variant ([nm = t] ++ ts) -> option t
+val testLess : nm :: Name -> t ::: Type -> ts ::: {Type} -> [[nm] ~ ts] => folder ts -> variant ([nm = t] ++ ts) -> option t
+
+val weaken : r1 ::: {Type} -> r2 ::: {Type} -> [r1 ~ r2] => folder r1
+             -> variant r1 -> variant (r1 ++ r2)
+
+val testEq : K --> f :: (K -> Type) -> nm :: Name -> t ::: K -> ts ::: {K} -> r ::: {K} -> [[nm] ~ ts] =>
+    Eq.eq r ([nm = t] ++ ts)
+    -> folder r
+    -> variant (map f r) -> option (f t)
+
+val eq : r ::: {Unit} -> folder r -> variant (mapU {} r) -> variant (mapU {} r) -> bool
+
+val makeEq : K --> f :: (K -> Type) -> nm :: Name -> t ::: K -> ts ::: {K} -> r ::: {K} -> [[nm] ~ ts] =>
+    Eq.eq r ([nm = t] ++ ts)
+    -> f t
+    -> variant (map f r)
+
+val mp : r ::: {Unit} -> t ::: Type -> folder r -> (variant (mapU {} r) -> t) -> $(mapU t r)
+
+val fold : r ::: {Unit} -> t ::: Type -> folder r -> (variant (mapU {} r) -> t -> t) -> t -> t
+
+val foldR : tr ::: Type -> r ::: {Unit} -> t ::: Type -> folder r -> (variant (mapU {} r) -> tr -> t -> t) -> $(mapU tr r) -> t -> t
+
+val appR : m ::: (Type -> Type) -> monad m
+           -> tr ::: Type -> r ::: {Unit} -> folder r -> (variant (mapU {} r) -> tr -> m {}) -> $(mapU tr r) -> m {}
+
+val mapR : tr ::: Type -> t ::: Type -> r ::: {Unit} -> folder r -> (variant (mapU {} r) -> tr -> t) -> $(mapU tr r) -> $(mapU t r)
+
+val destrR : K --> f :: (K -> Type) -> fr :: (K -> Type) -> t ::: Type
+             -> (p :: K -> f p -> fr p -> t)
+             -> r ::: {K} -> folder r -> variant (map f r) -> $(map fr r) -> t
+
+val destr2R : K --> f1 :: (K -> Type) -> f2 :: (K -> Type) -> fr :: (K -> Type) -> t ::: Type
+             -> (p :: K -> f1 p -> f2 p -> fr p -> t)
+             -> r ::: {K} -> folder r -> variant (map f1 r) -> variant (map f2 r) -> $(map fr r) -> option t
+
+(* Metaprogrammed type-directed case-match.
+
+This uses a combination of type classes and metaprogramming to make
+it easy to write case-matches on very large variants with many
+similar elements.  Here's how you use it:
+
+    1. For every type in the variant, write a local typeclass function
+       which reduces it to t, and register as such using the 'declareCase'
+       function in the module you created.
+
+            let val empty = declareCase (fn _ (_ : int) => True)
+
+       These functions also take an initial argument, which has
+       type [a -> variant ts]; e.g. you can use this to create
+       a new copy of the variant with different values!
+       Make sure you specify type signatures on the argument [t]
+       so that we can identify who this typeclass is for.  (If you
+       use type classes to construct the return value, you may
+       also need to declare the return type explicitly.)
+
+    2. Do the match using 'typeCase':
+
+            typeCase t
+
+       If you need to override specific constructors, use this idiom:
+
+            @typeCase t (_ ++ {
+                YourConstr = declareCase (fn _ _ => ...)
+            }) _
+
+How does it work?  Very simple: it uses local typeclasses + Ur/Web's
+support for automatically instantiating records of typeclasses.
+*)
+
+class type_case :: {Type} -> Type -> Type -> Type
+val declareCase : ts ::: {Type} -> t ::: Type -> a ::: Type -> ((a -> variant ts) -> a -> t) -> type_case ts t a
+val typeCase : ts ::: {Type} -> t ::: Type -> variant ts -> $(map (type_case ts t) ts) -> folder ts -> t

UrWeb/setup.py

@@ -0,0 +1,27 @@
+import subprocess
+import os
+
+def start(args, logfile, errfile):
+  subprocess.check_call("urweb bench", shell=True, cwd="UrWeb", stderr=errfile, stdout=logfile)
+
+  threads = str(args.max_threads)
+  conn_string = ('dbname=hello_world '
+                'user=benchmarkdbuser '
+                'password=benchmarkdbpass '
+                'host=' + args.database_host)
+  env = {'URWEB_PQ_CON': conn_string}
+  subprocess.Popen("./bench.exe -t " + threads,
+                   env=env, shell=True, cwd="UrWeb", stderr=errfile, stdout=logfile)
+  return 0
+
+def stop(logfile, errfile):
+  p = subprocess.Popen(['ps', 'aux'], stdout=subprocess.PIPE)
+  out, err = p.communicate()
+  for line in out.splitlines():
+    if 'bench.exe' in line:
+      try:
+        pid = int(line.split(None, 2)[1])
+        os.kill(pid, 9)
+      except OSError:
+        pass
+  return 0

UrWeb/source_code

@@ -0,0 +1 @@
+./UrWeb/bench.ur

UrWeb/world.sql

@@ -0,0 +1,3 @@
+CREATE TABLE uw_Bench_world AS SELECT uw_id::int8, trunc(random()*9999+1)::int8 AS uw_randomnumber FROM generate_series(1,10000) AS uw_id;
+ALTER TABLE uw_Bench_world ADD PRIMARY KEY (uw_id);
+ALTER TABLE uw_Bench_world ALTER COLUMN uw_randomnumber SET NOT NULL;

beego/src/hello/hello.go

@@ -2,7 +2,7 @@ package main
 
 import (
 	"github.com/astaxie/beego"
-	"runtime"
+	//"runtime"
 )
 
 type MessageStruct struct {

benchmark.cfg.example

@@ -0,0 +1,31 @@
+[Defaults]
+# Available Keys: 
+# client_host='localhost'
+# client_identity_file=None
+# client_user=None
+# database_host=None
+# database_identity_file=None
+# database_os='linux'
+# database_user=None
+# duration=60
+# exclude=None
+# install='all'
+# install_error_action='continue'
+# install_software=False
+# list_test_metadata=False
+# list_tests=False
+# max_concurrency=256
+# max_queries=20
+# max_threads=8
+# mode='benchmark'
+# name='ec2'
+# os='linux'
+# parse=None
+# password_prompt=False
+# query_interval=5
+# server_host='localhost'
+# sleep=60
+# starting_concurrency=8
+# test=None
+# type='all'
+# verbose=True

config/benchmark_profile

@@ -1,6 +1,6 @@
 export JAVA_HOME=/usr/lib/jvm/java-1.7.0-openjdk-amd64
 export RESIN_HOME=~/FrameworkBenchmarks/installs/resin-4.0.36
-export GRAILS_HOME=~/FrameworkBenchmarks/installs/grails-2.3.1
+export GRAILS_HOME=~/FrameworkBenchmarks/installs/grails-2.3.3
 export VERTX_HOME=~/FrameworkBenchmarks/installs/vert.x-2.0.2-final
 export GOROOT=~/FrameworkBenchmarks/installs/go
 export GOPATH=~/FrameworkBenchmarks/go:~/FrameworkBenchmarks/webgo:~/FrameworkBenchmarks/revel

config/create-postgres-urweb.sql

@@ -0,0 +1,28 @@
+DROP TABLE IF EXISTS uw_Bench_world;
+
+CREATE TABLE uw_Bench_world AS
+SELECT uw_id::int8, trunc(random()*9999+1)::int8 AS uw_randomnumber
+FROM generate_series(1,10000) AS uw_id;
+
+ALTER TABLE uw_Bench_world ADD PRIMARY KEY (uw_id);
+ALTER TABLE uw_Bench_world ALTER COLUMN uw_randomnumber SET NOT NULL;
+
+DROP TABLE IF EXISTS uw_Bench_fortune;
+CREATE TABLE uw_Bench_fortune (
+  uw_id int8 NOT NULL,
+  uw_message text NOT NULL,
+  PRIMARY KEY (uw_id)
+);
+
+INSERT INTO uw_Bench_fortune (uw_id, uw_message) VALUES (11, '<script>alert("This should not be displayed in a browser alert box.")</script>');
+INSERT INTO uw_Bench_fortune (uw_id, uw_message) VALUES (4, 'A bad random number generator: 1, 1, 1, 1, 1, 4.33e+67, 1, 1, 1');
+INSERT INTO uw_Bench_fortune (uw_id, uw_message) VALUES (5, 'A computer program does what you tell it to do, not what you want it to do.');
+INSERT INTO uw_Bench_fortune (uw_id, uw_message) VALUES (2, 'A computer scientist is someone who fixes things that aren''t broken.');
+INSERT INTO uw_Bench_fortune (uw_id, uw_message) VALUES (8, 'A list is only as strong as its weakest link. — Donald Knuth');
+INSERT INTO uw_Bench_fortune (uw_id, uw_message) VALUES (3, 'After enough decimal places, nobody gives a damn.');
+INSERT INTO uw_Bench_fortune (uw_id, uw_message) VALUES (7, 'Any program that runs right is obsolete.');
+INSERT INTO uw_Bench_fortune (uw_id, uw_message) VALUES (10, 'Computers make very fast, very accurate mistakes.');
+INSERT INTO uw_Bench_fortune (uw_id, uw_message) VALUES (6, 'Emacs is a nice operating system, but I prefer UNIX. — Tom Christaensen');
+INSERT INTO uw_Bench_fortune (uw_id, uw_message) VALUES (9, 'Feature: A bug with seniority.');
+INSERT INTO uw_Bench_fortune (uw_id, uw_message) VALUES (1, 'fortune: No such file or directory');
+INSERT INTO uw_Bench_fortune (uw_id, uw_message) VALUES (12, 'フレームワークのベンチマーク');

evhttp-sharp/.gitignore

@@ -0,0 +1,8 @@
+*.user
+*.suo
+*/bin/*
+*/obj/*
+obj/
+[Bb]in
+[Dd]ebug*/
+[Rr]elease*/

evhttp-sharp/benchmark_config

@@ -0,0 +1,24 @@
+{
+  "framework": "evhttp-sharp",
+  "tests": [{
+    "default": {
+      "setup_file": "setup",
+      "json_url": "/",
+      "plaintext_url": "/plaintext",
+      "port": 8085,
+      "approach": "Realistic",
+      "classification": "Micro",
+      "database": "None",
+      "framework": "evhttp-sharp",
+      "language": "C#",
+      "orm": "Raw",
+      "platform": "Mono",
+      "webserver": "none",
+      "os": "Linux",
+      "database_os": "Linux",
+      "display_name": "evhttp-sharp",
+      "notes": "",
+      "versus": ""
+    }
+  }]
+}

evhttp-sharp/setup.py

@@ -0,0 +1,28 @@
+import subprocess
+import sys
+import setup_util
+import os
+
+root = os.getcwd() + "/evhttp-sharp"
+app = root + "/src"
+
+def start(args, logfile, errfile):
+  if os.name == 'nt':
+    return 1
+
+  try:
+    # build
+    subprocess.check_call("rm -rf bin obj", shell=True, cwd=app, stdout=logfile, stderr=errfile)
+    subprocess.check_call("xbuild /p:Configuration=Release", shell=True, cwd=app, stdout=logfile, stderr=errfile)
+    
+    subprocess.Popen("mono -O=all bin/Release/EvHttpSharpBenchmark.exe 127.0.0.1 8085 " + str(args.max_threads) + " &", shell=True, cwd=app, stdout=logfile, stderr=errfile)
+    return 0
+  except subprocess.CalledProcessError:
+    return 1
+
+def stop(logfile, errfile):
+  if os.name == 'nt':
+    return 0
+  
+  subprocess.check_call("pkill -9 mono", shell=True)
+  return 0

evhttp-sharp/src/EvHttpSharpBenchmark.csproj

@@ -0,0 +1,69 @@
+<?xml version="1.0" encoding="utf-8"?>
+<Project ToolsVersion="4.0" DefaultTargets="Build" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+  <Import Project="$(MSBuildExtensionsPath)\$(MSBuildToolsVersion)\Microsoft.Common.props" Condition="Exists('$(MSBuildExtensionsPath)\$(MSBuildToolsVersion)\Microsoft.Common.props')" />
+  <PropertyGroup>
+    <Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
+    <Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
+    <ProjectGuid>{94B0D092-4377-4A5C-B222-4F005D316DB0}</ProjectGuid>
+    <OutputType>Exe</OutputType>
+    <AppDesignerFolder>Properties</AppDesignerFolder>
+    <RootNamespace>EvHttpSharpBenchmark</RootNamespace>
+    <AssemblyName>EvHttpSharpBenchmark</AssemblyName>
+    <TargetFrameworkVersion>v4.0</TargetFrameworkVersion>
+    <FileAlignment>512</FileAlignment>
+  </PropertyGroup>
+  <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
+    <PlatformTarget>AnyCPU</PlatformTarget>
+    <DebugSymbols>true</DebugSymbols>
+    <DebugType>full</DebugType>
+    <Optimize>false</Optimize>
+    <OutputPath>bin\Debug\</OutputPath>
+    <DefineConstants>DEBUG;TRACE</DefineConstants>
+    <ErrorReport>prompt</ErrorReport>
+    <WarningLevel>4</WarningLevel>
+  </PropertyGroup>
+  <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
+    <PlatformTarget>AnyCPU</PlatformTarget>
+    <DebugType>pdbonly</DebugType>
+    <Optimize>true</Optimize>
+    <OutputPath>bin\Release\</OutputPath>
+    <DefineConstants>TRACE</DefineConstants>
+    <ErrorReport>prompt</ErrorReport>
+    <WarningLevel>4</WarningLevel>
+  </PropertyGroup>
+  <ItemGroup>
+    <Reference Include="EvHttpSharp">
+      <HintPath>lib\EvHttpSharp.dll</HintPath>
+    </Reference>
+    <Reference Include="Newtonsoft.Json">
+      <HintPath>lib\Newtonsoft.Json.dll</HintPath>
+    </Reference>
+    <Reference Include="System" />
+    <Reference Include="System.Core" />
+    <Reference Include="System.Xml.Linq" />
+    <Reference Include="System.Data.DataSetExtensions" />
+    <Reference Include="Microsoft.CSharp" />
+    <Reference Include="System.Data" />
+    <Reference Include="System.Xml" />
+  </ItemGroup>
+  <ItemGroup>
+    <Compile Include="Program.cs" />
+    <Compile Include="Properties\AssemblyInfo.cs" />
+  </ItemGroup>
+  <ItemGroup>
+    <Content Include="libevent_core-2-0-5.dll">
+      <CopyToOutputDirectory>Always</CopyToOutputDirectory>
+    </Content>
+    <Content Include="libevent_extra-2-0-5.dll">
+      <CopyToOutputDirectory>Always</CopyToOutputDirectory>
+    </Content>
+  </ItemGroup>
+  <Import Project="$(MSBuildToolsPath)\Microsoft.CSharp.targets" />
+  <!-- To modify your build process, add your task inside one of the targets below and uncomment it. 
+       Other similar extension points exist, see Microsoft.Common.targets.
+  <Target Name="BeforeBuild">
+  </Target>
+  <Target Name="AfterBuild">
+  </Target>
+  -->
+</Project>

evhttp-sharp/src/EvHttpSharpBenchmark.sln

@@ -0,0 +1,20 @@
+
+Microsoft Visual Studio Solution File, Format Version 12.00
+# Visual Studio 2012
+Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "EvHttpSharpBenchmark", "EvHttpSharpBenchmark.csproj", "{94B0D092-4377-4A5C-B222-4F005D316DB0}"
+EndProject
+Global
+	GlobalSection(SolutionConfigurationPlatforms) = preSolution
+		Debug|Any CPU = Debug|Any CPU
+		Release|Any CPU = Release|Any CPU
+	EndGlobalSection
+	GlobalSection(ProjectConfigurationPlatforms) = postSolution
+		{94B0D092-4377-4A5C-B222-4F005D316DB0}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
+		{94B0D092-4377-4A5C-B222-4F005D316DB0}.Debug|Any CPU.Build.0 = Debug|Any CPU
+		{94B0D092-4377-4A5C-B222-4F005D316DB0}.Release|Any CPU.ActiveCfg = Release|Any CPU
+		{94B0D092-4377-4A5C-B222-4F005D316DB0}.Release|Any CPU.Build.0 = Release|Any CPU
+	EndGlobalSection
+	GlobalSection(SolutionProperties) = preSolution
+		HideSolutionNode = FALSE
+	EndGlobalSection
+EndGlobal

evhttp-sharp/src/Program.cs

@@ -0,0 +1,37 @@
+using System;
+using System.Collections.Generic;
+using System.IO;
+using System.Linq;
+using System.Net;
+using System.Text;
+using EvHttpSharp;
+using Newtonsoft.Json;
+
+namespace EvHttpSharpBenchmark
+{
+	class Program
+	{
+		public static readonly JsonSerializer Serializer = new JsonSerializer();
+
+		static void Main (string[] args)
+		{
+			var host = new EventHttpListener(Handler);
+			host.Start(args[0], ushort.Parse(args[1]), int.Parse(args[2]));
+		}
+
+		private static void Handler(EventHttpRequest req)
+		{
+			var headers = new Dictionary<string, string>();
+			var resp = "Hello, World!";
+
+			if (!req.Uri.Contains("plaintext"))
+			{
+				var sw = new StringWriter();
+				Serializer.Serialize(sw, new {message = "Hello, world"});
+				resp = sw.ToString();
+				headers["Content-Type"] = "application/json";
+			}
+			req.Respond (HttpStatusCode.OK, headers, Encoding.UTF8.GetBytes (resp));
+		}
+	}
+}

evhttp-sharp/src/Properties/AssemblyInfo.cs

@@ -0,0 +1,36 @@
+using System.Reflection;
+using System.Runtime.CompilerServices;
+using System.Runtime.InteropServices;
+
+// General Information about an assembly is controlled through the following 
+// set of attributes. Change these attribute values to modify the information
+// associated with an assembly.
+[assembly: AssemblyTitle ("EvHttpSharpBenchmark")]
+[assembly: AssemblyDescription ("")]
+[assembly: AssemblyConfiguration ("")]
+[assembly: AssemblyCompany ("")]
+[assembly: AssemblyProduct ("EvHttpSharpBenchmark")]
+[assembly: AssemblyCopyright ("Copyright ©  2013")]
+[assembly: AssemblyTrademark ("")]
+[assembly: AssemblyCulture ("")]
+
+// Setting ComVisible to false makes the types in this assembly not visible 
+// to COM components.  If you need to access a type in this assembly from 
+// COM, set the ComVisible attribute to true on that type.
+[assembly: ComVisible (false)]
+
+// The following GUID is for the ID of the typelib if this project is exposed to COM
+[assembly: Guid ("8c379b35-c45f-4d4b-b54a-2a38ec7112d4")]
+
+// Version information for an assembly consists of the following four values:
+//
+//      Major Version
+//      Minor Version 
+//      Build Number
+//      Revision
+//
+// You can specify all the values or you can default the Build and Revision Numbers 
+// by using the '*' as shown below:
+// [assembly: AssemblyVersion("1.0.*")]
+[assembly: AssemblyVersion ("1.0.0.0")]
+[assembly: AssemblyFileVersion ("1.0.0.0")]

falcore/setup.py

@@ -23,7 +23,7 @@ def stop(logfile, errfile):
   p = subprocess.Popen(['ps', 'aux'], stdout=subprocess.PIPE)
   out, err = p.communicate()
   for line in out.splitlines():
-    if 'falcore' in line:
+    if 'falcore' in line and 'run-tests' not in line:
       pid = int(line.split(None, 2)[1])
       os.kill(pid, 9)
   return 0

grails/README.md

@@ -4,17 +4,34 @@ This is the Grails portion of a [benchmarking test suite](../) comparing a varie
 
 ## Infrastructure Software Versions
 The tests were run with:
-* [Grails 2.3.1](http://grails.org/)
+* [Grails 2.3.3](http://grails.org/)
 * [Java OpenJDK 1.7.0_09](http://openjdk.java.net/)
 * [Resin 4.0.34](http://www.caucho.com/)
 * [MySQL 5.5.29](https://dev.mysql.com/)
 
 
 ## Test URLs
-### JSON Encoding Test
+
+### Test type 1: JSON serialization
 
 http://localhost:8080/grails/hello/json
 
-### Data-Store/Database Mapping Test
+### Test type 2: Single database query
+
+http://localhost:8080/grails/hello/db
+
+### Test type 3: Multiple database queries
+
+http://localhost:8080/grails/hello/queries?queries=10
+
+### Test type 4: Fortunes
+
+http://localhost:8080/grails/hello/fortunes
+
+### Test type 5: Database updates
+
+http://localhost:8080/grails/hello/updates?queries=10
+
+### Test type 6: Plaintext
 
-http://localhost:8080/grails/hello/db?queries=5
+http://localhost:8080/grails/hello/plaintext

grails/benchmark_config

@@ -5,7 +5,10 @@
       "setup_file": "setup",
       "json_url": "/grails/hello/json",
       "db_url": "/grails/hello/db",
-      "query_url": "/grails/hello/db?queries=",
+      "query_url": "/grails/hello/queries?queries=",
+      "fortune_url": "/grails/hello/fortunes",
+      "update_url": "/grails/hello/updates?queries=",
+      "plaintext_url": "/grails/hello/plaintext",
       "port": 8080,
       "approach": "Realistic",
       "classification": "Fullstack",
@@ -19,8 +22,7 @@
       "database_os": "Linux",
       "display_name": "grails",
       "notes": "",
-      "versus": "servlet",
-      "skip": "true"
+      "versus": "servlet"
     }
   }]
 }

grails/hello/.classpath

@@ -1,14 +1,16 @@
+<?xml version="1.0" encoding="UTF-8"?>
 <classpath>
-    <classpathentry kind="src" path="src/java"/>
-    <classpathentry kind="src" path="src/groovy"/>
-    <classpathentry kind="src" path="grails-app/conf"/>
-    <classpathentry kind="src" path="grails-app/controllers"/>
-    <classpathentry kind="src" path="grails-app/domain"/>
-    <classpathentry kind="src" path="grails-app/services"/>
-    <classpathentry kind="src" path="grails-app/taglib"/>
-    <classpathentry kind="src" path="test/integration"/>
-    <classpathentry kind="src" path="test/unit"/>
-    <classpathentry kind="con" path="org.eclipse.jdt.launching.JRE_CONTAINER"/>
-    <classpathentry kind="con" path="com.springsource.sts.grails.core.CLASSPATH_CONTAINER"/>
-    <classpathentry kind="output" path="web-app/WEB-INF/classes"/>
-</classpath>
+	<classpathentry kind="src" path="src/java"/>
+	<classpathentry kind="src" path="src/groovy"/>
+	<classpathentry kind="src" path="grails-app/conf"/>
+	<classpathentry kind="src" path="grails-app/controllers"/>
+	<classpathentry kind="src" path="grails-app/domain"/>
+	<classpathentry kind="src" path="grails-app/services"/>
+	<classpathentry kind="src" path="grails-app/taglib"/>
+	<classpathentry kind="src" path="grails-app/utils"/>
+	<classpathentry kind="src" path="test/integration"/>
+	<classpathentry kind="src" path="test/unit"/>
+	<classpathentry kind="con" path="org.eclipse.jdt.launching.JRE_CONTAINER"/>
+	<classpathentry kind="con" path="org.grails.ide.eclipse.core.CLASSPATH_CONTAINER"/>
+	<classpathentry kind="output" path="target-eclipse/classes"/>
+</classpath>

grails/hello/.gitignore

@@ -0,0 +1,17 @@
+*.iws
+*Db.properties
+*Db.script
+.settings
+stacktrace.log
+/*.zip
+/plugin.xml
+/*.log
+/*DB.*
+/cobertura.ser
+.DS_Store
+/target/
+/out/
+/web-app/plugins
+/web-app/WEB-INF/classes
+/.link_to_grails_plugins/
+/target-eclipse/

grails/hello/.project

@@ -5,6 +5,11 @@
 	<projects>
 	</projects>
 	<buildSpec>
+		<buildCommand>
+			<name>org.eclipse.wst.common.project.facet.core.builder</name>
+			<arguments>
+			</arguments>
+		</buildCommand>
 		<buildCommand>
 			<name>org.eclipse.jdt.core.javabuilder</name>
 			<arguments>
@@ -12,8 +17,9 @@
 		</buildCommand>
 	</buildSpec>
 	<natures>
-	    <nature>com.springsource.sts.grails.core.nature</nature>
+		<nature>org.grails.ide.eclipse.core.nature</nature>
 		<nature>org.eclipse.jdt.groovy.core.groovyNature</nature>
 		<nature>org.eclipse.jdt.core.javanature</nature>
+		<nature>org.eclipse.wst.common.project.facet.core.nature</nature>
 	</natures>
 </projectDescription>

grails/hello/application.properties

@@ -1,6 +1,6 @@
 #Grails Metadata file
-#Sat Oct 26 13:32:20 PDT 2013
-app.grails.version=2.3.1
+#Sun Oct 20 22:08:59 EEST 2013
+app.grails.version=2.3.3
 app.name=hello
 app.servlet.version=2.5
 app.version=0.1

grails/hello/grails-app/conf/BuildConfig.groovy

@@ -2,10 +2,34 @@ grails.servlet.version = "2.5" // Change depending on target container complianc
 grails.project.class.dir = "target/classes"
 grails.project.test.class.dir = "target/test-classes"
 grails.project.test.reports.dir = "target/test-reports"
+grails.project.work.dir = "target/work"
 grails.project.target.level = 1.7
 grails.project.source.level = 1.7
 //grails.project.war.file = "target/${appName}-${appVersion}.war"
 
+grails.project.fork = [
+    // configure settings for compilation JVM, note that if you alter the Groovy version forked compilation is required
+    //  compile: [maxMemory: 256, minMemory: 64, debug: false, maxPerm: 256, daemon:true],
+
+    // configure settings for the test-app JVM, uses the daemon by default
+    test: [maxMemory: 768, minMemory: 64, debug: false, maxPerm: 256, daemon:true],
+    // configure settings for the run-app JVM
+    run: [maxMemory: 768, minMemory: 64, debug: false, maxPerm: 256, forkReserve:false],
+    // configure settings for the run-war JVM
+    war: [maxMemory: 768, minMemory: 64, debug: false, maxPerm: 256, forkReserve:false],
+    // configure settings for the Console UI JVM
+    console: [maxMemory: 768, minMemory: 64, debug: false, maxPerm: 256]
+]
+
+def yjpConfig = [jvmArgs: [
+        "-agentpath:/opt/yjp/bin/linux-x86-64/libyjpagent.so=delay=30000,disablealloc,disablej2ee,noj2ee,builtinprobes=none,sampling,monitors,onexit=snapshot,telemetryperiod=250"
+    ]]
+if (System.getProperty("grails.yjp")) {
+    grails.project.fork.war += yjpConfig
+    println "Using YJP for run-war"
+}
+
+grails.project.dependency.resolver = "maven" // or ivy
 grails.project.dependency.resolution = {
     // inherit Grails' default dependencies
     inherits("global") {
@@ -14,11 +38,13 @@ grails.project.dependency.resolution = {
     }
     log "error" // log level of Ivy resolver, either 'error', 'warn', 'info', 'debug' or 'verbose'
     checksums true // Whether to verify checksums on resolve
+    legacyResolve false // whether to do a secondary resolve on plugin installation, not advised and here for backwards compatibility
 
     repositories {
         inherits true // Whether to inherit repository definitions from plugins
         grailsPlugins()
         grailsHome()
+		mavenLocal()
         grailsCentral()
         mavenCentral()
 
@@ -33,18 +59,19 @@ grails.project.dependency.resolution = {
     dependencies {
         // specify dependencies here under either 'build', 'compile', 'runtime', 'test' or 'provided' scopes eg.
 
-        runtime 'mysql:mysql-connector-java:5.1.22'
+        runtime 'mysql:mysql-connector-java:5.1.27'
     }
 
     plugins {
-        compile ":hibernate:3.6.10.2"
-        runtime ":jquery:1.7.1"
-        runtime ":resources:1.1.6"
+        runtime ":hibernate:3.6.10.4"
+        //runtime ":jquery:1.10.2"
+        //runtime ":resources:1.2.1"
 
         // Uncomment these (or add new ones) to enable additional resources capabilities
         //runtime ":zipped-resources:1.0"
         //runtime ":cached-resources:1.0"
         //runtime ":yui-minify-resources:0.1.4"
-        build ':tomcat:7.0.40.1'
+
+        build ":tomcat:7.0.47"
     }
 }

grails/hello/grails-app/conf/Config.groovy

@@ -12,21 +12,26 @@
 
 
 grails.project.groupId = appName // change this to alter the default package name and Maven publishing destination
-grails.mime.file.extensions = true // enables the parsing of file extensions from URLs into the request format
-grails.mime.use.accept.header = false
-grails.mime.types = [ html: ['text/html','application/xhtml+xml'],
-                      xml: ['text/xml', 'application/xml'],
-                      text: 'text/plain',
-                      js: 'text/javascript',
-                      rss: 'application/rss+xml',
-                      atom: 'application/atom+xml',
-                      css: 'text/css',
-                      csv: 'text/csv',
-                      all: '*/*',
-                      json: ['application/json','text/json'],
-                      form: 'application/x-www-form-urlencoded',
-                      multipartForm: 'multipart/form-data'
-                    ]
+
+grails.app.context = '/grails'
+
+// The ACCEPT header will not be used for content negotiation for user agents containing the following strings (defaults to the 4 major rendering engines)
+grails.mime.disable.accept.header.userAgents = ['Gecko', 'WebKit', 'Presto', 'Trident']
+grails.mime.types = [
+    all:           '*/*',
+    atom:          'application/atom+xml',
+    css:           'text/css',
+    csv:           'text/csv',
+    form:          'application/x-www-form-urlencoded',
+    html:          ['text/html','application/xhtml+xml'],
+    js:            'text/javascript',
+    json:          ['application/json', 'text/json'],
+    multipartForm: 'multipart/form-data',
+    rss:           'application/rss+xml',
+    text:          'text/plain',
+    hal:           ['application/hal+json','application/hal+xml'],
+    xml:           ['text/xml', 'application/xml']
+]
 
 // URL Mapping Cache Max Size, defaults to 5000
 //grails.urlmapping.cache.maxsize = 1000
@@ -34,10 +39,33 @@ grails.mime.types = [ html: ['text/html','application/xhtml+xml'],
 // What URL patterns should be processed by the resources plugin
 grails.resources.adhoc.patterns = ['/images/*', '/css/*', '/js/*', '/plugins/*']
 
+// Legacy setting for codec used to encode data with ${}
+grails.views.default.codec = "html"
+
+// The default scope for controllers. May be prototype, session or singleton.
+// If unspecified, controllers are prototype scoped.
+grails.controllers.defaultScope = 'singleton'
 
-// The default codec used to encode data with ${}
-grails.views.default.codec = "none" // none, html, base64
-grails.views.gsp.encoding = "UTF-8"
+// GSP settings
+grails {
+    views {
+        gsp {
+            encoding = 'UTF-8'
+            htmlcodec = 'xml' // use xml escaping instead of HTML4 escaping
+            codecs {
+                expression = 'html' // escapes values inside ${}
+                scriptlet = 'html' // escapes output from scriptlets in GSPs
+                taglib = 'none' // escapes output from taglibs
+                staticparts = 'none' // escapes output from static template parts
+            }
+        }
+        // escapes all not-encoded output at final stage of outputting
+        filteringCodecForContentType {
+            //'text/html' = 'html'
+        }
+    }
+}
+ 
 grails.converters.encoding = "UTF-8"
 // enable Sitemesh preprocessing of GSP pages
 grails.views.gsp.sitemesh.preprocess = true
@@ -59,6 +87,9 @@ grails.exceptionresolver.params.exclude = ['password']
 // disabling query cache
 grails.hibernate.cache.queries = false
 
+// OSIV is readonly by default
+grails.hibernate.osiv.readonly = true
+
 // set per-environment serverURL stem for creating absolute links
 environments {
     development {
@@ -91,27 +122,3 @@ log4j = {
            'org.hibernate',
            'net.sf.ehcache.hibernate'
 }
-
-// Uncomment and edit the following lines to start using Grails encoding & escaping improvements
-
-/* remove this line 
-// GSP settings
-grails {
-    views {
-        gsp {
-            encoding = 'UTF-8'
-            htmlcodec = 'xml' // use xml escaping instead of HTML4 escaping
-            codecs {
-                expression = 'html' // escapes values inside null
-                scriptlet = 'none' // escapes output from scriptlets in GSPs
-                taglib = 'none' // escapes output from taglibs
-                staticparts = 'none' // escapes output from static template parts
-            }
-        }
-        // escapes all not-encoded output at final stage of outputting
-        filteringCodecForContentType {
-            //'text/html' = 'html'
-        }
-    }
-}
-remove this line */

grails/hello/grails-app/conf/DataSource.groovy

@@ -1,25 +1,53 @@
+import org.springframework.beans.factory.config.PropertiesFactoryBean
+import org.springframework.core.io.support.ResourceArrayPropertyEditor
+
 dataSource {
     pooled = true
     dbCreate = "update"
-    url = "jdbc:mysql://localhost:3306/hello_world?jdbcCompliantTruncation=false&elideSetAutoCommits=true&useLocalSessionState=true&cachePrepStmts=true&cacheCallableStmts=true&alwaysSendSetIsolation=false&prepStmtCacheSize=4096&cacheServerConfiguration=true&prepStmtCacheSqlLimit=2048&zeroDateTimeBehavior=convertToNull&traceProtocol=false&useUnbufferedInput=false&useReadAheadInput=false&maintainTimeStats=false&useServerPrepStmts&cacheRSMetadata=true"
+    url = "jdbc:mysql://localhost:3306/hello_world"
     driverClassName = "com.mysql.jdbc.Driver"
     dialect = org.hibernate.dialect.MySQL5InnoDBDialect
     username = "benchmarkdbuser"
     password = "benchmarkdbpass"
     properties {
-        maxActive = 256
+        fairQueue = false
+        maxActive = 512
         maxIdle = 25
         minIdle = 5
         initialSize = 5
         minEvictableIdleTimeMillis = 60000
         timeBetweenEvictionRunsMillis = 60000
         maxWait = 10000
-        validationQuery = "/* ping */"
+        maxAge = 1800 * 1000
+        numTestsPerEvictionRun=3
+        testOnBorrow=false
+        testWhileIdle=true
+        testOnReturn=false
+        validationQuery="/* ping */"
+        validationInterval=15000
+        jdbcInterceptors="ConnectionState;StatementCache"
+        defaultTransactionIsolation = java.sql.Connection.TRANSACTION_READ_UNCOMMITTED
+        dbProperties = this.loadProperties("classpath:mysql-connection.properties")
     }
 }
+
 hibernate {
     // Purposely turning off query cache
     cache.use_second_level_cache = false
     cache.use_query_cache = false
     cache.region.factory_class = 'net.sf.ehcache.hibernate.EhCacheRegionFactory'
+    default_batch_fetch_size=256
+    jdbc.fetch_size=256
+    jdbc.batch_size=500
 }
+
+static Properties loadProperties(String path) {
+    PropertiesFactoryBean pfb=new PropertiesFactoryBean()
+    pfb.setIgnoreResourceNotFound(true)
+    def converter=new ResourceArrayPropertyEditor()
+    converter.setAsText(path)
+    pfb.setLocations(converter.getValue())
+    pfb.afterPropertiesSet()
+    return pfb.object
+}
+

grails/hello/grails-app/conf/JsonBootStrap.groovy

@@ -0,0 +1,18 @@
+import org.codehaus.groovy.grails.web.converters.Converter
+import org.codehaus.groovy.grails.web.json.JSONWriter
+import grails.converters.JSON
+import hello.World
+
[email protected]
+class JsonBootStrap {
+    def init = { servletContext ->
+        JSON.registerObjectMarshaller(World, { World world, Converter converter ->
+            JSONWriter writer = (JSONWriter)converter.writer
+            writer.object()
+            writer.key('id').value(world.id)
+            writer.key('randomNumber').value(world.randomNumber)
+            writer.endObject()
+            null
+        })
+    }
+}

grails/hello/grails-app/conf/JsonWorkaroundBootStrap.groovy

@@ -0,0 +1,19 @@
+import org.codehaus.groovy.grails.web.json.JSONObject
+import org.springframework.util.ClassUtils
+import org.springframework.util.ReflectionUtils
+
+class JsonWorkaroundBootStrap {
+    def init = { servletContext ->
+        // activate workaround for GRAILS-10823
+        println("activating workaround for GRAILS-10823 - use this only for Grails 2.3.3")
+        def encoderInstance = ClassUtils.forName("org.codehaus.groovy.grails.plugins.codecs.JSONEncoder", JSONObject.class.getClassLoader()).newInstance()
+        ['javascriptEncoderStateless', 'javascriptEncoder'].each { fieldName ->
+            ReflectionUtils.findField(JSONObject, fieldName).with {
+                accessible = true
+                set(null, encoderInstance)
+            }
+        }
+    }
+    def destroy = {
+    }
+}

grails/hello/grails-app/conf/UrlMappings.groovy

@@ -1,7 +1,7 @@
 class UrlMappings {
 
 	static mappings = {
-		"/$controller/$action?/$id?"{
+        "/$controller/$action?/$id?(.${format})?"{
 			constraints {
 				// apply constraints here
 			}

grails/hello/grails-app/conf/mysql-connection.properties

@@ -0,0 +1,60 @@
+# MYSQL JDBC Connection properties
+# http://dev.mysql.com/doc/refman/5.5/en/connector-j-reference-configuration-properties.html
+jdbcCompliantTruncation=false
+autoReconnect=false
+zeroDateTimeBehavior=convertToNull
+
+# disable unicode handling
+useUnicode=false
+
+# Get rid of SQL exceptions thrown in Mysql jdbc driver
+holdResultsOpenOverStatementClose=true
+
+# charset
+#useUnicode=true
+#characterEncoding=Cp1252
+
+#dumpQueriesOnException=true
+
+dontTrackOpenResources=true
+
+#useCompression=true
+#tcpRcvBuf=262144
+#tcpSndBuf=262144
+
+# setAutocommit / setIsolationLevel optimizations
+useLocalSessionState=true
+useLocalTransactionState=true
+elideSetAutoCommits=true
+alwaysSendSetIsolation=false
+relaxAutoCommit=true
+
+# metadata caching
+cacheServerConfiguration=true
+cacheResultSetMetadata=true
+metadataCacheSize=100
+
+# enable MySQL query cache - server prep stmts wont use caching
+useServerPrepStmts=false
+
+# prepared statement caching on JDBC client
+cachePrepStmts=false
+cacheCallableStmts=false
+prepStmtCacheSize=4096
+prepStmtCacheSqlLimit=32000
+
+# log slow queries
+#logSlowQueries=true
+#slowQueryThresholdMillis=2000
+
+noDatetimeStringSync=true
+enableQueryTimeouts=false
+
+traceProtocol=false
+useUnbufferedInput=true
+useReadAheadInput=true
+maintainTimeStats=false
+
+# timeouts for TCP/IP
+connectTimeout=15000
+socketTimeout=120000

grails/hello/grails-app/controllers/hello/HelloController.groovy

@@ -1,32 +1,101 @@
 package hello
 
 import grails.converters.JSON
+import grails.transaction.Transactional
+import groovy.transform.CompileStatic
+import groovy.transform.TypeCheckingMode;
+
 import java.util.concurrent.ThreadLocalRandom
 
+import org.springframework.transaction.annotation.Isolation;
+
+@CompileStatic
 class HelloController {
 
     def index() {
-      def response = [
-        message: "Hello, world"
-      ]
-      render response as JSON
+        plaintext()
+    }
+
+    // benchmark specification
+    // http://www.techempower.com/benchmarks/#section=code
+    
+    // Test type 1: JSON serialization
+    def json() {
+        def msg = [
+            message: "Hello, world"
+        ]
+        render msg as JSON
     }
 
+    // Test type 2: Single database query
+    @Transactional(readOnly=true)
     def db() {
-      int queries = params.queries ? params.int('queries') : 1
-      def worlds = new ArrayList(queries)
-      def random = ThreadLocalRandom.current();
+        def random = ThreadLocalRandom.current()
+        def world = World.read(random.nextInt(10000) + 1)
+        render world as JSON
+    }
+    
+    // Test type 3: Multiple database queries
+    @Transactional(readOnly=true)
+    def queries(int queries) {
+        def worlds = fetchRandomWorlds(queries, false)
+        render worlds as JSON
+    }
+
+    private List<World> fetchRandomWorlds(int queries, boolean updateAlso) {
+        if(queries < 1) queries=1
+        if(queries > 500) queries=500
+        def random = ThreadLocalRandom.current()
 
-      for (int i = 0; i < queries; i++) {
-        worlds.add(World.read(random.nextInt(10000) + 1));
-      }
-      render worlds as JSON
+        List<Integer> worldIds = new ArrayList<Integer>(queries)
+        for (int i = 0; i < queries; i++) {
+            worldIds.add(random.nextInt(10000) + 1)
+        }
+        List<World> worlds
+        if (updateAlso) {
+            worlds = getAllLocked(worldIds as Serializable[])
+            for (World world : worlds) {
+                world.randomNumber = random.nextInt(10000) + 1
+            }
+        } else {
+            worlds = new ArrayList<World>(queries)
+            for (Integer id : worldIds) {
+                worlds.add(World.read(id))
+            }
+        }
+        return worlds
     }
     
-    def json() {
-      def response = [
-        message: "Hello, world"
-      ]
-      render response as JSON
+    @CompileStatic(TypeCheckingMode.SKIP)
+    private List<World> getAllLocked(Serializable[] worldIds) {
+        World.withCriteria {
+            'in'('id', worldIds as Serializable[])
+            lock true
+        }
+    }
+    
+    // Test type 4: Fortunes
+    @Transactional(readOnly=true)
+    def fortunes() {
+        def fortunes = Fortune.getAll()
+        fortunes << new Fortune(message: 'Additional fortune added at request time.')
+        fortunes.sort(true){Fortune it -> it.message}
+        [fortunes: fortunes]
+    }
+    
+    // Test type 5: Database updates
+    def updates(int queries) {
+        def worlds = updateWorlds(queries)
+        render worlds as JSON
+    }
+
+    @Transactional(isolation=Isolation.READ_COMMITTED)
+    private List updateWorlds(int queries) {
+        fetchRandomWorlds(queries, true)
+    }
+    
+    // Test type 6: Plaintext
+    def plaintext() {
+        render text:'Hello, world', contentType:'text/plain'
     }
 }

grails/hello/grails-app/domain/hello/Fortune.groovy

@@ -0,0 +1,14 @@
+package hello
+
+class Fortune {
+    Integer id
+    String message
+
+    static constraints = {
+    }
+
+    static mapping = {
+      table name: 'Fortune'
+      version false
+    }
+}

grails/hello/grails-app/domain/hello/World.groovy

@@ -1,12 +1,14 @@
 package hello
 
 class World {
+    Integer id
     Integer randomNumber
 
     static constraints = {
     }
 
     static mapping = {
+      table name: 'World'
       version false
       columns {
         randomNumber     column:"randomNumber"

grails/hello/grails-app/views/error.gsp

@@ -1,11 +1,18 @@
-<!doctype html>
+<!DOCTYPE html>
 <html>
 	<head>
-		<title>Grails Runtime Exception</title>
+		<title><g:if env="development">Grails Runtime Exception</g:if><g:else>Error</g:else></title>
 		<meta name="layout" content="main">
-		<link rel="stylesheet" href="${resource(dir: 'css', file: 'errors.css')}" type="text/css">
+		<g:if env="development"><link rel="stylesheet" href="${resource(dir: 'css', file: 'errors.css')}" type="text/css"></g:if>
 	</head>
 	<body>
-		<g:renderException exception="${exception}" />
+		<g:if env="development">
+			<g:renderException exception="${exception}" />
+		</g:if>
+		<g:else>
+			<ul class="errors">
+				<li>An error has occurred</li>
+			</ul>
+		</g:else>
 	</body>
-</html>
+</html>

grails/hello/grails-app/views/hello/fortunes.gsp

@@ -0,0 +1,10 @@
+<!DOCTYPE html>
+<html>
+<head><title>Fortunes</title></head>
+<body>
+<table>
+<tr><th>id</th><th>message</th></tr>
+<g:each var="fortune" in="${fortunes}"><tr><td>${fortune.id}</td><td>${fortune.message}</td></tr></g:each>
+</table>
+</body>
+</html>

grails/hello/grails-app/views/index.gsp

@@ -1,4 +1,4 @@
-<!doctype html>
+<!DOCTYPE html>
 <html>
 	<head>
 		<meta name="layout" content="main"/>
@@ -29,7 +29,7 @@
 				margin-bottom: 0.6em;
 				padding: 0;
 			}
-            
+
 			#status li {
 				line-height: 1.3;
 			}
@@ -87,7 +87,7 @@
 			<ul>
 				<li>App version: <g:meta name="app.version"/></li>
 				<li>Grails version: <g:meta name="app.grails.version"/></li>
-				<li>Groovy version: ${org.codehaus.groovy.runtime.InvokerHelper.getVersion()}</li>
+				<li>Groovy version: ${GroovySystem.getVersion()}</li>
 				<li>JVM version: ${System.getProperty('java.version')}</li>
 				<li>Reloading active: ${grails.util.Environment.reloadingAgentEnabled}</li>
 				<li>Controllers: ${grailsApplication.controllerClasses.size()}</li>

grails/hello/src/groovy/org/codehaus/groovy/grails/plugins/codecs/JSONEncoder.java

@@ -0,0 +1,85 @@
+/*
+ * Copyright 2013 the original author or authors.
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ *      http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ * See the License for the specific language governing permissions and
+ * limitations under the License.
+ */
+package org.codehaus.groovy.grails.plugins.codecs;
+
+import org.apache.commons.lang.StringUtils;
+import org.codehaus.groovy.grails.support.encoding.CodecIdentifier;
+import org.codehaus.groovy.grails.support.encoding.DefaultCodecIdentifier;
+
+/**
+ * Escapes characters in JSON output
+ *
+ * @author Lari Hotari
+ * @since 2.3.4
+ */
+public class JSONEncoder extends AbstractCharReplacementEncoder {
+    public static final CodecIdentifier JSON_CODEC_IDENTIFIER = new DefaultCodecIdentifier(
+            "JSON", "Json") {
+        public boolean isEquivalent(CodecIdentifier other) {
+            return super.isEquivalent(other) || JavaScriptEncoder.JAVASCRIPT_CODEC_IDENTIFIER.getCodecName().equals(other.getCodecName());
+        };
+    };
+
+    public JSONEncoder() {
+        super(JSON_CODEC_IDENTIFIER);
+    }
+
+    /* (non-Javadoc)
+     * @see org.codehaus.groovy.grails.plugins.codecs.AbstractCharReplacementEncoder#escapeCharacter(char, char)
+     */
+    @Override
+    protected String escapeCharacter(char ch, char previousChar) {
+        switch (ch) {
+            case '"':
+                return "\\\"";
+            case '\\':
+                return "\\\\";
+            case '\t':
+                return "\\t";
+            case '\n':
+                return "\\n";
+            case '\r':
+                return "\\r";
+            case '\f':
+                return "\\f";
+            case '\b':
+                return "\\b";
+            case '\u000B': // vertical tab: http://bclary.com/2004/11/07/#a-7.8.4
+                return "\\v";
+            case '\u2028':
+                return "\\u2028"; // Line separator
+            case '\u2029':
+                return "\\u2029"; // Paragraph separator
+            case '/':
+                // preserve special handling that exists in JSONObject.quote to improve security if JSON is embedded in HTML document
+                // prevents outputting "</" gets outputted with unicode escaping for the slash
+                if (previousChar == '<') {
+                    return "\\u002f"; 
+                }
+                break;
+        }
+        if(ch < ' ') {
+            // escape all other control characters
+            return "\\u" + StringUtils.leftPad(Integer.toHexString(ch), 4, '0');
+        }
+        return null;
+    }
+
+    @Override
+    public boolean isApplyToSafelyEncoded() {
+        return true;
+    }
+}

grails/hello/web-app/WEB-INF/sitemesh-excludes.xml

@@ -0,0 +1,8 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<sitemesh-excludes>
+  <excludes>
+      <pattern>/hello/*</pattern>
+      <pattern>/hello</pattern>
+  </excludes>
+</sitemesh-excludes>
+

grails/hello/web-app/WEB-INF/sitemesh.xml

@@ -1,4 +1,5 @@
 <sitemesh>
+    <excludes file="/WEB-INF/sitemesh-excludes.xml" />
     <page-parsers>
         <parser content-type="text/html"
             class="org.codehaus.groovy.grails.web.sitemesh.GrailsHTMLPageParser" />
@@ -11,4 +12,4 @@
     <decorator-mappers>
         <mapper class="org.codehaus.groovy.grails.web.sitemesh.GrailsLayoutDecoratorMapper" />
     </decorator-mappers>
-</sitemesh>
+</sitemesh>

grails/setup.py

@@ -7,8 +7,8 @@ def start(args, logfile, errfile):
   setup_util.replace_text("grails/hello/grails-app/conf/DataSource.groovy", "jdbc:mysql:\/\/.*:3306", "jdbc:mysql://" + args.database_host + ":3306")
   
   try:
-    subprocess.check_call("grails install-dependency mysql:mysql-connector-java:5.1.22", shell=True, cwd="grails/hello", stderr=errfile, stdout=logfile)
-    subprocess.check_call("grails war", shell=True, cwd="grails/hello", stderr=errfile, stdout=logfile)
+    subprocess.check_call("grails -non-interactive -plain-output compile", shell=True, cwd="grails/hello", stderr=errfile, stdout=logfile)
+    subprocess.check_call("grails prod -non-interactive -plain-output war", shell=True, cwd="grails/hello", stderr=errfile, stdout=logfile)
     subprocess.check_call("rm -rf $RESIN_HOME/webapps/*", shell=True, stderr=errfile, stdout=logfile)
     subprocess.check_call("cp grails/hello/target/hello-0.1.war $RESIN_HOME/webapps/grails.war", shell=True, stderr=errfile, stdout=logfile)
     subprocess.check_call("$RESIN_HOME/bin/resinctl start", shell=True, stderr=errfile, stdout=logfile)
@@ -21,4 +21,4 @@ def stop(logfile, errfile):
     subprocess.check_call("rm -rf $RESIN_HOME/resin-data/*", shell=True, stderr=errfile, stdout=logfile)
     return 0
   except subprocess.CalledProcessError:
-    return 1
+    return 1

jetty-servlet/README.md

@@ -0,0 +1,15 @@
+# Jetty-9 Benchmarking Test
+
+This is the Jetty portion of a [benchmarking test suite](../) comparing a variety of web development platforms.
+
+### JSON Encoding Test
+* [JSON test source](src/main/java/hello/HelloWebServer.java)
+
+## Versions
+Jetty-9.1.0 (http://eclipse.org/jetty)
+
+## Test URLs
+
+### JSON Encoding Test
+
+    http://localhost:8080

jetty-servlet/benchmark_config

@@ -0,0 +1,24 @@
+{
+  "framework": "jetty-servlet",
+  "tests": [{
+    "default": {
+      "setup_file": "setup",
+      "json_url": "/json",
+      "plaintext_url": "/plaintext",
+      "port": 8080,
+      "approach": "Realistic",
+      "classification": "Platform",
+      "database": "None",
+      "framework": "Servlet-3.1",
+      "language": "Java",
+      "orm": "None",
+      "platform": "Jetty",
+      "webserver": "Jetty",
+      "os": "Linux",
+      "database_os": "Linux",
+      "display_name": "jetty-servlet",
+      "notes": "Jetty 9.1 with ServletContext",
+      "versus": ""
+    }
+  }]
+}

jetty-servlet/pom.xml

@@ -0,0 +1,64 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<project xmlns="http://maven.apache.org/POM/4.0.0"
+         xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
+         xsi:schemaLocation="http://maven.apache.org/POM/4.0.0 http://maven.apache.org/xsd/maven-4.0.0.xsd">
+    <modelVersion>4.0.0</modelVersion>
+
+    <groupId>com.techempower</groupId>
+    <artifactId>jetty-servlet-example</artifactId>
+    <version>0.1</version>
+
+    <dependencies>
+        <!-- Web server -->
+        <dependency>
+            <groupId>org.eclipse.jetty</groupId>
+            <artifactId>jetty-servlet</artifactId>
+            <version>9.1.0.v20131115</version>
+        </dependency>
+        <dependency>
+            <groupId>org.eclipse.jetty</groupId>
+            <artifactId>jetty-util-ajax</artifactId>
+            <version>9.1.0.v20131115</version>
+        </dependency>
+    </dependencies>
+
+    <build>
+        <plugins>
+            <plugin>
+                <inherited>true</inherited>
+                <groupId>org.apache.maven.plugins</groupId>
+                <artifactId>maven-compiler-plugin</artifactId>
+                <version>2.3.2</version>
+                <configuration>
+                    <source>1.7</source>
+                    <target>1.7</target>
+                    <optimize>true</optimize>
+                    <debug>false</debug>
+                </configuration>
+            </plugin>
+            <plugin>
+                <artifactId>maven-assembly-plugin</artifactId>
+                <configuration>
+                    <archive>
+                        <manifest>
+                            <mainClass>hello.HelloWebServer</mainClass>
+                        </manifest>
+                    </archive>
+                    <descriptorRefs>
+                        <descriptorRef>jar-with-dependencies</descriptorRef>
+                    </descriptorRefs>
+                </configuration>
+                <executions>
+                    <execution>
+                        <id>make-assembly</id> <!-- this is used for inheritance merges -->
+                        <phase>package</phase> <!-- bind to the packaging phase -->
+                        <goals>
+                            <goal>single</goal>
+                        </goals>
+                    </execution>
+                </executions>
+            </plugin>
+        </plugins>
+    </build>
+
+</project>

jetty-servlet/setup.py

@@ -0,0 +1,19 @@
+import subprocess
+import sys
+import os
+
+def start(args, logfile, errfile):
+  try:
+    subprocess.check_call("mvn clean compile assembly:single", shell=True, cwd="jetty-servlet", stderr=errfile, stdout=logfile)
+    subprocess.Popen("java -jar jetty-servlet-example-0.1-jar-with-dependencies.jar".rsplit(" "), cwd="jetty-servlet/target", stderr=errfile, stdout=logfile)
+    return 0
+  except subprocess.CalledProcessError:
+    return 1
+def stop(logfile, errfile):
+  p = subprocess.Popen(['ps', 'aux'], stdout=subprocess.PIPE)
+  out, err = p.communicate()
+  for line in out.splitlines():
+    if 'jetty-servlet-example' in line:
+      pid = int(line.split(None, 2)[1])
+      os.kill(pid, 9)
+  return 0

jetty-servlet/source_code

@@ -0,0 +1,4 @@
+./jetty-servlet/src/main/java/hello/
+./jetty-servlet/src/main/java/hello/HelloWebServer.java
+./jetty-servlet/src/main/java/hello/JsonServlet.java
+./jetty-servlet/src/main/java/hello/PlaintextServlet.java

jetty-servlet/src/main/java/hello/HelloWebServer.java

@@ -0,0 +1,36 @@
+package hello;
+
+import org.eclipse.jetty.server.HttpConfiguration;
+import org.eclipse.jetty.server.HttpConnectionFactory;
+import org.eclipse.jetty.server.Server;
+import org.eclipse.jetty.server.ServerConnector;
+import org.eclipse.jetty.servlet.ServletContextHandler;
+
+
+/**
+ * An implementation of the TechEmpower benchmark tests using the Jetty web
+ * server.  
+ */
+public final class HelloWebServer 
+{
+
+    public static void main(String[] args) throws Exception
+    {
+        Server server = new Server(8080);
+        ServerConnector connector = server.getBean(ServerConnector.class);
+        HttpConfiguration config = connector.getBean(HttpConnectionFactory.class).getHttpConfiguration();
+        config.setSendDateHeader(true);
+        config.setSendServerVersion(true);
+
+        ServletContextHandler context = new ServletContextHandler(ServletContextHandler.NO_SECURITY|ServletContextHandler.NO_SESSIONS);
+        context.setContextPath("/");
+        server.setHandler(context);
+
+        context.addServlet(org.eclipse.jetty.servlet.DefaultServlet.class,"/");
+        context.addServlet(JsonServlet.class,"/json");
+        context.addServlet(PlaintextServlet.class,"/plaintext");
+
+        server.start();
+        server.join();
+    }
+}

jetty-servlet/src/main/java/hello/JsonServlet.java

@@ -0,0 +1,31 @@
+package hello;
+
+import java.io.IOException;
+import java.util.Collections;
+import java.util.Map;
+
+import javax.servlet.GenericServlet;
+import javax.servlet.ServletException;
+import javax.servlet.ServletRequest;
+import javax.servlet.ServletResponse;
+import javax.servlet.http.HttpServletResponse;
+
+import org.eclipse.jetty.util.ajax.JSON;
+
+
+
+public class JsonServlet extends GenericServlet
+{
+    private JSON json = new JSON();
+    
+    @Override
+    public void service(ServletRequest req, ServletResponse res) throws ServletException, IOException
+    {
+        HttpServletResponse response= (HttpServletResponse)res;
+        response.setContentType("application/json");
+        Map<String,String> map = Collections.singletonMap("message","Hello, World!");
+        
+        json.append(response.getWriter(),map);
+    }
+
+}

jetty-servlet/src/main/java/hello/PlaintextServlet.java

@@ -0,0 +1,28 @@
+package hello;
+
+import java.io.IOException;
+import java.nio.charset.StandardCharsets;
+import java.util.Collections;
+import java.util.Map;
+
+import javax.activation.MimeType;
+import javax.servlet.GenericServlet;
+import javax.servlet.ServletException;
+import javax.servlet.ServletRequest;
+import javax.servlet.ServletResponse;
+import javax.servlet.http.HttpServletRequest;
+import javax.servlet.http.HttpServletResponse;
+
+import org.eclipse.jetty.http.MimeTypes;
+
+public class PlaintextServlet extends GenericServlet
+{
+    byte[] helloWorld = "Hello, World!".getBytes(StandardCharsets.ISO_8859_1);
+    @Override
+    public void service(ServletRequest req, ServletResponse res) throws ServletException, IOException
+    {
+        HttpServletResponse response= (HttpServletResponse)res;
+        response.setContentType(MimeTypes.Type.TEXT_PLAIN.asString());
+        response.getOutputStream().write(helloWorld);
+    }
+}

plain/benchmark_config

@@ -23,6 +23,29 @@
       "display_name": "plain",
       "notes": "",
       "versus": ""
+    },
+    "win": {
+      "setup_file": "setup",
+      "json_url": "/json",
+      "plaintext_url": "/plaintext",
+      "db_url": "/db",
+      "query_url": "/db?queries=",
+      "update_url": "/update?queries=",
+      "fortune_url": "/fortunes",
+      "port": 9080,
+      "approach": "Realistic",
+      "classification": "Fullstack",
+      "database": "MySQL",
+      "framework": "plain",
+      "language": "Scala",
+      "orm": "Full",
+      "platform": "Plain",
+      "webserver": "None",
+      "os": "Windows",
+      "database_os": "Linux",
+      "display_name": "plain-win",
+      "notes": "",
+      "versus": ""
     }
   }]
 }

plain/build.sbt

@@ -31,8 +31,8 @@ libraryDependencies ++= Seq(
   "ch.qos.logback" % "logback-classic" % "1.0.13",
   "org.codehaus.janino" % "janino" % "2.6.1",
   "com.lmax" % "disruptor" % "3.2.0",
-  "com.typesafe.akka" %% "akka-actor" % "2.2.1",
-  "com.typesafe.akka" %% "akka-slf4j" % "2.2.1",
+  "com.typesafe.akka" %% "akka-actor" % "2.2.3",
+  "com.typesafe.akka" %% "akka-slf4j" % "2.2.3",
   "org.apache.commons" % "commons-lang3" % "3.1",
   "org.apache.commons" % "commons-compress" % "1.5",
   "commons-io" % "commons-io" % "2.4",

plain/setup.py

@@ -7,11 +7,11 @@ import os
 def start(args, logfile, errfile):
   setup_util.replace_text("plain/src/main/resources/application.conf", "127.0.0.1", args.database_host)
   if os.name == 'nt':
-    subprocess.check_call("./sbt.bat assembly", shell=True, cwd="plain", stderr=errfile, stdout=logfile)
+    subprocess.check_call(".\sbt.bat assembly && del /f /s /q target\scala-2.10\cache", shell=True, cwd="plain", stderr=errfile, stdout=logfile)
   else:
-    subprocess.check_call("./sbt assembly", shell=True, cwd="plain", stderr=errfile, stdout=logfile)
-     
-  subprocess.Popen("java -server -Xnoclassgc -XX:MaxPermSize=1g -XX:ReservedCodeCacheSize=384m -Xmx8g -Xss8m -Xmn4g -Xms6g -XX:+AggressiveOpts -XX:+UseBiasedLocking -XX:+UseG1GC -XX:MaxGCPauseMillis=200 -jar target/scala-2.10/plain-benchmark-assembly-1.0.1.jar", cwd="plain", shell=True, stderr=errfile, stdout=logfile)
+    subprocess.check_call("./sbt assembly && rm -rf target/scala-2.10/cache", shell=True, cwd="plain", stderr=errfile, stdout=logfile)
+
+  subprocess.Popen("java -server -da -dsa -Xrs -Xmx6g -Xmn4g -Xss8m -Xnoclassgc -XX:MaxPermSize=1g -XX:ReservedCodeCacheSize=384m -XX:+UseG1GC -XX:MaxGCPauseMillis=200 -jar target/scala-2.10/plain-benchmark-assembly-1.0.1.jar", cwd="plain", shell=True, stderr=errfile, stdout=logfile)
   time.sleep(10)
   return 0
 
@@ -19,6 +19,7 @@ def stop(logfile, errfile):
   if os.name == 'nt':
     subprocess.call("taskkill /f /im *plain-benchmark* > NUL", shell=True, stderr=errfile, stdout=logfile)
     return 0
+
   p = subprocess.Popen(['ps', 'aux'], stdout=subprocess.PIPE)
   out, err = p.communicate()
   for line in out.splitlines():

plain/src/main/resources/application.conf

@@ -4,13 +4,14 @@
 
 akka {
 	loggers = [ "akka.event.slf4j.Slf4jLogger" ]
-	loglevel = OFF
-	stdout-loglevel = OFF
+	loglevel = off
+	stdout-loglevel = off
 }
 
 plain {
 	logging.level = INFO
-	aio.send-receive-buffer-size = 1m
+	json.encode-output = off
+	http.ignore-accept-header = on
 	http.startup-servers = [ benchmark-server ]
 	jdbc.startup-connection-factories = [ benchmark-mysql ]
 }
@@ -32,11 +33,11 @@ benchmark-mysql {
 	name = MysqlBenchmark
 	driver = mysql-5-6-12
 	datasource-settings {	
-        	setUrl = "jdbc:mysql://127.0.0.1:3306/hello_world?jdbcCompliantTruncation=false&elideSetAutoCommits=true&dontTrackOpenResources=true&enableQueryTimeouts=false&useLocalSessionState=true&cachePrepStmts=true&cacheCallableStmts=true&alwaysSendSetIsolation=false&prepStmtCacheSize=1024&cacheServerConfiguration=true&prepStmtCacheSqlLimit=2048&zeroDateTimeBehavior=convertToNull&traceProtocol=false&useUnbufferedInput=false&useReadAheadInput=true&maintainTimeStats=false&useServerPrepStmts&cacheRSMetadata=true&poolPreparedStatements=true&maxOpenPreparedStatements=100"
+		setUrl = "jdbc:mysql://127.0.0.1:3306/hello_world?jdbcCompliantTruncation=false&elideSetAutoCommits=false&dontTrackOpenResources=true&enableQueryTimeouts=false&useLocalSessionState=false&cachePrepStmts=true&cacheCallableStmts=true&alwaysSendSetIsolation=false&prepStmtCacheSize=1024&cacheServerConfiguration=true&prepStmtCacheSqlLimit=2048&zeroDateTimeBehavior=convertToNull&traceProtocol=false&useUnbufferedInput=false&useReadAheadInput=true&maintainTimeStats=false&useServerPrepStmts&cacheRSMetadata=true&poolPreparedStatements=true"
 		setUser = "benchmarkdbuser"
 		setPassword = "benchmarkdbpass"
 	}	
-	min-pool-size = 0
-	max-pool-size = 64
+	min-pool-size = 8
+	max-pool-size = 128
 }
 

plain/src/main/scala/com/ibm/techempower/Db.scala

@@ -6,6 +6,7 @@ import scala.language.implicitConversions
 import scala.language.postfixOps
 import scala.collection.mutable.MutableList
 
+import com.ibm.plain.ignore
 import com.ibm.plain.rest.{ Form, Resource }
 import com.ibm.plain.json.{ Json => J }
 import com.ibm.plain.jdbc.withConnection
@@ -37,7 +38,7 @@ sealed abstract class DbResource
     val output = new MutableList[J]
     val q = form match { case None => 1 case Some(f) => queries(f) }
     withConnection(datasource) { implicit connection =>
-      for (i <- 1 to q) { for (j <- selectsql << next <<! asJson) { output += j } }
+      for (i <- 1 to q) { for (j <- selectsql << next ! asJson) { output += j } }
     }
     form match { case None => output.head case _ => J(output.toList) }
   }
@@ -47,13 +48,14 @@ sealed abstract class DbResource
     val output = new MutableList[J]
     val q = queries(form)
     withConnection(datasource) { implicit connection =>
-      for (i <- 1 to q) { for (j <- selectsql << next <<! asTuple) { input += j } }
+      for (i <- 1 to q) { for (j <- selectsql << next ! asTuple) { input += j } }
       input.foreach {
         case (id, _) =>
           val randomNumber = next
-          updatesql << randomNumber << id <<!!;
+          updatesql << randomNumber << id ++;
           output += asJson(id, randomNumber)
       }
+      ignore(updatesql ++!)
     }
     J(output.toList)
   }
@@ -68,11 +70,11 @@ sealed abstract class DbResource
     case _: Throwable => 1
   }
 
-  @inline private[this] final def asJson = (r: RichResultSet) => J(Map("id" -> r.nextInt.get, "randomNumber" -> r.nextInt.get))
+  @inline private[this] final def asJson = (r: RichResultSet) => J(Map("id" -> r.nextInt, "randomNumber" -> r.nextInt))
 
   @inline private[this] final def asJson(id: Int, randomNumber: Int) = J(Map("id" -> id, "randomNumber" -> randomNumber))
 
-  @inline private[this] final def asTuple = (r: RichResultSet) => (r.nextInt.get, r.nextInt.get)
+  @inline private[this] final def asTuple = (r: RichResultSet) => (r.nextInt, r.nextInt)
 
   @inline private[this] final def next = random.nextInt(1, 10001)
 

plain/src/main/scala/com/ibm/techempower/Fortunes.scala

@@ -4,7 +4,7 @@ import scala.collection.mutable.ListBuffer
 import scala.language.implicitConversions
 import scala.xml._
 
-import com.ibm.plain.rest.Resource
+import com.ibm.plain.rest.{ Resource, Html }
 import com.ibm.plain.jdbc.withConnection
 import com.ibm.plain.jdbc.ConnectionHelper._
 
@@ -14,18 +14,18 @@ final class Fortunes
 
   Get {
     val list = new ListBuffer[(Int, String)]
-    withConnection(datasource) { implicit c => for (row <- sql <<! asRow) { list += row } }
+    withConnection(datasource) { implicit c => for (row <- sql ! asRow) { list += row } }
     list += ((0, "Additional fortune added at request time."))
-    html(rows(list.sortBy(_._2))).toString
+    html(rows(list.sortBy(_._2)))
   }
 
-  @inline private[this] final def asRow = (r: RichResultSet) => (r.nextInt.get, r.nextString.get)
+  @inline private[this] final def asRow = (r: RichResultSet) => (r.nextInt, r.nextString)
 
   @inline private[this] final def rows(list: ListBuffer[(Int, String)]) = list.map { e => row(e._1, e._2) }
 
   @inline private[this] final def row(id: Int, message: String) = <tr><td>{ id }</td><td>{ message }</td></tr>
 
-  @inline private[this] final def html(rows: ListBuffer[Elem]) =
+  @inline private[this] final def html(rows: ListBuffer[Elem]): Html =
     <html>
       <head><title>Fortunes</title></head>
       <body>  <table>

rack/Gemfile-jruby

@@ -1,8 +1,6 @@
 source 'http://rubygems.org'
 
-gem 'jruby-rack', '1.2.0.SNAPSHOT'
-gem 'warbler', '1.3.6'
-gem 'jruby-jars', '1.7.4'
+gem 'torqbox', '0.1.2'
 gem 'json', '1.7.6'
 gem "rubyzip", "~> 1.0.0"
 gem "zip-zip", "~> 0.1"

rack/README.md

@@ -10,14 +10,13 @@ This is the Ruby Rack portion of a [benchmarking test suite](../) comparing a va
 The tests were run with:
 
 * [Ruby 2.0.0-p0](http://www.ruby-lang.org/)
-* [JRuby 1.7.4](http://jruby.org/)
+* [JRuby 1.7.8](http://jruby.org/)
 * [Rack 1.5.1](http://rack.github.com/)
 * [Unicorn 4.6.2](http://unicorn.bogomips.org/)
-* [Resin 4.0.34](http://www.caucho.com/)
+* [TorqBox 0.1.2](http://torquebox.org/torqbox/)
 
 ## References
 * https://github.com/FooBarWidget/passenger/pull/71
-* https://github.com/jruby/jruby-rack/issues/146
 
 ## Test URLs
 ### JSON Encoding Test
@@ -26,5 +25,5 @@ Ruby:
 localhost:8080
 
 JRuby:
-localhost:8080/rack/
+localhost:8080
 

rack/benchmark_config

@@ -22,8 +22,8 @@
     },
     "jruby": {
       "setup_file": "setup_jruby",
-      "json_url": "/rack/json",
-      "plaintext_url": "/rack/plaintext",
+      "json_url": "/json",
+      "plaintext_url": "/plaintext",
       "port": 8080,
       "approach": "Realistic",
       "classification": "Platform",
@@ -32,7 +32,7 @@
       "language": "Ruby",
       "orm": "Full",
       "platform": "JRuby",
-      "webserver": "Resin",
+      "webserver": "TorqBox",
       "os": "Linux",
       "database_os": "Linux",
       "display_name": "rack",

rack/config/warble.rb

@@ -1,151 +0,0 @@
-# Disable Rake-environment-task framework detection by uncommenting/setting to false
-# Warbler.framework_detection = false
-
-# Warbler web application assembly configuration file
-Warbler::Config.new do |config|
-  # Features: additional options controlling how the jar is built.
-  # Currently the following features are supported:
-  # - gemjar: package the gem repository in a jar file in WEB-INF/lib
-  # - executable: embed a web server and make the war executable
-  # - compiled: compile .rb files to .class files
-  # config.features = %w(gemjar)
-
-  # Application directories to be included in the webapp.
-  config.dirs = %w(app config lib log vendor tmp)
-
-  # Additional files/directories to include, above those in config.dirs
-  # config.includes = FileList["db"]
-
-  # Additional files/directories to exclude
-  # config.excludes = FileList["lib/tasks/*"]
-
-  # Additional Java .jar files to include.  Note that if .jar files are placed
-  # in lib (and not otherwise excluded) then they need not be mentioned here.
-  # JRuby and JRuby-Rack are pre-loaded in this list.  Be sure to include your
-  # own versions if you directly set the value
-  # config.java_libs += FileList["lib/java/*.jar"]
-
-  # Loose Java classes and miscellaneous files to be included.
-  # config.java_classes = FileList["target/classes/**.*"]
-
-  # One or more pathmaps defining how the java classes should be copied into
-  # the archive. The example pathmap below accompanies the java_classes
-  # configuration above. See http://rake.rubyforge.org/classes/String.html#M000017
-  # for details of how to specify a pathmap.
-  # config.pathmaps.java_classes << "%{target/classes/,}p"
-
-  # Bundler support is built-in. If Warbler finds a Gemfile in the
-  # project directory, it will be used to collect the gems to bundle
-  # in your application. If you wish to explicitly disable this
-  # functionality, uncomment here.
-  # config.bundler = false
-
-  # An array of Bundler groups to avoid including in the war file.
-  # Defaults to ["development", "test"].
-  # config.bundle_without = []
-
-  # Other gems to be included. If you don't use Bundler or a gemspec
-  # file, you need to tell Warbler which gems your application needs
-  # so that they can be packaged in the archive.
-  # For Rails applications, the Rails gems are included by default
-  # unless the vendor/rails directory is present.
-  # config.gems += ["activerecord-jdbcmysql-adapter", "jruby-openssl"]
-  # config.gems << "tzinfo"
-
-  # Uncomment this if you don't want to package rails gem.
-  # config.gems -= ["rails"]
-
-  # The most recent versions of gems are used.
-  # You can specify versions of gems by using a hash assignment:
-  # config.gems["rails"] = "2.3.10"
-  
-  # You can also use regexps or Gem::Dependency objects for flexibility or
-  # finer-grained control.
-  # config.gems << /^merb-/
-  # config.gems << Gem::Dependency.new("merb-core", "= 0.9.3")
-
-  # Include gem dependencies not mentioned specifically. Default is
-  # true, uncomment to turn off.
-  # config.gem_dependencies = false
-
-  # Array of regular expressions matching relative paths in gems to be
-  # excluded from the war. Defaults to empty, but you can set it like
-  # below, which excludes test files.
-  # config.gem_excludes = [/^(test|spec)\//]
-
-  # Pathmaps for controlling how application files are copied into the archive
-  # config.pathmaps.application = ["WEB-INF/%p"]
-
-  # Name of the archive (without the extension). Defaults to the basename
-  # of the project directory.
-  # config.jar_name = "mywar"
-
-  # Name of the MANIFEST.MF template for the war file. Defaults to a simple
-  # MANIFEST.MF that contains the version of Warbler used to create the war file.
-  # config.manifest_file = "config/MANIFEST.MF"
-
-  # When using the 'compiled' feature and specified, only these Ruby
-  # files will be compiled. Default is to compile all \.rb files in
-  # the application.
-  # config.compiled_ruby_files = FileList['app/**/*.rb']
-
-  # === War files only below here ===
-
-  # Path to the pre-bundled gem directory inside the war file. Default
-  # is 'WEB-INF/gems'. Specify path if gems are already bundled
-  # before running Warbler. This also sets 'gem.path' inside web.xml.
-  # config.gem_path = "WEB-INF/vendor/bundler_gems"
-
-  # Files for WEB-INF directory (next to web.xml). This contains
-  # web.xml by default. If there is an .erb-File it will be processed
-  # with webxml-config. You may want to exclude this file via
-  # config.excludes.
-  # config.webinf_files += FileList["jboss-web.xml"]
-
-  # Files to be included in the root of the webapp.  Note that files in public
-  # will have the leading 'public/' part of the path stripped during staging.
-  # config.public_html = FileList["public/**/*", "doc/**/*"]
-
-  # Pathmaps for controlling how public HTML files are copied into the .war
-  # config.pathmaps.public_html = ["%{public/,}p"]
-
-  # Embedded webserver to use with the 'executable' feature. Currently supported
-  # webservers are:
-  # * <tt>winstone</tt> (default) - Winstone 0.9.10 from sourceforge
-  # * <tt>jenkins-ci.winstone</tt> - Improved Winstone from Jenkins CI
-  # * <tt>jetty</tt> - Embedded Jetty from Eclipse
-  # config.webserver = 'jetty'
-
-# Value of RAILS_ENV for the webapp -- default as shown below
-  # config.webxml.rails.env = ENV['RAILS_ENV'] || 'production'
-
-  # Application booter to use, one of :rack, :rails, or :merb (autodetected by default)
-  # config.webxml.booter = :rails
-
-  # Set JRuby to run in 1.9 mode.
-  config.webxml.jruby.compat.version = "1.9"
-
-  # When using the :rack booter, "Rackup" script to use.
-  # - For 'rackup.path', the value points to the location of the rackup
-  # script in the web archive file. You need to make sure this file
-  # gets included in the war, possibly by adding it to config.includes
-  # or config.webinf_files above.
-  # - For 'rackup', the rackup script you provide as an inline string
-  #   is simply embedded in web.xml.
-  # The script is evaluated in a Rack::Builder to load the application.
-  # Examples:
-  # config.webxml.rackup.path = 'WEB-INF/hello.ru'
-  # config.webxml.rackup = %{require './lib/demo'; run Rack::Adapter::Camping.new(Demo)}
-  # config.webxml.rackup = require 'cgi' && CGI::escapeHTML(File.read("config.ru"))
-
-  # Control the pool of Rails runtimes. Leaving unspecified means
-  # the pool will grow as needed to service requests. It is recommended
-  # that you fix these values when running a production server!
-  # If you're using threadsafe! mode, you probably don't want to set these values,
-  # since 1 runtime(default for threadsafe mode) will be enough.
-  # config.webxml.jruby.min.runtimes = 2
-  # config.webxml.jruby.max.runtimes = 4
-
-  # JNDI data source name
-  # config.webxml.jndi = 'jdbc/rails'
-end

rack/setup_jruby.py

@@ -2,23 +2,26 @@
 import subprocess
 import sys
 import re
+import os
 
 def start(args, logfile, errfile):
 
   try:
-    subprocess.check_call("rvm jruby-1.7.4 do bundle install --gemfile=Gemfile-jruby", shell=True, cwd="rack", stderr=errfile, stdout=logfile)
+    subprocess.check_call("rvm jruby-1.7.8 do bundle install --gemfile=Gemfile-jruby", shell=True, cwd="rack", stderr=errfile, stdout=logfile)
     subprocess.check_call("cp Gemfile-jruby Gemfile", shell=True, cwd="rack", stderr=errfile, stdout=logfile)
     subprocess.check_call("cp Gemfile-jruby.lock Gemfile.lock", shell=True, cwd="rack", stderr=errfile, stdout=logfile)
-    subprocess.check_call("rvm jruby-1.7.4 do warble war", shell=True, cwd="rack", stderr=errfile, stdout=logfile)
-    subprocess.check_call("rm -rf $RESIN_HOME/webapps/*", shell=True, stderr=errfile, stdout=logfile)
-    subprocess.check_call("cp rack.war $RESIN_HOME/webapps/rack.war", shell=True, cwd="rack", stderr=errfile, stdout=logfile)
-    subprocess.check_call("$RESIN_HOME/bin/resinctl start", shell=True, stderr=errfile, stdout=logfile)
+    subprocess.Popen("rvm jruby-1.7.8 do bundle exec torqbox -b 0.0.0.0 -E production", shell=True, cwd="rack", stderr=errfile, stdout=logfile)
     return 0
   except subprocess.CalledProcessError:
     return 1
 def stop(logfile, errfile):
   try:
-    subprocess.check_call("$RESIN_HOME/bin/resinctl shutdown", shell=True, stderr=errfile, stdout=logfile)
+    p = subprocess.Popen(['ps', 'aux'], stdout=subprocess.PIPE)
+    out, err = p.communicate()
+    for line in out.splitlines():
+      if 'torqbox' in line:
+        pid = int(line.split(None, 2)[1])
+        os.kill(pid, 9)
     subprocess.check_call("rm Gemfile", shell=True, cwd="rack", stderr=errfile, stdout=logfile)
     subprocess.check_call("rm Gemfile.lock", shell=True, cwd="rack", stderr=errfile, stdout=logfile)
     return 0

rack/source_code

@@ -1,4 +1,3 @@
 ./rack/config/unicorn.rb
-./rack/config/warble.rb
 ./rack/setup_jruby.py
 ./rack/setup_ruby.py

rails-stripped/Gemfile-jruby

@@ -1,10 +1,7 @@
 source 'https://rubygems.org'
 
-gem 'jruby-openssl', '0.8.5'
 gem 'rails', '3.2.13'
-gem 'jruby-rack', '1.2.0.SNAPSHOT'
-gem 'warbler', '1.3.6'
-gem 'jruby-jars', '1.7.4'
+gem 'torqbox', '0.1.2'
 gem 'activerecord-jdbcmysql-adapter', '1.2.6'
 gem "rubyzip", "~> 1.0.0"
 gem "zip-zip", "~> 0.1"

rails-stripped/README.md

@@ -13,15 +13,14 @@ This is the Ruby on Rails portion of a [benchmarking test suite](../) comparing
 ## Infrastructure Software Versions
 The tests were run with:
 * [Ruby 2.0.0-p0](http://www.ruby-lang.org/)
-* [JRuby 1.7.4](http://jruby.org/)
+* [JRuby 1.7.8](http://jruby.org/)
 * [Rails 3.2.11](http://rubyonrails.org/)
 * [Unicorn 4.6.2](http://unicorn.bogomips.org/)
-* [Resin 4.0.34](http://www.caucho.com/)
+* [TorqBox 0.1.2](http://torquebox.org/torqbox/)
 * [MySQL 5.5.29](https://dev.mysql.com/)
 
 ## References
 * https://github.com/FooBarWidget/passenger/pull/71
-* https://github.com/jruby/jruby-rack/issues/146
 
 ## Test URLs
 ### JSON Encoding Test
@@ -30,7 +29,7 @@ Ruby:
 localhost:8080/hello_world/json
 
 JRuby:
-localhost:8080/rails/hello_world/json
+localhost:8080/hello_world/json
 
 ### Data-Store/Database Mapping Test
 
@@ -38,4 +37,4 @@ Ruby:
 localhost:8080/hello_world/db?queries=5
 
 JRuby:
-localhost:8080/rails/hello_world/db?queries=5
+localhost:8080/hello_world/db?queries=5

rails-stripped/benchmark_config

@@ -23,9 +23,9 @@
     },
     "jruby": {
       "setup_file": "setup_jruby",
-      "json_url": "/rails/hello_world/json",
-      "db_url": "/rails/hello_world/db",
-      "query_url": "/rails/hello_world/db?queries=",
+      "json_url": "/hello_world/json",
+      "db_url": "/hello_world/db",
+      "query_url": "/hello_world/db?queries=",
       "port": 8080,
       "approach": "Stripped",
       "classification": "Fullstack",
@@ -34,7 +34,7 @@
       "language": "Ruby",
       "orm": "Full",
       "platform": "JRuby",
-      "webserver": "Resin",
+      "webserver": "TorqBox",
       "os": "Linux",
       "database_os": "Linux",
       "display_name": "rails",

rails-stripped/config/warble.rb

@@ -1,151 +0,0 @@
-# Disable Rake-environment-task framework detection by uncommenting/setting to false
-# Warbler.framework_detection = false
-
-# Warbler web application assembly configuration file
-Warbler::Config.new do |config|
-  # Features: additional options controlling how the jar is built.
-  # Currently the following features are supported:
-  # - gemjar: package the gem repository in a jar file in WEB-INF/lib
-  # - executable: embed a web server and make the war executable
-  # - compiled: compile .rb files to .class files
-  # config.features = %w(gemjar)
-
-  # Application directories to be included in the webapp.
-  config.dirs = %w(app config lib log vendor tmp views)
-
-  # Additional files/directories to include, above those in config.dirs
-  # config.includes = FileList["hello_world.rb"]
-
-  # Additional files/directories to exclude
-  # config.excludes = FileList["lib/tasks/*"]
-
-  # Additional Java .jar files to include.  Note that if .jar files are placed
-  # in lib (and not otherwise excluded) then they need not be mentioned here.
-  # JRuby and JRuby-Rack are pre-loaded in this list.  Be sure to include your
-  # own versions if you directly set the value
-  # config.java_libs += FileList["lib/java/*.jar"]
-
-  # Loose Java classes and miscellaneous files to be included.
-  # config.java_classes = FileList["target/classes/**.*"]
-
-  # One or more pathmaps defining how the java classes should be copied into
-  # the archive. The example pathmap below accompanies the java_classes
-  # configuration above. See http://rake.rubyforge.org/classes/String.html#M000017
-  # for details of how to specify a pathmap.
-  # config.pathmaps.java_classes << "%{target/classes/,}p"
-
-  # Bundler support is built-in. If Warbler finds a Gemfile in the
-  # project directory, it will be used to collect the gems to bundle
-  # in your application. If you wish to explicitly disable this
-  # functionality, uncomment here.
-  # config.bundler = false
-
-  # An array of Bundler groups to avoid including in the war file.
-  # Defaults to ["development", "test"].
-  # config.bundle_without = []
-
-  # Other gems to be included. If you don't use Bundler or a gemspec
-  # file, you need to tell Warbler which gems your application needs
-  # so that they can be packaged in the archive.
-  # For Rails applications, the Rails gems are included by default
-  # unless the vendor/rails directory is present.
-  # config.gems += ["activerecord-jdbcmysql-adapter", "jruby-openssl"]
-  # config.gems << "tzinfo"
-
-  # Uncomment this if you don't want to package rails gem.
-  # config.gems -= ["rails"]
-
-  # The most recent versions of gems are used.
-  # You can specify versions of gems by using a hash assignment:
-  # config.gems["rails"] = "2.3.10"
-
-  # You can also use regexps or Gem::Dependency objects for flexibility or
-  # finer-grained control.
-  # config.gems << /^merb-/
-  # config.gems << Gem::Dependency.new("merb-core", "= 0.9.3")
-
-  # Include gem dependencies not mentioned specifically. Default is
-  # true, uncomment to turn off.
-  # config.gem_dependencies = false
-
-  # Array of regular expressions matching relative paths in gems to be
-  # excluded from the war. Defaults to empty, but you can set it like
-  # below, which excludes test files.
-  # config.gem_excludes = [/^(test|spec)\//]
-
-  # Pathmaps for controlling how application files are copied into the archive
-  # config.pathmaps.application = ["WEB-INF/%p"]
-
-  # Name of the archive (without the extension). Defaults to the basename
-  # of the project directory.
-  # config.jar_name = "mywar"
-
-  # Name of the MANIFEST.MF template for the war file. Defaults to a simple
-  # MANIFEST.MF that contains the version of Warbler used to create the war file.
-  # config.manifest_file = "config/MANIFEST.MF"
-
-  # When using the 'compiled' feature and specified, only these Ruby
-  # files will be compiled. Default is to compile all \.rb files in
-  # the application.
-  # config.compiled_ruby_files = FileList['app/**/*.rb']
-
-  # === War files only below here ===
-
-  # Path to the pre-bundled gem directory inside the war file. Default
-  # is 'WEB-INF/gems'. Specify path if gems are already bundled
-  # before running Warbler. This also sets 'gem.path' inside web.xml.
-  # config.gem_path = "WEB-INF/vendor/bundler_gems"
-
-  # Files for WEB-INF directory (next to web.xml). This contains
-  # web.xml by default. If there is an .erb-File it will be processed
-  # with webxml-config. You may want to exclude this file via
-  # config.excludes.
-  config.webinf_files += FileList["resin-web.xml"]
-
-  # Files to be included in the root of the webapp.  Note that files in public
-  # will have the leading 'public/' part of the path stripped during staging.
-  # config.public_html = FileList["public/**/*", "doc/**/*"]
-
-  # Pathmaps for controlling how public HTML files are copied into the .war
-  # config.pathmaps.public_html = ["%{public/,}p"]
-
-  # Embedded webserver to use with the 'executable' feature. Currently supported
-  # webservers are:
-  # * <tt>winstone</tt> (default) - Winstone 0.9.10 from sourceforge
-  # * <tt>jenkins-ci.winstone</tt> - Improved Winstone from Jenkins CI
-  # * <tt>jetty</tt> - Embedded Jetty from Eclipse
-  # config.webserver = 'jetty'
-
-  # Value of RAILS_ENV for the webapp -- default as shown below
-  # config.webxml.rails.env = ENV['RAILS_ENV'] || 'production'
-
-  # Application booter to use, one of :rack, :rails, or :merb (autodetected by default)
-  # config.webxml.booter = :rails
-
-  # Set JRuby to run in 1.9 mode.
-  # config.webxml.jruby.compat.version = "1.9"
-
-  # When using the :rack booter, "Rackup" script to use.
-  # - For 'rackup.path', the value points to the location of the rackup
-  # script in the web archive file. You need to make sure this file
-  # gets included in the war, possibly by adding it to config.includes
-  # or config.webinf_files above.
-  # - For 'rackup', the rackup script you provide as an inline string
-  #   is simply embedded in web.xml.
-  # The script is evaluated in a Rack::Builder to load the application.
-  # Examples:
-  # config.webxml.rackup.path = 'WEB-INF/hello.ru'
-  # config.webxml.rackup = %{require './lib/demo'; run Rack::Adapter::Camping.new(Demo)}
-  # config.webxml.rackup = require 'cgi' && CGI::escapeHTML(File.read("config.ru"))
-
-  # Control the pool of Rails runtimes. Leaving unspecified means
-  # the pool will grow as needed to service requests. It is recommended
-  # that you fix these values when running a production server!
-  # If you're using threadsafe! mode, you probably don't want to set these values,
-  # since 1 runtime(default for threadsafe mode) will be enough.
-  # config.webxml.jruby.min.runtimes = 24
-  # config.webxml.jruby.max.runtimes = 24
-
-  # JNDI data source name
-  # config.webxml.jndi = 'jdbc/rails'
-end