adamc@1151: (* Copyright (c) 2008-2010, Adam Chlipala adamc@380: * All rights reserved. adamc@380: * adamc@380: * Redistribution and use in source and binary forms, with or without adamc@380: * modification, are permitted provided that the following conditions are met: adamc@380: * adamc@380: * - Redistributions of source code must retain the above copyright notice, adamc@380: * this list of conditions and the following disclaimer. adamc@380: * - Redistributions in binary form must reproduce the above copyright notice, adamc@380: * this list of conditions and the following disclaimer in the documentation adamc@380: * and/or other materials provided with the distribution. adamc@380: * - The names of contributors may not be used to endorse or promote products adamc@380: * derived from this software without specific prior written permission. adamc@380: * adamc@380: * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" adamc@380: * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE adamc@380: * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE adamc@380: * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE adamc@380: * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR adamc@380: * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF adamc@380: * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS adamc@380: * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN adamc@380: * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) adamc@380: * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE adamc@380: * POSSIBILITY OF SUCH DAMAGE. adamc@380: *) adamc@380: adamc@380: structure Demo :> DEMO = struct adamc@380: adam@1301: val noEmacs = ref false adam@1301: adamc@1079: fun make' {prefix, dirname, guided} = adamc@380: let adamc@380: val prose = OS.Path.joinDirFile {dir = dirname, adamc@380: file = "prose"} adamc@380: val inf = TextIO.openIn prose adamc@380: adamc@380: val outDir = OS.Path.concat (dirname, "out") adamc@380: adamc@380: val () = if OS.FileSys.access (outDir, []) then adamc@380: () adamc@380: else adamc@380: OS.FileSys.mkDir outDir adamc@380: adamc@380: val fname = OS.Path.joinDirFile {dir = outDir, adamc@380: file = "index.html"} adamc@380: adamc@380: val out = TextIO.openOut fname adamc@773: val () = (TextIO.output (out, "\n"); adamc@380: TextIO.output (out, "\n"); adamc@380: TextIO.output (out, "\n"); adamc@380: TextIO.output (out, "\n"); adamc@380: TextIO.closeOut out) adamc@380: adamc@380: val fname = OS.Path.joinDirFile {dir = outDir, adamc@380: file = "demos.html"} adamc@380: adamc@380: val demosOut = TextIO.openOut fname adamc@381: val () = (TextIO.output (demosOut, "\n\n"); adamc@380: TextIO.output (demosOut, "
  • Intro
    • \n\n")) adamc@380: adamc@384: val fname = OS.Path.joinDirFile {dir = dirname, adamc@384: file = "demo.urs"} adamc@384: val ursOut = TextIO.openOut fname adamc@384: val () = (TextIO.output (ursOut, "val main : unit -> transaction page\n"); adamc@384: TextIO.closeOut ursOut) adamc@384: adamc@384: val fname = OS.Path.joinDirFile {dir = dirname, adamc@384: file = "demo.ur"} adamc@384: val urOut = TextIO.openOut fname adamc@384: val () = TextIO.output (urOut, "fun main () = return \n") adamc@384: adamc@380: fun mergeWith f (o1, o2) = adamc@380: case (o1, o2) of adamc@380: (NONE, _) => o2 adamc@380: | (_, NONE) => o1 adamc@380: | (SOME v1, SOME v2) => SOME (f (v1, v2)) adamc@380: adamc@380: fun combiner (combined : Compiler.job, urp : Compiler.job) = { adamc@385: prefix = prefix, adamc@380: database = mergeWith (fn (v1, v2) => adamc@380: if v1 = v2 then adamc@380: v1 adamc@380: else adamc@380: raise Fail "Different demos want to use different database strings") adamc@380: (#database combined, #database urp), adamc@380: sources = foldl (fn (file, files) => adamc@380: if List.exists (fn x => x = file) files then adamc@380: files adamc@380: else adamc@380: files @ [file]) adamc@380: (#sources combined) (#sources urp), adamc@891: exe = case Settings.getExe () of adamc@891: NONE => OS.Path.joinDirFile {dir = dirname, adamc@891: file = "demo.exe"} adamc@891: | SOME s => s, adamc@891: sql = SOME (case Settings.getSql () of adamc@891: NONE => OS.Path.joinDirFile {dir = dirname, adamc@891: file = "demo.sql"} adamc@891: | SOME s => s), adamc@863: debug = Settings.getDebug (), adamc@673: timeout = Int.max (#timeout combined, #timeout urp), adamc@764: profile = false, adamc@764: ffi = [], adamc@764: link = [], adam@1725: linker = NONE, adamc@765: headers = [], adamc@766: scripts = [], adamc@765: clientToServer = [], adamc@765: effectful = [], adamc@1171: benignEffectful = [], adamc@765: clientOnly = [], adamc@765: serverOnly = [], adamc@768: jsFuncs = [], adamc@774: rewrites = #rewrites combined @ #rewrites urp, adamc@769: filterUrl = #filterUrl combined @ #filterUrl urp, adamc@866: filterMime = #filterMime combined @ #filterMime urp, adam@1465: filterRequest = #filterRequest combined @ #filterRequest urp, adam@1465: filterResponse = #filterResponse combined @ #filterResponse urp, adamc@866: protocol = mergeWith #2 (#protocol combined, #protocol urp), adamc@1164: dbms = mergeWith #2 (#dbms combined, #dbms urp), adamc@1183: sigFile = mergeWith #2 (#sigFile combined, #sigFile urp), adam@1614: safeGets = #safeGets combined @ #safeGets urp, adam@1332: onError = NONE, adam@1332: minHeap = 0 adamc@380: } adamc@380: adamc@380: val parse = Compiler.run (Compiler.transform Compiler.parseUrp "Demo parseUrp") adamc@380: adamc@380: fun capitalize "" = "" adamc@380: | capitalize s = str (Char.toUpper (String.sub (s, 0))) adamc@380: ^ String.extract (s, 1, NONE) adamc@380: adamc@380: fun startUrp urp = adamc@380: let adamc@380: val base = OS.Path.base urp adamc@380: val name = capitalize base adamc@380: adamc@380: val () = (TextIO.output (demosOut, "
  • "); adamc@380: TextIO.output (demosOut, name); adamc@380: TextIO.output (demosOut, "
    • \n")) adamc@380: adamc@384: val () = (TextIO.output (urOut, "
  • "); adamc@384: TextIO.output (urOut, name); adamc@384: TextIO.output (urOut, "
    • \n")) adamc@384: adamc@380: val urp_file = OS.Path.joinDirFile {dir = dirname, adamc@380: file = urp} adamc@380: adamc@380: val out = OS.Path.joinBaseExt {base = base, adamc@380: ext = SOME "html"} adamc@380: val out = OS.Path.joinDirFile {dir = outDir, adamc@380: file = out} adamc@380: val out = TextIO.openOut out adamc@380: adamc@501: val () = (TextIO.output (out, "\n"); adamc@380: TextIO.output (out, "\n"); adamc@380: TextIO.output (out, "\n"); adamc@380: TextIO.output (out, "\n"); adamc@380: TextIO.closeOut out) adamc@380: val () = TextIO.closeOut out adamc@380: adamc@380: val out = OS.Path.joinBaseExt {base = base, adamc@380: ext = SOME "desc"} adamc@380: val out = OS.Path.joinBaseExt {base = out, adamc@380: ext = SOME "html"} adamc@380: val out = TextIO.openOut (OS.Path.joinDirFile {dir = outDir, adamc@380: file = out}) adamc@380: in adamc@380: case parse (OS.Path.base urp_file) of adamc@380: NONE => raise Fail ("Can't parse " ^ urp_file) adamc@380: | SOME urpData => adamc@380: (TextIO.output (out, "\n"); adamc@380: TextIO.output (out, name); adamc@380: TextIO.output (out, "\n\n\n

    "); adamc@380: TextIO.output (out, name); adamc@380: TextIO.output (out, "

    \n\n
    [ Application"); adamc@382: TextIO.output (out, " | "); adamc@380: TextIO.output (out, urp); adamc@380: TextIO.output (out, ""); adamc@380: app (fn file => adamc@380: let adamc@380: fun ifEx s = adamc@380: let adamc@380: val src = OS.Path.joinBaseExt {base = file, adamc@380: ext = SOME s} adamc@380: val src' = OS.Path.file src adamc@380: in adamc@1151: if String.isPrefix (OS.Path.mkAbsolute {path = dirname, adamc@1151: relativeTo = OS.FileSys.getDir ()}) src adamc@943: andalso OS.FileSys.access (src, []) then adamc@380: (TextIO.output (out, " | "); adamc@380: TextIO.output (out, src'); adamc@380: TextIO.output (out, "")) adamc@380: else adamc@1156: () adamc@380: end adamc@380: in adamc@380: ifEx "urs"; adamc@380: ifEx "ur" adamc@380: end) (#sources urpData); adamc@380: TextIO.output (out, " ]
    \n\n"); adamc@380: adamc@380: (urpData, out)) adamc@380: end adamc@380: adamc@380: fun endUrp out = adamc@380: (TextIO.output (out, "\n\n"); adamc@380: TextIO.closeOut out) adamc@380: adamc@380: fun readUrp (combined, out) = adamc@380: let adamc@380: fun finished () = endUrp out adamc@380: adamc@380: fun readUrp' () = adamc@380: case TextIO.inputLine inf of adamc@384: NONE => (finished (); adamc@384: combined) adamc@380: | SOME line => adamc@380: if String.isSuffix ".urp\n" line then adamc@380: let adamc@380: val urp = String.substring (line, 0, size line - 1) adamc@380: val (urpData, out) = startUrp urp adamc@380: in adamc@380: finished (); adamc@380: adamc@380: readUrp (combiner (combined, urpData), adamc@380: out) adamc@380: end adamc@380: else adamc@380: (TextIO.output (out, line); adamc@380: readUrp' ()) adamc@380: in adamc@380: readUrp' () adamc@380: end adamc@380: adamc@380: val indexFile = OS.Path.joinDirFile {dir = outDir, adamc@380: file = "intro.html"} adamc@380: adamc@380: val out = TextIO.openOut indexFile adamc@380: val () = TextIO.output (out, "\nUr/Web Demo\n\n\n") adamc@380: adamc@380: fun readIndex () = adamc@380: let adamc@380: fun finished () = (TextIO.output (out, "\n\n"); adamc@380: TextIO.closeOut out) adamc@380: in adamc@380: case TextIO.inputLine inf of adamc@384: NONE => (finished (); adamc@384: NONE) adamc@380: | SOME line => adamc@380: if String.isSuffix ".urp\n" line then adamc@380: let adamc@380: val urp = String.substring (line, 0, size line - 1) adamc@380: val (urpData, out) = startUrp urp adamc@380: in adamc@380: finished (); adamc@380: adamc@384: SOME (readUrp (urpData, adamc@384: out)) adamc@380: end adamc@380: else adamc@380: (TextIO.output (out, line); adamc@380: readIndex ()) adamc@380: end adamc@381: adamc@381: fun prettyPrint () = adamc@381: let adamc@381: val dir = Posix.FileSys.opendir dirname adamc@381: adamc@381: fun loop () = adamc@381: case Posix.FileSys.readdir dir of adamc@381: NONE => Posix.FileSys.closedir dir adamc@381: | SOME file => adamc@381: let adamc@381: fun doit f = adamc@381: f (OS.Path.joinDirFile {dir = dirname, adamc@381: file = file}, adamc@382: OS.Path.mkAbsolute adamc@382: {relativeTo = OS.FileSys.getDir (), adamc@382: path = OS.Path.joinDirFile {dir = outDir, adamc@382: file = OS.Path.joinBaseExt {base = file, adamc@382: ext = SOME "html"}}}) adamc@382: adamc@382: fun highlight () = adamc@382: doit (fn (src, html) => adamc@382: let adamc@410: val dirty = adamc@410: let adamc@410: val srcSt = Posix.FileSys.stat src adamc@410: val htmlSt = Posix.FileSys.stat html adamc@410: in adamc@410: Time.> (Posix.FileSys.ST.mtime srcSt, adamc@410: Posix.FileSys.ST.mtime htmlSt) adamc@410: end handle OS.SysErr _ => true adamc@410: adamc@382: val cmd = "emacs --eval \"(progn " adamc@382: ^ "(global-font-lock-mode t) " adamc@382: ^ "(add-to-list 'load-path \\\"" adamc@382: ^ Config.sitelisp adamc@382: ^ "/\\\") " adamc@382: ^ "(load \\\"urweb-mode-startup\\\") " adamc@382: ^ "(urweb-mode) " adamc@382: ^ "(find-file \\\"" adamc@382: ^ src adamc@382: ^ "\\\") " adamc@382: ^ "(switch-to-buffer (htmlize-buffer)) " adamc@382: ^ "(write-file \\\"" adamc@382: ^ html adamc@382: ^ "\\\") " adamc@382: ^ "(kill-emacs))\"" adamc@382: in adamc@410: if dirty then adamc@410: (print (">>> " ^ cmd ^ "\n"); adamc@410: ignore (OS.Process.system cmd)) adamc@410: else adamc@410: () adamc@382: end) adam@1301: adam@1301: val highlight = fn () => if !noEmacs then () else highlight () adamc@381: in adamc@384: if OS.Path.base file = "demo" then adamc@384: () adamc@384: else case OS.Path.ext file of adamc@384: SOME "urp" => adamc@384: doit (fn (src, html) => adamc@384: let adamc@384: val inf = TextIO.openIn src adamc@384: val out = TextIO.openOut html adamc@381: adamc@384: fun loop () = adamc@384: case TextIO.inputLine inf of adamc@384: NONE => () adamc@384: | SOME line => (TextIO.output (out, line); adamc@384: loop ()) adamc@384: in adamc@384: TextIO.output (out, "\n\n
    ");
adamc@384:                                                   loop ();
adamc@384:                                                   TextIO.output (out, "
    \n\n"); adamc@381: adamc@384: TextIO.closeIn inf; adamc@384: TextIO.closeOut out adamc@384: end) adamc@384: | SOME "urs" => highlight () adamc@384: | SOME "ur" => highlight () adamc@384: | _ => (); adamc@381: loop () adamc@381: end adamc@381: in adamc@381: loop () adamc@381: end adamc@380: in adamc@384: case readIndex () of adamc@384: NONE => raise Fail "No demo applications!" adamc@384: | SOME combined => adamc@384: let adamc@384: val () = (TextIO.output (urOut, "    \n"); adamc@384: TextIO.closeOut urOut) adamc@384: adamc@384: val fname = OS.Path.joinDirFile {dir = dirname, adamc@384: file = "demo.urp"} adamc@384: val outf = TextIO.openOut fname adamc@776: adamc@776: fun filters kind = adamc@776: app (fn rule : Settings.rule => adamc@776: (TextIO.output (outf, case #action rule of adamc@776: Settings.Allow => "allow" adamc@776: | Settings.Deny => "deny"); adamc@776: TextIO.output (outf, " "); adamc@776: TextIO.output (outf, kind); adamc@776: TextIO.output (outf, " "); adamc@776: TextIO.output (outf, #pattern rule); adamc@776: case #kind rule of adamc@776: Settings.Exact => () adamc@776: | Settings.Prefix => TextIO.output (outf, "*"); adamc@776: TextIO.output (outf, "\n"))) adamc@384: in adamc@384: Option.app (fn db => (TextIO.output (outf, "database "); adamc@384: TextIO.output (outf, db); adamc@384: TextIO.output (outf, "\n"))) adamc@384: (#database combined); adamc@384: TextIO.output (outf, "sql demo.sql\n"); adamc@385: TextIO.output (outf, "prefix "); adamc@385: TextIO.output (outf, prefix); adamc@385: TextIO.output (outf, "\n"); adamc@774: app (fn rule => adamc@774: (TextIO.output (outf, "rewrite "); adamc@774: TextIO.output (outf, case #pkind rule of adamc@774: Settings.Any => "any" adamc@774: | Settings.Url => "url" adamc@774: | Settings.Table => "table" adamc@774: | Settings.Sequence => "sequence" adamc@774: | Settings.View => "view" adamc@774: | Settings.Relation => "relation" adamc@774: | Settings.Cookie => "cookie" adamc@774: | Settings.Style => "style"); adamc@774: TextIO.output (outf, " "); adamc@774: TextIO.output (outf, #from rule); adamc@774: case #kind rule of adamc@774: Settings.Exact => () adamc@774: | Settings.Prefix => TextIO.output (outf, "*"); adamc@774: TextIO.output (outf, " "); adamc@774: TextIO.output (outf, #to rule); adamc@774: TextIO.output (outf, "\n"))) (#rewrites combined); adamc@776: filters "url" (#filterUrl combined); adamc@776: filters "mime" (#filterMime combined); adam@1614: app (fn path => adam@1614: (TextIO.output (outf, "safeGet "); adam@1614: TextIO.output (outf, path); adam@1614: TextIO.output (outf, "\n"))) (#safeGets combined); adamc@384: TextIO.output (outf, "\n"); adamc@384: adamc@384: app (fn s => adamc@384: let adamc@384: val s = OS.Path.mkAbsolute {relativeTo = OS.FileSys.getDir (), adamc@384: path = s} adamc@384: in adamc@384: TextIO.output (outf, s); adamc@384: TextIO.output (outf, "\n") adamc@384: end) adamc@384: (#sources combined); adamc@384: TextIO.output (outf, "\n"); adamc@384: TextIO.output (outf, "demo\n"); adamc@384: adamc@384: TextIO.closeOut outf; adamc@384: adamc@1079: let adamc@1079: val b = Compiler.compile (OS.Path.base fname) adamc@1079: in adamc@1079: TextIO.output (demosOut, "\n\n"); adamc@1079: TextIO.closeOut demosOut; adamc@1079: if b then adamc@1079: prettyPrint () adamc@1079: else adamc@1079: (); adamc@1079: b adamc@1079: end adamc@1079: end adamc@380: end adamc@380: adamc@1079: fun make args = if make' args then adamc@1079: () adamc@1079: else adamc@1079: OS.Process.exit OS.Process.failure adamc@1079: adamc@380: end