adamc@380: (* Copyright (c) 2008, 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:
adamc@380: fun make {prefix, dirname} =
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 demo_urp = OS.Path.joinDirFile {dir = dirname,
adamc@380: file = "demo.urp"}
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@380: val () = (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@380: val () = (TextIO.output (demosOut, "\n\n");
adamc@380: TextIO.output (demosOut, "- Intro
\n\n"))
adamc@380:
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@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@380: exe = OS.Path.joinDirFile {dir = dirname,
adamc@380: file = "demo.exe"},
adamc@380: sql = SOME (OS.Path.joinDirFile {dir = dirname,
adamc@380: file = "demo.sql"}),
adamc@380: debug = false
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@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@380: val () = (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[ ");
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@380: if 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@380: ()
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@380: NONE => finished ()
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@380: NONE => finished ()
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 (urpData,
adamc@380: out)
adamc@380: end
adamc@380: else
adamc@380: (TextIO.output (out, line);
adamc@380: readIndex ())
adamc@380: end
adamc@380: in
adamc@380: readIndex ();
adamc@380:
adamc@380: TextIO.output (demosOut, "\n
\n");
adamc@380: TextIO.closeOut demosOut
adamc@380: end
adamc@380:
adamc@380: end