Mercurial > urweb

annotate src/demo.sml @ 381:1fe85b58c9ba

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Generating urp HTML
author Adam Chlipala <adamc@hcoop.net>
date Sun, 19 Oct 2008 14:13:08 -0400
parents 758304561b60
children aa2edbd47041
rev   line source
adamc@380 1 (* Copyright (c) 2008, Adam Chlipala
adamc@380 2 * All rights reserved.
adamc@380 3 *
adamc@380 4 * Redistribution and use in source and binary forms, with or without
adamc@380 5 * modification, are permitted provided that the following conditions are met:
adamc@380 6 *
adamc@380 7 * - Redistributions of source code must retain the above copyright notice,
adamc@380 8 * this list of conditions and the following disclaimer.
adamc@380 9 * - Redistributions in binary form must reproduce the above copyright notice,
adamc@380 10 * this list of conditions and the following disclaimer in the documentation
adamc@380 11 * and/or other materials provided with the distribution.
adamc@380 12 * - The names of contributors may not be used to endorse or promote products
adamc@380 13 * derived from this software without specific prior written permission.
adamc@380 14 *
adamc@380 15 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
adamc@380 16 * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
adamc@380 17 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
adamc@380 18 * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
adamc@380 19 * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
adamc@380 20 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
adamc@380 21 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
adamc@380 22 * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
adamc@380 23 * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
adamc@380 24 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
adamc@380 25 * POSSIBILITY OF SUCH DAMAGE.
adamc@380 26 *)
adamc@380 27
adamc@380 28 structure Demo :> DEMO = struct
adamc@380 29
adamc@380 30 fun make {prefix, dirname} =
adamc@380 31 let
adamc@380 32 val prose = OS.Path.joinDirFile {dir = dirname,
adamc@380 33 file = "prose"}
adamc@380 34 val inf = TextIO.openIn prose
adamc@380 35
adamc@380 36 val demo_urp = OS.Path.joinDirFile {dir = dirname,
adamc@380 37 file = "demo.urp"}
adamc@380 38
adamc@380 39 val outDir = OS.Path.concat (dirname, "out")
adamc@380 40
adamc@380 41 val () = if OS.FileSys.access (outDir, []) then
adamc@380 42 ()
adamc@380 43 else
adamc@380 44 OS.FileSys.mkDir outDir
adamc@380 45
adamc@380 46 val fname = OS.Path.joinDirFile {dir = outDir,
adamc@380 47 file = "index.html"}
adamc@380 48
adamc@380 49 val out = TextIO.openOut fname
adamc@381 50 val () = (TextIO.output (out, "<frameset cols=\"10%,90%\">\n");
adamc@380 51 TextIO.output (out, "<frame src=\"demos.html\">\n");
adamc@380 52 TextIO.output (out, "<frame src=\"intro.html\" name=\"staging\">\n");
adamc@380 53 TextIO.output (out, "</frameset>\n");
adamc@380 54 TextIO.closeOut out)
adamc@380 55
adamc@380 56 val fname = OS.Path.joinDirFile {dir = outDir,
adamc@380 57 file = "demos.html"}
adamc@380 58
adamc@380 59 val demosOut = TextIO.openOut fname
adamc@381 60 val () = (TextIO.output (demosOut, "<html><body>\n\n");
adamc@380 61 TextIO.output (demosOut, "<li> <a target=\"staging\" href=\"intro.html\">Intro</a></li>\n\n"))
adamc@380 62
adamc@380 63 fun mergeWith f (o1, o2) =
adamc@380 64 case (o1, o2) of
adamc@380 65 (NONE, _) => o2
adamc@380 66 | (_, NONE) => o1
adamc@380 67 | (SOME v1, SOME v2) => SOME (f (v1, v2))
adamc@380 68
adamc@380 69 fun combiner (combined : Compiler.job, urp : Compiler.job) = {
adamc@380 70 database = mergeWith (fn (v1, v2) =>
adamc@380 71 if v1 = v2 then
adamc@380 72 v1
adamc@380 73 else
adamc@380 74 raise Fail "Different demos want to use different database strings")
adamc@380 75 (#database combined, #database urp),
adamc@380 76 sources = foldl (fn (file, files) =>
adamc@380 77 if List.exists (fn x => x = file) files then
adamc@380 78 files
adamc@380 79 else
adamc@380 80 files @ [file])
adamc@380 81 (#sources combined) (#sources urp),
adamc@380 82 exe = OS.Path.joinDirFile {dir = dirname,
adamc@380 83 file = "demo.exe"},
adamc@380 84 sql = SOME (OS.Path.joinDirFile {dir = dirname,
adamc@380 85 file = "demo.sql"}),
adamc@380 86 debug = false
adamc@380 87 }
adamc@380 88
adamc@380 89 val parse = Compiler.run (Compiler.transform Compiler.parseUrp "Demo parseUrp")
adamc@380 90
adamc@380 91 fun capitalize "" = ""
adamc@380 92 | capitalize s = str (Char.toUpper (String.sub (s, 0)))
adamc@380 93 ^ String.extract (s, 1, NONE)
adamc@380 94
adamc@380 95 fun startUrp urp =
adamc@380 96 let
adamc@380 97 val base = OS.Path.base urp
adamc@380 98 val name = capitalize base
adamc@380 99
adamc@380 100 val () = (TextIO.output (demosOut, "<li> <a target=\"staging\" href=\"");
adamc@380 101 TextIO.output (demosOut, base);
adamc@380 102 TextIO.output (demosOut, ".html\">");
adamc@380 103 TextIO.output (demosOut, name);
adamc@380 104 TextIO.output (demosOut, "</a></li>\n"))
adamc@380 105
adamc@380 106 val urp_file = OS.Path.joinDirFile {dir = dirname,
adamc@380 107 file = urp}
adamc@380 108
adamc@380 109 val out = OS.Path.joinBaseExt {base = base,
adamc@380 110 ext = SOME "html"}
adamc@380 111 val out = OS.Path.joinDirFile {dir = outDir,
adamc@380 112 file = out}
adamc@380 113 val out = TextIO.openOut out
adamc@380 114
adamc@380 115 val () = (TextIO.output (out, "<frameset rows=\"75%,25%\">\n");
adamc@380 116 TextIO.output (out, "<frame src=\"");
adamc@380 117 TextIO.output (out, prefix);
adamc@380 118 TextIO.output (out, "/");
adamc@380 119 TextIO.output (out, name);
adamc@380 120 TextIO.output (out, "/main\" name=\"showcase\">\n");
adamc@380 121 TextIO.output (out, "<frame src=\"");
adamc@380 122 TextIO.output (out, base);
adamc@380 123 TextIO.output (out, ".desc.html\">\n");
adamc@380 124 TextIO.output (out, "</frameset>\n");
adamc@380 125 TextIO.closeOut out)
adamc@380 126 val () = TextIO.closeOut out
adamc@380 127
adamc@380 128 val out = OS.Path.joinBaseExt {base = base,
adamc@380 129 ext = SOME "desc"}
adamc@380 130 val out = OS.Path.joinBaseExt {base = out,
adamc@380 131 ext = SOME "html"}
adamc@380 132 val out = TextIO.openOut (OS.Path.joinDirFile {dir = outDir,
adamc@380 133 file = out})
adamc@380 134 in
adamc@380 135 case parse (OS.Path.base urp_file) of
adamc@380 136 NONE => raise Fail ("Can't parse " ^ urp_file)
adamc@380 137 | SOME urpData =>
adamc@380 138 (TextIO.output (out, "<html><head>\n<title>");
adamc@380 139 TextIO.output (out, name);
adamc@380 140 TextIO.output (out, "</title>\n</head><body>\n\n<h1>");
adamc@380 141 TextIO.output (out, name);
adamc@380 142 TextIO.output (out, "</h1>\n\n<center>[ <a target=\"showcase\" href=\"");
adamc@380 143 TextIO.output (out, urp);
adamc@380 144 TextIO.output (out, ".html\"><tt>");
adamc@380 145 TextIO.output (out, urp);
adamc@380 146 TextIO.output (out, "</tt></a>");
adamc@380 147 app (fn file =>
adamc@380 148 let
adamc@380 149 fun ifEx s =
adamc@380 150 let
adamc@380 151 val src = OS.Path.joinBaseExt {base = file,
adamc@380 152 ext = SOME s}
adamc@380 153 val src' = OS.Path.file src
adamc@380 154 in
adamc@380 155 if OS.FileSys.access (src, []) then
adamc@380 156 (TextIO.output (out, " | <a target=\"showcase\" href=\"");
adamc@380 157 TextIO.output (out, src');
adamc@380 158 TextIO.output (out, ".html\"><tt>");
adamc@380 159 TextIO.output (out, src');
adamc@380 160 TextIO.output (out, "</tt></a>"))
adamc@380 161 else
adamc@380 162 ()
adamc@380 163 end
adamc@380 164 in
adamc@380 165 ifEx "urs";
adamc@380 166 ifEx "ur"
adamc@380 167 end) (#sources urpData);
adamc@380 168 TextIO.output (out, " ]</center>\n\n");
adamc@380 169
adamc@380 170 (urpData, out))
adamc@380 171 end
adamc@380 172
adamc@380 173 fun endUrp out =
adamc@380 174 (TextIO.output (out, "\n</body></html>\n");
adamc@380 175 TextIO.closeOut out)
adamc@380 176
adamc@380 177 fun readUrp (combined, out) =
adamc@380 178 let
adamc@380 179 fun finished () = endUrp out
adamc@380 180
adamc@380 181 fun readUrp' () =
adamc@380 182 case TextIO.inputLine inf of
adamc@380 183 NONE => finished ()
adamc@380 184 | SOME line =>
adamc@380 185 if String.isSuffix ".urp\n" line then
adamc@380 186 let
adamc@380 187 val urp = String.substring (line, 0, size line - 1)
adamc@380 188 val (urpData, out) = startUrp urp
adamc@380 189 in
adamc@380 190 finished ();
adamc@380 191
adamc@380 192 readUrp (combiner (combined, urpData),
adamc@380 193 out)
adamc@380 194 end
adamc@380 195 else
adamc@380 196 (TextIO.output (out, line);
adamc@380 197 readUrp' ())
adamc@380 198 in
adamc@380 199 readUrp' ()
adamc@380 200 end
adamc@380 201
adamc@380 202 val indexFile = OS.Path.joinDirFile {dir = outDir,
adamc@380 203 file = "intro.html"}
adamc@380 204
adamc@380 205 val out = TextIO.openOut indexFile
adamc@380 206 val () = TextIO.output (out, "<html><head>\n<title>Ur/Web Demo</title>\n</head><body>\n\n")
adamc@380 207
adamc@380 208 fun readIndex () =
adamc@380 209 let
adamc@380 210 fun finished () = (TextIO.output (out, "\n</body></html>\n");
adamc@380 211 TextIO.closeOut out)
adamc@380 212 in
adamc@380 213 case TextIO.inputLine inf of
adamc@380 214 NONE => finished ()
adamc@380 215 | SOME line =>
adamc@380 216 if String.isSuffix ".urp\n" line then
adamc@380 217 let
adamc@380 218 val urp = String.substring (line, 0, size line - 1)
adamc@380 219 val (urpData, out) = startUrp urp
adamc@380 220 in
adamc@380 221 finished ();
adamc@380 222
adamc@380 223 readUrp (urpData,
adamc@380 224 out)
adamc@380 225 end
adamc@380 226 else
adamc@380 227 (TextIO.output (out, line);
adamc@380 228 readIndex ())
adamc@380 229 end
adamc@381 230
adamc@381 231 fun prettyPrint () =
adamc@381 232 let
adamc@381 233 val dir = Posix.FileSys.opendir dirname
adamc@381 234
adamc@381 235 fun loop () =
adamc@381 236 case Posix.FileSys.readdir dir of
adamc@381 237 NONE => Posix.FileSys.closedir dir
adamc@381 238 | SOME file =>
adamc@381 239 let
adamc@381 240 fun doit f =
adamc@381 241 f (OS.Path.joinDirFile {dir = dirname,
adamc@381 242 file = file},
adamc@381 243 OS.Path.joinDirFile {dir = outDir,
adamc@381 244 file = OS.Path.joinBaseExt {base = file,
adamc@381 245 ext = SOME "html"}})
adamc@381 246 in
adamc@381 247 case OS.Path.ext file of
adamc@381 248 SOME "urp" =>
adamc@381 249 doit (fn (src, html) =>
adamc@381 250 let
adamc@381 251 val inf = TextIO.openIn src
adamc@381 252 val out = TextIO.openOut html
adamc@381 253
adamc@381 254 fun loop () =
adamc@381 255 case TextIO.inputLine inf of
adamc@381 256 NONE => ()
adamc@381 257 | SOME line => (TextIO.output (out, line);
adamc@381 258 loop ())
adamc@381 259 in
adamc@381 260 TextIO.output (out, "<html><head>\n<title>");
adamc@381 261 TextIO.output (out, file);
adamc@381 262 TextIO.output (out, "</title>\n</head><body>\n<h1>");
adamc@381 263 TextIO.output (out, file);
adamc@381 264 TextIO.output (out, "</h1>\n\n<pre>");
adamc@381 265 loop ();
adamc@381 266 TextIO.output (out, "</pre>\n\n</body></html>");
adamc@381 267
adamc@381 268 TextIO.closeIn inf;
adamc@381 269 TextIO.closeOut out
adamc@381 270 end)
adamc@381 271 | _ => ();
adamc@381 272 loop ()
adamc@381 273 end
adamc@381 274 in
adamc@381 275 loop ()
adamc@381 276 end
adamc@380 277 in
adamc@380 278 readIndex ();
adamc@380 279
adamc@381 280 TextIO.output (demosOut, "\n</body></html>\n");
adamc@381 281 TextIO.closeOut demosOut;
adamc@381 282
adamc@381 283 prettyPrint ()
adamc@380 284 end
adamc@380 285
adamc@380 286 end