Mercurial > urweb

comparison src/demo.sml @ 380:758304561b60

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