Mercurial > urweb
view src/demo.sml @ 381:1fe85b58c9ba
Generating urp HTML
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Sun, 19 Oct 2008 14:13:08 -0400 |
| parents | 758304561b60 |
| children | aa2edbd47041 |
line wrap: on
line source
(* Copyright (c) 2008, 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. *) structure Demo :> DEMO = struct fun make {prefix, dirname} = let val prose = OS.Path.joinDirFile {dir = 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 () else OS.FileSys.mkDir outDir val fname = OS.Path.joinDirFile {dir = outDir, file = "index.html"} val out = TextIO.openOut fname val () = (TextIO.output (out, "<frameset cols=\"10%,90%\">\n"); TextIO.output (out, "<frame src=\"demos.html\">\n"); TextIO.output (out, "<frame src=\"intro.html\" name=\"staging\">\n"); TextIO.output (out, "</frameset>\n"); TextIO.closeOut out) val fname = OS.Path.joinDirFile {dir = outDir, file = "demos.html"} val demosOut = TextIO.openOut fname val () = (TextIO.output (demosOut, "<html><body>\n\n"); TextIO.output (demosOut, "<li> <a target=\"staging\" href=\"intro.html\">Intro</a></li>\n\n")) fun mergeWith f (o1, o2) = case (o1, o2) of (NONE, _) => o2 | (_, NONE) => o1 | (SOME v1, SOME v2) => SOME (f (v1, v2)) fun combiner (combined : Compiler.job, urp : Compiler.job) = { database = mergeWith (fn (v1, v2) => if v1 = v2 then v1 else raise Fail "Different demos want to use different database strings") (#database combined, #database urp), sources = foldl (fn (file, files) => if List.exists (fn x => x = file) files then files else files @ [file]) (#sources combined) (#sources urp), exe = OS.Path.joinDirFile {dir = dirname, file = "demo.exe"}, sql = SOME (OS.Path.joinDirFile {dir = dirname, file = "demo.sql"}), debug = false } val parse = Compiler.run (Compiler.transform Compiler.parseUrp "Demo parseUrp") fun capitalize "" = "" | capitalize s = str (Char.toUpper (String.sub (s, 0))) ^ String.extract (s, 1, NONE) fun startUrp urp = let val base = OS.Path.base urp val name = capitalize base val () = (TextIO.output (demosOut, "<li> <a target=\"staging\" href=\""); TextIO.output (demosOut, base); TextIO.output (demosOut, ".html\">"); TextIO.output (demosOut, name); TextIO.output (demosOut, "</a></li>\n")) val urp_file = OS.Path.joinDirFile {dir = dirname, file = urp} val out = OS.Path.joinBaseExt {base = base, ext = SOME "html"} val out = OS.Path.joinDirFile {dir = outDir, file = out} val out = TextIO.openOut out val () = (TextIO.output (out, "<frameset rows=\"75%,25%\">\n"); TextIO.output (out, "<frame src=\""); TextIO.output (out, prefix); TextIO.output (out, "/"); TextIO.output (out, name); TextIO.output (out, "/main\" name=\"showcase\">\n"); TextIO.output (out, "<frame src=\""); TextIO.output (out, base); TextIO.output (out, ".desc.html\">\n"); TextIO.output (out, "</frameset>\n"); TextIO.closeOut out) val () = TextIO.closeOut out val out = OS.Path.joinBaseExt {base = base, ext = SOME "desc"} val out = OS.Path.joinBaseExt {base = out, ext = SOME "html"} val out = TextIO.openOut (OS.Path.joinDirFile {dir = outDir, file = out}) in case parse (OS.Path.base urp_file) of NONE => raise Fail ("Can't parse " ^ urp_file) | SOME urpData => (TextIO.output (out, "<html><head>\n<title>"); TextIO.output (out, name); TextIO.output (out, "</title>\n</head><body>\n\n<h1>"); TextIO.output (out, name); TextIO.output (out, "</h1>\n\n<center>[ <a target=\"showcase\" href=\""); TextIO.output (out, urp); TextIO.output (out, ".html\"><tt>"); TextIO.output (out, urp); TextIO.output (out, "</tt></a>"); app (fn file => let fun ifEx s = let val src = OS.Path.joinBaseExt {base = file, ext = SOME s} val src' = OS.Path.file src in if OS.FileSys.access (src, []) then (TextIO.output (out, " | <a target=\"showcase\" href=\""); TextIO.output (out, src'); TextIO.output (out, ".html\"><tt>"); TextIO.output (out, src'); TextIO.output (out, "</tt></a>")) else () end in ifEx "urs"; ifEx "ur" end) (#sources urpData); TextIO.output (out, " ]</center>\n\n"); (urpData, out)) end fun endUrp out = (TextIO.output (out, "\n</body></html>\n"); TextIO.closeOut out) fun readUrp (combined, out) = let fun finished () = endUrp out fun readUrp' () = case TextIO.inputLine inf of NONE => finished () | SOME line => if String.isSuffix ".urp\n" line then let val urp = String.substring (line, 0, size line - 1) val (urpData, out) = startUrp urp in finished (); readUrp (combiner (combined, urpData), out) end else (TextIO.output (out, line); readUrp' ()) in readUrp' () end val indexFile = OS.Path.joinDirFile {dir = outDir, file = "intro.html"} val out = TextIO.openOut indexFile val () = TextIO.output (out, "<html><head>\n<title>Ur/Web Demo</title>\n</head><body>\n\n") fun readIndex () = let fun finished () = (TextIO.output (out, "\n</body></html>\n"); TextIO.closeOut out) in case TextIO.inputLine inf of NONE => finished () | SOME line => if String.isSuffix ".urp\n" line then let val urp = String.substring (line, 0, size line - 1) val (urpData, out) = startUrp urp in finished (); readUrp (urpData, out) end else (TextIO.output (out, line); readIndex ()) end fun prettyPrint () = let val dir = Posix.FileSys.opendir dirname fun loop () = case Posix.FileSys.readdir dir of NONE => Posix.FileSys.closedir dir | SOME file => let fun doit f = f (OS.Path.joinDirFile {dir = dirname, file = file}, OS.Path.joinDirFile {dir = outDir, file = OS.Path.joinBaseExt {base = file, ext = SOME "html"}}) 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><head>\n<title>"); TextIO.output (out, file); TextIO.output (out, "</title>\n</head><body>\n<h1>"); TextIO.output (out, file); TextIO.output (out, "</h1>\n\n<pre>"); loop (); TextIO.output (out, "</pre>\n\n</body></html>"); TextIO.closeIn inf; TextIO.closeOut out end) | _ => (); loop () end in loop () end in readIndex (); TextIO.output (demosOut, "\n</body></html>\n"); TextIO.closeOut demosOut; prettyPrint () end end