changeset 384:2a7e7bd7b29f

Building combined demo app
author Adam Chlipala <adamc@hcoop.net>
date Sun, 19 Oct 2008 15:19:41 -0400
parents 49c95753bf3b
children 1195f6e4d208
files .hgignore src/demo.sml src/main.mlton.sml
diffstat 3 files changed, 96 insertions(+), 38 deletions(-) [+]
line wrap: on
line diff
--- a/.hgignore	Sun Oct 19 14:53:38 2008 -0400
+++ b/.hgignore	Sun Oct 19 15:19:41 2008 -0400
@@ -23,3 +23,4 @@
 *.status
 
 demo/out/*.html
+demo/demo.*
--- a/src/demo.sml	Sun Oct 19 14:53:38 2008 -0400
+++ b/src/demo.sml	Sun Oct 19 15:19:41 2008 -0400
@@ -33,9 +33,6 @@
                                          file = "prose"}
         val inf = TextIO.openIn prose
 
-        val demo_urp = OS.Path.joinDirFile {dir = dirname,
-                                            file = "demo.urp"}
-
         val outDir = OS.Path.concat (dirname, "out")
 
         val () = if OS.FileSys.access (outDir, []) then
@@ -60,6 +57,17 @@
         val () = (TextIO.output (demosOut, "<html><body>\n\n");
                   TextIO.output (demosOut, "<li> <a target=\"staging\" href=\"intro.html\">Intro</a></li>\n\n"))
 
+        val fname = OS.Path.joinDirFile {dir = dirname,
+                                         file = "demo.urs"}
+        val ursOut = TextIO.openOut fname
+        val () = (TextIO.output (ursOut, "val main : unit -> transaction page\n");
+                  TextIO.closeOut ursOut)
+
+        val fname = OS.Path.joinDirFile {dir = dirname,
+                                         file = "demo.ur"}
+        val urOut = TextIO.openOut fname
+        val () = TextIO.output (urOut, "fun main () = return <xml><body>\n")
+
         fun mergeWith f (o1, o2) =
             case (o1, o2) of
                 (NONE, _) => o2
@@ -103,6 +111,12 @@
                           TextIO.output (demosOut, name);
                           TextIO.output (demosOut, "</a></li>\n"))
 
+                val () = (TextIO.output (urOut, "  <li> <a link={");
+                          TextIO.output (urOut, name);
+                          TextIO.output (urOut, ".main ()}>");
+                          TextIO.output (urOut, name);
+                          TextIO.output (urOut, "</a></li>\n"))
+
                 val urp_file = OS.Path.joinDirFile {dir = dirname,
                                                     file = urp}
 
@@ -185,7 +199,8 @@
 
                 fun readUrp' () =
                     case TextIO.inputLine inf of
-                        NONE => finished ()
+                        NONE => (finished ();
+                                 combined)
                       | SOME line =>
                         if String.isSuffix ".urp\n" line then
                             let
@@ -216,7 +231,8 @@
                                    TextIO.closeOut out)
             in
                 case TextIO.inputLine inf of
-                    NONE => finished ()
+                    NONE => (finished ();
+                             NONE)
                   | SOME line =>
                     if String.isSuffix ".urp\n" line then
                         let
@@ -225,8 +241,8 @@
                         in
                             finished ();
                             
-                            readUrp (urpData,
-                                     out)
+                            SOME (readUrp (urpData,
+                                           out))
                         end
                     else
                         (TextIO.output (out, line);
@@ -274,36 +290,71 @@
                                              ignore (OS.Process.system cmd)
                                          end)
                         in
-                            case OS.Path.ext file of
-                                SOME "urp" =>
-                                doit (fn (src, html) =>
-                                         let
-                                             val inf = TextIO.openIn src
-                                             val out = TextIO.openOut html
+                            if OS.Path.base file = "demo" then
+                                ()
+                            else case OS.Path.ext file of
+                                     SOME "urp" =>
+                                     doit (fn (src, html) =>
+                                              let
+                                                  val inf = TextIO.openIn src
+                                                  val out = TextIO.openOut html
 
-                                             fun loop () =
-                                                 case TextIO.inputLine inf of
-                                                     NONE => ()
-                                                   | SOME line => (TextIO.output (out, line);
-                                                                   loop ())
-                                         in
-                                             TextIO.output (out, "<html><body>\n\n<pre>");
-                                             loop ();
-                                             TextIO.output (out, "</pre>\n\n</body></html>");
+                                                  fun loop () =
+                                                      case TextIO.inputLine inf of
+                                                          NONE => ()
+                                                        | SOME line => (TextIO.output (out, line);
+                                                                        loop ())
+                                              in
+                                                  TextIO.output (out, "<html><body>\n\n<pre>");
+                                                  loop ();
+                                                  TextIO.output (out, "</pre>\n\n</body></html>");
 
-                                             TextIO.closeIn inf;
-                                             TextIO.closeOut out
-                                         end)
-                              | SOME "urs" => highlight ()
-                              | SOME "ur" => highlight ()
-                              | _ => ();
+                                                  TextIO.closeIn inf;
+                                                  TextIO.closeOut out
+                                              end)
+                                   | SOME "urs" => highlight ()
+                                   | SOME "ur" => highlight ()
+                                   | _ => ();
                             loop ()
                         end
             in
                 loop ()
             end
     in
-        readIndex ();
+        case readIndex () of
+            NONE => raise Fail "No demo applications!"
+          | SOME combined =>
+            let
+                val () = (TextIO.output (urOut, "</body></xml>\n");
+                          TextIO.closeOut urOut)
+
+                val fname = OS.Path.joinDirFile {dir = dirname,
+                                                 file = "demo.urp"}
+                val outf = TextIO.openOut fname
+            in
+                Option.app (fn db => (TextIO.output (outf, "database ");
+                                      TextIO.output (outf, db);
+                                      TextIO.output (outf, "\n")))
+                           (#database combined);
+                TextIO.output (outf, "sql demo.sql\n");
+                TextIO.output (outf, "\n");
+
+                app (fn s =>
+                        let
+                            val s = OS.Path.mkAbsolute {relativeTo = OS.FileSys.getDir (),
+                                                        path = s}
+                        in
+                            TextIO.output (outf, s);
+                            TextIO.output (outf, "\n")
+                        end)
+                    (#sources combined);
+                TextIO.output (outf, "\n");
+                TextIO.output (outf, "demo\n");
+
+                TextIO.closeOut outf;
+
+                Compiler.compile (OS.Path.base fname)
+            end;
 
         TextIO.output (demosOut, "\n</body></html>\n");
         TextIO.closeOut demosOut;
--- a/src/main.mlton.sml	Sun Oct 19 14:53:38 2008 -0400
+++ b/src/main.mlton.sml	Sun Oct 19 15:19:41 2008 -0400
@@ -25,23 +25,25 @@
  * POSSIBILITY OF SUCH DAMAGE.
  *)
 
-fun doArgs (args, (timing, sources)) =
+fun doArgs (args, (timing, demo, sources)) =
     case args of
-        [] => (timing, rev sources)
+        [] => (timing, demo, rev sources)
+      | "-demo" :: prefix :: rest =>
+        doArgs (rest, (timing, SOME prefix, sources))
       | arg :: rest =>
         let
             val acc =
                 if size arg > 0 andalso String.sub (arg, 0) = #"-" then
                     case arg of
-                        "-timing" => (true, sources)
+                        "-timing" => (true, demo, sources)
                       | _ => raise Fail ("Unknown option " ^ arg)
                 else
-                    (timing, arg :: sources)
+                    (timing, demo, arg :: sources)
         in
             doArgs (rest, acc)
         end
 
-val (timing, sources) = doArgs (CommandLine.arguments (), (false, []))
+val (timing, demo, sources) = doArgs (CommandLine.arguments (), (false, NONE, []))
 
 val job =
     case sources of
@@ -49,7 +51,11 @@
       | _ => raise Fail "Zero or multiple job files specified"
 
 val () =
-    if timing then
-        Compiler.time Compiler.toCjrize job
-    else
-        Compiler.compile job
+    case demo of
+        SOME prefix =>
+        Demo.make {prefix = prefix, dirname = job}
+      | NONE =>
+        if timing then
+            Compiler.time Compiler.toCjrize job
+        else
+            Compiler.compile job