adam@1493: (* Copyright (c) 2011, Adam Chlipala
adam@1493:  * All rights reserved.
adam@1493:  *
adam@1493:  * Redistribution and use in source and binary forms, with or without
adam@1493:  * modification, are permitted provided that the following conditions are met:
adam@1493:  *
adam@1493:  * - Redistributions of source code must retain the above copyright notice,
adam@1493:  *   this list of conditions and the following disclaimer.
adam@1493:  * - Redistributions in binary form must reproduce the above copyright notice,
adam@1493:  *   this list of conditions and the following disclaimer in the documentation
adam@1493:  *   and/or other materials provided with the distribution.
adam@1493:  * - The names of contributors may not be used to endorse or promote products
adam@1493:  *   derived from this software without specific prior written permission.
adam@1493:  *
adam@1493:  * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
adam@1493:  * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
adam@1493:  * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
adam@1493:  * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
adam@1493:  * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
adam@1493:  * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
adam@1493:  * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
adam@1493:  * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
adam@1493:  * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
adam@1493:  * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
adam@1493:  * POSSIBILITY OF SUCH DAMAGE.
adam@1493:  *)
adam@1493: 
adam@1493: structure Tutorial :> TUTORIAL = struct
adam@1493: 
adam@1494: fun readAll inf =
adam@1493:     let
adam@1493:         fun loop acc =
adam@1493:             case TextIO.inputLine inf of
adam@1493:                 NONE => Substring.full (String.concat (rev acc))
adam@1493:               | SOME line => loop (line :: acc)
adam@1493:     in
adam@1493:         loop []
adam@1493:         before TextIO.closeIn inf
adam@1493:     end
adam@1493: 
adam@1494: val readAllFile = readAll o TextIO.openIn
adam@1494: 
adam@1494: fun fixupFile (fname, title) =
adam@1494:     let
adam@1494:         val source = readAllFile "/tmp/final.html"
adam@1494:         val outf = TextIO.openOut (OS.Path.mkAbsolute {relativeTo = OS.FileSys.getDir (),
adam@1494:                                                        path = OS.Path.joinBaseExt {base = OS.Path.base fname, ext = SOME "html"}})
adam@1494: 
adam@1494:         val (befor, after) = Substring.position "<title>" source
adam@1494: 
adam@1495:         fun proseLoop source =
adam@1495:             let
adam@1495:                 val (befor, after) = Substring.splitl (fn ch => ch <> #"&") source
adam@1495:             in
adam@1495:                 if Substring.isEmpty after then
adam@1495:                     TextIO.outputSubstr (outf, source)
adam@1497:                 else if Substring.size after >= 4 andalso Substring.string (Substring.slice (after, 1, SOME 3)) = "lt;" then
adam@1495:                     (TextIO.outputSubstr (outf, befor);
adam@1495:                      TextIO.output (outf, "<");
adam@1497:                      proseLoop (Substring.slice (after, 4, NONE)))
adam@1495:                 else if Substring.size after >= 4 andalso Substring.string (Substring.slice (after, 1, SOME 3)) = "gt;" then
adam@1495:                     (TextIO.outputSubstr (outf, befor);
adam@1495:                      TextIO.output (outf, ">");
adam@1495:                      proseLoop (Substring.slice (after, 4, NONE)))
adam@1495:                 else if Substring.size after >= 5 andalso Substring.string (Substring.slice (after, 1, SOME 4)) = "amp;" then
adam@1495:                     (TextIO.outputSubstr (outf, befor);
adam@1495:                      TextIO.output (outf, "&");
adam@1495:                      proseLoop (Substring.slice (after, 5, NONE)))
adam@1495:                 else
adam@1495:                     raise Fail "Unsupported HTML escape"
adam@1495:             end
adam@1495: 
adam@1494:         fun loop source =
adam@1494:             let
adam@1494:                 val (befor, after) = Substring.position "<span class=\"comment-delimiter\">(* </span><span class=\"comment\">" source
adam@1494:             in
adam@1494:                 if Substring.isEmpty after then
adam@1497:                    TextIO.outputSubstr (outf, source)
adam@1494:                 else
adam@1494:                     let
adam@1494:                         val (befor', after) = Substring.position " </span><span class=\"comment-delimiter\">*)</span>"
adam@1498:                                                                  (Substring.slice (after, 64, NONE))
adam@1494:                     in
adam@1494:                         if Substring.isEmpty after then
adam@1494:                             TextIO.outputSubstr (outf, source)
adam@1494:                         else
adam@1494:                             (TextIO.outputSubstr (outf, befor);
adam@1497:                              TextIO.output (outf, "</pre>");
adam@1497:                              if Substring.size befor' >= 1 andalso Substring.sub (befor', 0) = #"*" then
adam@1497:                                  (TextIO.output (outf, "<h2>");
adam@1497:                                   proseLoop (Substring.slice (befor', 2, NONE));
adam@1497:                                   TextIO.output (outf, "</h2>"))
adam@1497:                              else
adam@1497:                                  (TextIO.output (outf, "<div class=\"prose\">");
adam@1497:                                   proseLoop befor';
adam@1497:                                   TextIO.output (outf, "</div>"));
adam@1497:                              TextIO.output (outf, "<pre>");
adam@1494:                              loop (Substring.slice (after, 49, NONE)))
adam@1494:                     end
adam@1494:             end
adam@1494:     in
adam@1494:         if Substring.isEmpty after then
adam@1494:             raise Fail ("Missing <title> for " ^ title)
adam@1494:         else
adam@1494:             (TextIO.outputSubstr (outf, befor);
adam@1494:              TextIO.output (outf, "<style type=\"text/css\">\n");
adam@1494:              TextIO.output (outf, "<!--\n");
adam@1494:              TextIO.output (outf, "\tdiv.prose {\n");
adam@1494:              TextIO.output (outf, "\t\tfont-family: Arial;\n");
adam@1494:              TextIO.output (outf, "\t\tbackground-color: #CCFFCC;\n");
adam@1494:              TextIO.output (outf, "\t\tborder-style: solid;\n");
adam@1494:              TextIO.output (outf, "\t\tpadding: 5px;\n");
adam@1494:              TextIO.output (outf, "\t\tfont-size: larger;\n");
adam@1494:              TextIO.output (outf, "\t}\n");
adam@1496:              TextIO.output (outf, "\th2 {\n");
adam@1496:              TextIO.output (outf, "\t\tfont-family: Arial;\n");
adam@1496:              TextIO.output (outf, "\t\tfont-size: 20pt;\n");
adam@1496:              TextIO.output (outf, "\t\tbackground-color: #99FF99;\n");
adam@1496:              TextIO.output (outf, "\t\tpadding: 5px;\n");
adam@1496:              TextIO.output (outf, "\t}\n");
adam@1497:              TextIO.output (outf, "\ta:link {\n");
adam@1497:              TextIO.output (outf, "\t\ttext-decoration: underline;\n");
adam@1497:              TextIO.output (outf, "\t\tcolor: blue;\n");
adam@1497:              TextIO.output (outf, "\t}\n");
adam@1497:              TextIO.output (outf, "\ta:visited {\n");
adam@1497:              TextIO.output (outf, "\t\ttext-decoration: underline;\n");
adam@1497:              TextIO.output (outf, "\t\tcolor: red;\n");
adam@1497:              TextIO.output (outf, "\t}\n");
adam@1494:              TextIO.output (outf, "-->\n");
adam@1494:              TextIO.output (outf, "</style>\n");
adam@1494:              TextIO.output (outf, "<title>");
adam@1494:              TextIO.output (outf, title);
adam@1494:              let
adam@1494:                  val (befor, after) = Substring.position "</title>" after
adam@1494:              in
adam@1494:                  if Substring.isEmpty after then
adam@1494:                      raise Fail ("Missing </title> for " ^ title)
adam@1494:                  else
adam@1494:                      let
adam@1494:                          val (befor, after) = Substring.position "<body>" after
adam@1494:                      in
adam@1494:                          if Substring.isEmpty after then
adam@1494:                              raise Fail ("Missing <body> for " ^ title)
adam@1494:                          else
adam@1494:                              (TextIO.outputSubstr (outf, befor);
adam@1494:                               TextIO.output (outf, "<body><h1>");
adam@1494:                               TextIO.output (outf, title);
adam@1494:                               TextIO.output (outf, "</h1>");
adam@1494:                               loop (Substring.slice (after, 6, NONE)))
adam@1494:                      end
adam@1494:              end;
adam@1494:              TextIO.closeOut outf)
adam@1494:     end
adam@1493: 
adam@1493: fun doUr fname =
adam@1493:     let
adam@1494:         val inf = TextIO.openIn fname
adam@1494: 
adam@1494:         val title = case TextIO.inputLine inf of
adam@1494:                         NONE => raise Fail ("No title comment at start of " ^ fname)
adam@1494:                       | SOME title => title
adam@1494: 
adam@1494:         val title = String.substring (title, 3, size title - 7)
adam@1494: 
adam@1493:         val eval = TextIO.openOut "/tmp/eval.ur"
adam@1493:         val gen = TextIO.openOut "/tmp/gen.ur"
adam@1493: 
adam@1493:         fun untilEnd source =
adam@1493:             let
adam@1493:                 val (befor, after) = Substring.position "(* end *)" source
adam@1493:             in
adam@1493:                 if Substring.isEmpty after then
adam@1493:                     (source, Substring.full "")
adam@1493:                 else
adam@1493:                     (befor, Substring.slice (after, 9, NONE))
adam@1493:             end
adam@1493: 
adam@1493:         fun doDirectives (count, source) =
adam@1493:             let
adam@1493:                 val safe = String.translate (fn #"<" => "&lt;"
adam@1493:                                               | #"&" => "&amp;"
adam@1493:                                               | #"{" => "&#123;"
adam@1493:                                               | #"(" => "&#40;"
adam@1493:                                               | #"\n" => "&#40;*NL*)\n"
adam@1493:                                               | ch => str ch) o Substring.string
adam@1493: 
adam@1493:                 val (befor, after) = Substring.position "(* begin " source
adam@1493: 
adam@1493:                 fun default () = (TextIO.outputSubstr (eval, source);
adam@1493:                                   TextIO.output (gen, safe source))
adam@1493:             in
adam@1493:                 if Substring.isEmpty after then
adam@1493:                     default ()
adam@1493:                 else
adam@1493:                     let
adam@1493:                         val (command, after) = Substring.splitl (not o Char.isSpace) (Substring.slice (after, 9, NONE))
adam@1493:                     in
adam@1493:                         if Substring.isEmpty after then
adam@1493:                             default ()
adam@1493:                         else
adam@1493:                             let
adam@1493:                                 val (_, rest) = Substring.position "*)" after
adam@1493:                             in
adam@1493:                                 if Substring.isEmpty rest then
adam@1493:                                     default ()
adam@1493:                                 else
adam@1493:                                     let
adam@1493:                                         val (arg, source) = untilEnd (Substring.slice (rest, 3, NONE))
adam@1493:                                         val () = (TextIO.outputSubstr (eval, befor);
adam@1493:                                                   TextIO.output (gen, safe befor))
adam@1493:                                         val (count, skip) =
adam@1493:                                             case Substring.string command of
adam@1493:                                                 "hide" => (TextIO.outputSubstr (eval, arg);
adam@1493:                                                            (count, true))
adam@1493:                                               | "eval" => (TextIO.output (eval, "val _eval");
adam@1493:                                                            TextIO.output (eval, Int.toString count);
adam@1493:                                                            TextIO.output (eval, " = ");
adam@1493:                                                            TextIO.outputSubstr (eval, arg);
adam@1493:                                                            TextIO.output (eval, "\n\n");
adam@1493: 
adam@1493:                                                            TextIO.output (gen, safe arg);
adam@1493:                                                            TextIO.output (gen, "== {[_eval");
adam@1493:                                                            TextIO.output (gen, Int.toString count);
adam@1493:                                                            TextIO.output (gen, "]}");
adam@1493: 
adam@1493:                                                            (count + 1, false))
adam@1493:                                               | s => raise Fail ("Unknown tutorial directive: " ^ s)
adam@1493:                                     in
adam@1493:                                         doDirectives (count, if skip then
adam@1493:                                                                  #2 (Substring.splitl Char.isSpace source)
adam@1493:                                                              else
adam@1493:                                                                  source)
adam@1493:                                     end
adam@1493:                             end
adam@1493:                     end
adam@1493:             end
adam@1493:     in
adam@1494:         doDirectives (0, readAll inf);
adam@1493:         TextIO.closeOut gen;
adam@1493: 
adam@1493:         TextIO.output (eval, "\n\nfun main () : transaction page =\nreturn <xml><body>");
adam@1494:         TextIO.outputSubstr (eval, readAllFile "/tmp/gen.ur");
adam@1493:         TextIO.output (eval, "</body></xml>");
adam@1493:         TextIO.closeOut eval;
adam@1493: 
adam@1493:         if Compiler.compile "/tmp/eval" then
adam@1493:             let
adam@1493:                 val proc = Unix.execute ("/bin/sh", ["-c", "/tmp/eval.exe /main"])
adam@1493:                 val inf = Unix.textInstreamOf proc
adam@1494:                 val s = readAll inf
adam@1493:                 val _ = Unix.reap proc
adam@1493: 
adam@1493:                 val (befor, after) = Substring.position "<sc>" s
adam@1493:             in
adam@1493:                 if Substring.isEmpty after then
adam@1493:                     print ("Bad output for " ^ fname ^ "! [1]\n")
adam@1493:                 else
adam@1493:                     let
adam@1493:                         val after = Substring.slice (after, 4, NONE)
adam@1493:                         val (befor, after) = Substring.position "</body>" after
adam@1493:                     in
adam@1493:                         if Substring.isEmpty after then
adam@1493:                             print ("Bad output for " ^ fname ^ "! [2]\n")
adam@1493:                         else
adam@1493:                             let
adam@1493:                                 val outf = TextIO.openOut "/tmp/final.ur"
adam@1493: 
adam@1493:                                 fun eatNls source =
adam@1493:                                     let
adam@1493:                                         val (befor, after) = Substring.position "(*NL*)" source
adam@1493:                                     in
adam@1493:                                         if Substring.isEmpty after then
adam@1493:                                             TextIO.outputSubstr (outf, source)
adam@1493:                                         else
adam@1493:                                             (TextIO.outputSubstr (outf, befor);
adam@1493:                                              eatNls (Substring.slice (after, 6, NONE)))
adam@1493:                                     end
adam@1493: 
adam@1493:                                 val cmd = "emacs --eval \"(progn "
adam@1493:                                           ^ "(global-font-lock-mode t) "
adam@1493:                                           ^ "(add-to-list 'load-path \\\""
adam@1493:                                           ^ Config.sitelisp
adam@1493:                                           ^ "/\\\") "
adam@1493:                                           ^ "(load \\\"urweb-mode-startup\\\") "
adam@1493:                                           ^ "(urweb-mode) "
adam@1497:                                           ^ "(find-file \\\"/tmp/final2.ur\\\") "
adam@1493:                                           ^ "(switch-to-buffer (htmlize-buffer)) "
adam@1494:                                           ^ "(write-file \\\"/tmp/final.html\\\") "
adam@1493:                                           ^ "(kill-emacs))\""
adam@1493:                             in
adam@1493:                                 eatNls befor;
adam@1493:                                 TextIO.closeOut outf;
adam@1497:                                 ignore (OS.Process.system "sed -e 's/&lt;/</g;s/&amp;/\\&/g' </tmp/final.ur >/tmp/final2.ur");
adam@1494:                                 ignore (OS.Process.system cmd);
adam@1494:                                 fixupFile (fname, title)
adam@1493:                             end
adam@1493:                     end
adam@1493:             end
adam@1493:         else
adam@1493:             ()
adam@1493:     end
adam@1493: 
adam@1493: fun make dirname =
adam@1493:     let
adam@1493:         val dir = OS.FileSys.openDir dirname
adam@1493: 
adam@1493:         fun doDir () =
adam@1493:             case OS.FileSys.readDir dir of
adam@1493:                 NONE => OS.FileSys.closeDir dir
adam@1493:               | SOME fname =>
adam@1493:                 (if OS.Path.ext fname = SOME "ur" then
adam@1493:                      doUr (OS.Path.joinDirFile {dir = dirname, file = fname})
adam@1493:                  else
adam@1493:                      ();
adam@1493:                  doDir ())
adam@1493:     in
adam@1493:         Settings.setProtocol "static";
adam@1493:         doDir ()
adam@1493:     end
adam@1493: 
adam@1493: end