Mercurial > urweb
changeset 1493:9cb923efea4d
Generated pretty-printed HTML for a simple tutorial source file
| author | Adam Chlipala <adam@chlipala.net> |
|---|---|
| date | Fri, 15 Jul 2011 16:50:55 -0400 |
| parents | 175b6d52252d |
| children | 9ef6dd0df7a0 |
| files | .hgignore doc/intro.ur src/c/Makefile.am src/c/Makefile.in src/c/static.c src/main.mlton.sml src/sources src/static.sig src/static.sml src/tutorial.sig src/tutorial.sml |
| diffstat | 11 files changed, 401 insertions(+), 8 deletions(-) [+] |
line wrap: on
line diff
--- a/.hgignore Fri Jul 15 10:17:15 2011 -0400 +++ b/.hgignore Fri Jul 15 16:50:55 2011 -0400 @@ -33,6 +33,8 @@ demo/more/out/*.html demo/more/demo.* +doc/*.html + *.sql *mlmon.out
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/doc/intro.ur Fri Jul 15 16:50:55 2011 -0400 @@ -0,0 +1,9 @@ +(* Test evaluation.... *) + +fun f [a] (x : a) : a = x + +(* begin eval *) +f 6 +(* end *) + +(* Did it work? *)
--- a/src/c/Makefile.am Fri Jul 15 10:17:15 2011 -0400 +++ b/src/c/Makefile.am Fri Jul 15 16:50:55 2011 -0400 @@ -1,9 +1,10 @@ -lib_LTLIBRARIES = liburweb.la liburweb_http.la liburweb_cgi.la liburweb_fastcgi.la +lib_LTLIBRARIES = liburweb.la liburweb_http.la liburweb_cgi.la liburweb_fastcgi.la liburweb_static.la liburweb_la_SOURCES = memmem.c openssl.c urweb.c request.c queue.c liburweb_http_la_SOURCES = http.c liburweb_cgi_la_SOURCES = cgi.c liburweb_fastcgi_la_SOURCES = fastcgi.c +liburweb_static_la_SOURCES = static.c AM_CPPFLAGS = -I../../include @OPENSSL_INCLUDES@ AM_CFLAGS = -Wimplicit -Wall -Werror -Wno-format-security
--- a/src/c/Makefile.in Fri Jul 15 10:17:15 2011 -0400 +++ b/src/c/Makefile.in Fri Jul 15 16:50:55 2011 -0400 @@ -83,6 +83,9 @@ liburweb_http_la_LIBADD = am_liburweb_http_la_OBJECTS = http.lo liburweb_http_la_OBJECTS = $(am_liburweb_http_la_OBJECTS) +liburweb_static_la_LIBADD = +am_liburweb_static_la_OBJECTS = static.lo +liburweb_static_la_OBJECTS = $(am_liburweb_static_la_OBJECTS) DEFAULT_INCLUDES = -I.@am__isrc@ -I$(top_builddir) depcomp = $(SHELL) $(top_srcdir)/depcomp am__depfiles_maybe = depfiles @@ -97,9 +100,11 @@ --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) $(AM_LDFLAGS) \ $(LDFLAGS) -o $@ SOURCES = $(liburweb_la_SOURCES) $(liburweb_cgi_la_SOURCES) \ - $(liburweb_fastcgi_la_SOURCES) $(liburweb_http_la_SOURCES) + $(liburweb_fastcgi_la_SOURCES) $(liburweb_http_la_SOURCES) \ + $(liburweb_static_la_SOURCES) DIST_SOURCES = $(liburweb_la_SOURCES) $(liburweb_cgi_la_SOURCES) \ - $(liburweb_fastcgi_la_SOURCES) $(liburweb_http_la_SOURCES) + $(liburweb_fastcgi_la_SOURCES) $(liburweb_http_la_SOURCES) \ + $(liburweb_static_la_SOURCES) ETAGS = etags CTAGS = ctags DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) @@ -231,11 +236,12 @@ top_build_prefix = @top_build_prefix@ top_builddir = @top_builddir@ top_srcdir = @top_srcdir@ -lib_LTLIBRARIES = liburweb.la liburweb_http.la liburweb_cgi.la liburweb_fastcgi.la +lib_LTLIBRARIES = liburweb.la liburweb_http.la liburweb_cgi.la liburweb_fastcgi.la liburweb_static.la liburweb_la_SOURCES = memmem.c openssl.c urweb.c request.c queue.c liburweb_http_la_SOURCES = http.c liburweb_cgi_la_SOURCES = cgi.c liburweb_fastcgi_la_SOURCES = fastcgi.c +liburweb_static_la_SOURCES = static.c AM_CPPFLAGS = -I../../include @OPENSSL_INCLUDES@ AM_CFLAGS = -Wimplicit -Wall -Werror -Wno-format-security all: all-am @@ -311,6 +317,8 @@ $(LINK) -rpath $(libdir) $(liburweb_fastcgi_la_OBJECTS) $(liburweb_fastcgi_la_LIBADD) $(LIBS) liburweb_http.la: $(liburweb_http_la_OBJECTS) $(liburweb_http_la_DEPENDENCIES) $(LINK) -rpath $(libdir) $(liburweb_http_la_OBJECTS) $(liburweb_http_la_LIBADD) $(LIBS) +liburweb_static.la: $(liburweb_static_la_OBJECTS) $(liburweb_static_la_DEPENDENCIES) + $(LINK) -rpath $(libdir) $(liburweb_static_la_OBJECTS) $(liburweb_static_la_LIBADD) $(LIBS) mostlyclean-compile: -rm -f *.$(OBJEXT) @@ -325,6 +333,7 @@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/openssl.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/queue.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/request.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/static.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/urweb.Plo@am__quote@ .c.o:
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/c/static.c Fri Jul 15 16:50:55 2011 -0400 @@ -0,0 +1,56 @@ +#include "config.h" + +#include <stdio.h> +#include <stdarg.h> + +#include "urweb.h" + +extern uw_app uw_application; + +static void log_debug(void *data, const char *fmt, ...) { + va_list ap; + va_start(ap, fmt); + + vprintf(fmt, ap); +} + +int main(int argc, char *argv[]) { + uw_context ctx; + failure_kind fk; + + if (argc != 2) { + fprintf(stderr, "Pass exactly one argument: the URI to run\n"); + return 1; + } + + ctx = uw_init(0, NULL, log_debug); + uw_set_app(ctx, &uw_application); + fk = uw_begin(ctx, argv[1]); + + if (fk == SUCCESS) { + uw_print(ctx, 1); + puts(""); + return 0; + } else { + fprintf(stderr, "Error!\n"); + return 1; + } +} + +void *uw_init_client_data() { + return NULL; +} + +void uw_free_client_data(void *data) { +} + +void uw_copy_client_data(void *dst, void *src) { +} + +void uw_do_expunge(uw_context ctx, uw_Basis_client cli, void *data) { +} + +void uw_post_expunge(uw_context ctx, void *data) { +} + +int uw_supports_direct_status = 0;
--- a/src/main.mlton.sml Fri Jul 15 10:17:15 2011 -0400 +++ b/src/main.mlton.sml Fri Jul 15 16:50:55 2011 -0400 @@ -1,4 +1,4 @@ -(* Copyright (c) 2008-2010, Adam Chlipala +(* Copyright (c) 2008-2011, Adam Chlipala * All rights reserved. * * Redistribution and use in source and binary forms, with or without @@ -29,6 +29,7 @@ val tc = ref false val sources = ref ([] : string list) val demo = ref (NONE : (string * bool) option) +val tutorial = ref false val css = ref false fun doArgs args = @@ -43,6 +44,9 @@ | "-guided-demo" :: prefix :: rest => (demo := SOME (prefix, true); doArgs rest) + | "-tutorial" :: rest => + (tutorial := true; + doArgs rest) | "-protocol" :: name :: rest => (Settings.setProtocol name; doArgs rest) @@ -118,8 +122,8 @@ | _ => raise Fail "Zero or multiple job files specified" val () = - case (!css, !demo) of - (true, _) => + case (!css, !demo, !tutorial) of + (true, _, _) => (case Compiler.run Compiler.toCss job of NONE => OS.Process.exit OS.Process.failure | SOME {Overall = ov, Classes = cl} => @@ -131,8 +135,9 @@ app (print o Css.inheritableToString) ins; app (print o Css.othersToString) ots; print "\n")) cl)) - | (_, SOME (prefix, guided)) => + | (_, SOME (prefix, guided), _) => Demo.make {prefix = prefix, dirname = job, guided = guided} + | (_, _, true) => Tutorial.make job | _ => if !tc then (Compiler.check Compiler.toElaborate job;
--- a/src/sources Fri Jul 15 10:17:15 2011 -0400 +++ b/src/sources Fri Jul 15 16:50:55 2011 -0400 @@ -28,6 +28,9 @@ fastcgi.sig fastcgi.sml +static.sig +static.sml + mysql.sig mysql.sml @@ -209,3 +212,6 @@ demo.sig demo.sml + +tutorial.sig +tutorial.sml
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/static.sig Fri Jul 15 16:50:55 2011 -0400 @@ -0,0 +1,30 @@ +(* Copyright (c) 2011, 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. + *) + +signature STATIC = sig + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/static.sml Fri Jul 15 16:50:55 2011 -0400 @@ -0,0 +1,41 @@ +(* Copyright (c) 2011, 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 Static :> STATIC = struct + +open Settings +open Print.PD Print + +val () = addProtocol {name = "static", + compile = "", + linkStatic = Config.lib ^ "/../liburweb_static.a", + linkDynamic = "-lurweb_static", + persistent = false, + code = fn () => box [string "void uw_global_custom() { }", + newline]} + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/tutorial.sig Fri Jul 15 16:50:55 2011 -0400 @@ -0,0 +1,32 @@ +(* Copyright (c) 2011, 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. + *) + +signature TUTORIAL = sig + + val make : string -> unit + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/tutorial.sml Fri Jul 15 16:50:55 2011 -0400 @@ -0,0 +1,202 @@ +(* Copyright (c) 2011, 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 Tutorial :> TUTORIAL = struct + +fun readAll' inf = + let + fun loop acc = + case TextIO.inputLine inf of + NONE => Substring.full (String.concat (rev acc)) + | SOME line => loop (line :: acc) + in + loop [] + before TextIO.closeIn inf + end + +fun readAll fname = readAll' (TextIO.openIn fname) + +fun doUr fname = + let + val eval = TextIO.openOut "/tmp/eval.ur" + val gen = TextIO.openOut "/tmp/gen.ur" + + fun untilEnd source = + let + val (befor, after) = Substring.position "(* end *)" source + in + if Substring.isEmpty after then + (source, Substring.full "") + else + (befor, Substring.slice (after, 9, NONE)) + end + + fun doDirectives (count, source) = + let + val safe = String.translate (fn #"<" => "<" + | #"&" => "&" + | #"{" => "{" + | #"(" => "(" + | #"\n" => "(*NL*)\n" + | ch => str ch) o Substring.string + + val (befor, after) = Substring.position "(* begin " source + + fun default () = (TextIO.outputSubstr (eval, source); + TextIO.output (gen, safe source)) + in + if Substring.isEmpty after then + default () + else + let + val (command, after) = Substring.splitl (not o Char.isSpace) (Substring.slice (after, 9, NONE)) + in + if Substring.isEmpty after then + default () + else + let + val (_, rest) = Substring.position "*)" after + in + if Substring.isEmpty rest then + default () + else + let + val (arg, source) = untilEnd (Substring.slice (rest, 3, NONE)) + val () = (TextIO.outputSubstr (eval, befor); + TextIO.output (gen, safe befor)) + val (count, skip) = + case Substring.string command of + "hide" => (TextIO.outputSubstr (eval, arg); + (count, true)) + | "eval" => (TextIO.output (eval, "val _eval"); + TextIO.output (eval, Int.toString count); + TextIO.output (eval, " = "); + TextIO.outputSubstr (eval, arg); + TextIO.output (eval, "\n\n"); + + TextIO.output (gen, safe arg); + TextIO.output (gen, "== {[_eval"); + TextIO.output (gen, Int.toString count); + TextIO.output (gen, "]}"); + + (count + 1, false)) + | s => raise Fail ("Unknown tutorial directive: " ^ s) + in + doDirectives (count, if skip then + #2 (Substring.splitl Char.isSpace source) + else + source) + end + end + end + end + in + doDirectives (0, readAll fname); + TextIO.closeOut gen; + + TextIO.output (eval, "\n\nfun main () : transaction page =\nreturn <xml><body>"); + TextIO.outputSubstr (eval, readAll "/tmp/gen.ur"); + TextIO.output (eval, "</body></xml>"); + TextIO.closeOut eval; + + if Compiler.compile "/tmp/eval" then + let + val proc = Unix.execute ("/bin/sh", ["-c", "/tmp/eval.exe /main"]) + val inf = Unix.textInstreamOf proc + val s = readAll' inf + val _ = Unix.reap proc + + val (befor, after) = Substring.position "<sc>" s + in + if Substring.isEmpty after then + print ("Bad output for " ^ fname ^ "! [1]\n") + else + let + val after = Substring.slice (after, 4, NONE) + val (befor, after) = Substring.position "</body>" after + in + if Substring.isEmpty after then + print ("Bad output for " ^ fname ^ "! [2]\n") + else + let + val outf = TextIO.openOut "/tmp/final.ur" + + fun eatNls source = + let + val (befor, after) = Substring.position "(*NL*)" source + in + if Substring.isEmpty after then + TextIO.outputSubstr (outf, source) + else + (TextIO.outputSubstr (outf, befor); + eatNls (Substring.slice (after, 6, NONE))) + end + + val cmd = "emacs --eval \"(progn " + ^ "(global-font-lock-mode t) " + ^ "(add-to-list 'load-path \\\"" + ^ Config.sitelisp + ^ "/\\\") " + ^ "(load \\\"urweb-mode-startup\\\") " + ^ "(urweb-mode) " + ^ "(find-file \\\"/tmp/final.ur\\\") " + ^ "(switch-to-buffer (htmlize-buffer)) " + ^ "(write-file \\\"" + ^ OS.Path.mkAbsolute {relativeTo = OS.FileSys.getDir (), + path = OS.Path.joinBaseExt {base = OS.Path.base fname, ext = SOME "html"}} + ^ "\\\") " + ^ "(kill-emacs))\"" + in + eatNls befor; + TextIO.closeOut outf; + ignore (OS.Process.system cmd) + end + end + end + else + () + end + +fun make dirname = + let + val dir = OS.FileSys.openDir dirname + + fun doDir () = + case OS.FileSys.readDir dir of + NONE => OS.FileSys.closeDir dir + | SOME fname => + (if OS.Path.ext fname = SOME "ur" then + doUr (OS.Path.joinDirFile {dir = dirname, file = fname}) + else + (); + doDir ()) + in + Settings.setProtocol "static"; + doDir () + end + +end