summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2008-10-19 15:19:41 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2008-10-19 15:19:41 -0400
commit0a1e81c5811d640c00d5b5984d2254e0d8521743 (patch)
tree7af5a35748f3b5dca4efc5eced2e1a842b719a30 /src
parent6b4491e84c22056a9d97c34abc9c3561108f2497 (diff)
Building combined demo app
Diffstat (limited to 'src')
-rw-r--r--src/demo.sml113
-rw-r--r--src/main.mlton.sml24
2 files changed, 97 insertions, 40 deletions
diff --git a/src/demo.sml b/src/demo.sml
index 015090e0..5bb11fa5 100644
--- a/src/demo.sml
+++ b/src/demo.sml
@@ -33,9 +33,6 @@ fun make {prefix, dirname} =
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 @@ fun make {prefix, dirname} =
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 @@ fun make {prefix, dirname} =
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 make {prefix, dirname} =
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 @@ fun make {prefix, dirname} =
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 @@ fun make {prefix, dirname} =
in
finished ();
- readUrp (urpData,
- out)
+ SOME (readUrp (urpData,
+ out))
end
else
(TextIO.output (out, line);
@@ -274,36 +290,71 @@ fun make {prefix, dirname} =
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
-
- 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 ()
- | _ => ();
+ 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>");
+
+ 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;
diff --git a/src/main.mlton.sml b/src/main.mlton.sml
index 94d0f2ac..eb92e39d 100644
--- a/src/main.mlton.sml
+++ b/src/main.mlton.sml
@@ -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 @@ val job =
| _ => 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