Mercurial > urweb
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