Add before, after, and exn config directives

diff --git a/doc/manual.tex b/doc/manual.tex
index beb35d5..ada1809 100644 (file)
--- a/doc/manual.tex
+++ b/doc/manual.tex
@@ -48,6 +48,12 @@ Files consist of a sequence of the following kinds of lines in any order:
        \item {\tt cm {\it file}}: {\it file} is the path to a file that the SML/NJ Compilation Manager understands (i.e., {\tt .cm}, {\tt .sml}, {\tt .sig}, {\tt .grm}, {\tt .lex}). This file is to be made available to templates in the project.
 
        \item {\tt print {\it type} = {\it code}}: This declares that the given {\it code} is an SML expression that evaluates to an appropriate function for printing values of the SML {\it type}. The {\it code} should usually be the name of a function defined in a library or project SML source file.
+
+       \item {\tt before {\it template}}: Run {\it template} before every normally-requested template, including its output at the beginning of the final output. This can be used to set up project-wide global state. Performing initialization inside project SML files will not generally be good enough. This is because all of the structure definitions these contain are evaluated at ``compile time,'' causing their code not found inside function definitions to be run only once.
+
+       \item {\tt after {\it template}}: Run {\it template} after every successfully executing template, including its output at the end.
+
+       \item {\tt exn {\it template}}: Run {\it template} when an exception goes uncaught during normal template execution. The function {\tt Web.getExn : unit -> exn} can be used to retrieve the causing exception from within {\it template}. The {\tt before} and {\tt after} templates are not run in the {\tt exn} template when it is executed because of an uncaught exception.
 \end{itemize}
 
 \section{The template language}

diff --git a/src/compiler.sml b/src/compiler.sml
index e87cb57..0b6d484 100644 (file)
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -81,16 +81,23 @@ struct
        else
            ch
 
-    fun compileTemplate (config, env, templates) path =
+    fun makeName name = 
        let
-           val fname = getFname path
-           val name = removeExt fname
            val name =
                if size name >= 1 then
                    str (toUpper (String.sub (name, 0))) ^ String.extract (name, 1, NONE)
                else
                    raise Error
            val name = name ^ "_"
+       in
+           name
+       end
+
+    fun compileTemplate (config, env, templates) path =
+       let
+           val fname = getFname path
+           val name = removeExt fname
+           val name = makeName name
        in
            (name, Mlt.trans (config, env, templates, name, Parse.parse path))
        end
@@ -199,7 +206,33 @@ struct
 
            val outf = TextIO.openOut (outPath ^ "/_main.sml")
 
-           val _ = TextIO.output (outf, "structure Templates :> TEMPLATES =\nstruct\n\tval templates = [")
+           fun isTemplate x =
+               let
+                   val x = makeName x
+               in
+                   if List.exists (fn y => x = y) exports then
+                       SOME x
+                   else
+                       NONE
+               end
+           fun decide NONE = "(fn () => ())"
+             | decide (SOME t) =
+               (case isTemplate t of
+                    SOME t => t ^ ".exec"
+                  | _ => (err_flag := true;
+                          print ("Template " ^ t ^ " specified in mlt.conf does not exist!\n");
+                          "(fn () => ())"))
+           val beforeT = decide (Config.beforeT config)
+           val afterT = decide (Config.afterT config)
+           val exnT = decide (Config.exnT config)
+
+           val _ = (TextIO.output (outf, "structure Templates :> TEMPLATES =\nstruct\n\tval beforeFn =");
+                    TextIO.output (outf, beforeT);
+                    TextIO.output (outf, "\n\tval afterFn = ");
+                    TextIO.output (outf, afterT);
+                    TextIO.output (outf, "\n\tval exnFn = ");
+                    TextIO.output (outf, exnT);
+                    TextIO.output (outf, "\n\n\tval templates = ["))
            val _ = (case exports of
                         [] => ()
                       | (exp::rest) => (TextIO.output (outf, "(\"" ^ exp ^ "\", " ^ exp ^ ".exec)");

diff --git a/src/config.sig b/src/config.sig
index 57c0f86..e8e49bb 100644 (file)
--- a/src/config.sig
+++ b/src/config.sig
@@ -33,6 +33,9 @@ sig
     val compiler : config -> string
     val cm : config -> string list
     val sml : config -> string
+    val beforeT : config -> string option
+    val afterT : config -> string option
+    val exnT : config -> string option
 
     val printFn : config -> string -> string option
 end
\ No newline at end of file

diff --git a/src/config.sml b/src/config.sml
index d021359..691f714 100644 (file)
--- a/src/config.sml
+++ b/src/config.sml
@@ -32,7 +32,11 @@ struct
                        sml : string, (* Path to sml program *)
                         printFn : string StringMap.map, (* Map from SML type names to text for functions to print
                                                         * their values *)
-                       cm : string list (* List of extra SML/CM files to use with this project *)}
+                       cm : string list, (* List of extra SML/CM files to use with this project *)
+                       beforeT : string option, (* Template to run before every template execution *)
+                       afterT : string option, (* Template to run after every successful template execution *)
+                       exnT : string option (* Template to run after every template execution
+                                             * ending in an uncaught exception *)}
 
     fun inPath (CONFIG {inPath, ...}) = inPath
     fun outPath (CONFIG {outPath, ...}) = outPath
@@ -40,6 +44,9 @@ struct
     fun lib (CONFIG {lib, ...}) = lib
     fun sml (CONFIG {sml, ...}) = sml
     fun compiler (CONFIG {compiler, ...}) = compiler
+    fun beforeT (CONFIG {beforeT, ...}) = beforeT
+    fun afterT (CONFIG {afterT, ...}) = afterT
+    fun exnT (CONFIG {exnT, ...}) = exnT
     fun cm (CONFIG {cm, ...}) = cm
     fun printFn (CONFIG {printFn, ...}) s = StringMap.find (printFn, s)
 
@@ -53,7 +60,7 @@ struct
        let
            val inf = TextIO.openIn fname
 
-           fun read (fields as {inPath, outPath, pubPath, lib, compiler, cm, sml, printFn}) =
+           fun read (fields as {inPath, outPath, pubPath, lib, compiler, cm, sml, printFn, beforeT, afterT, exnT}) =
                (case TextIO.inputLine inf of
                     "" => CONFIG fields
                   | line =>
@@ -61,22 +68,40 @@ struct
                          [] => read fields
                        | ["in", inPath] => read {inPath = expandPath inPath, outPath = outPath, pubPath = pubPath,
                                                  lib = lib, compiler = compiler, printFn = printFn,
-                                                 cm = cm, sml = sml}
+                                                 cm = cm, sml = sml,
+                                                 beforeT = beforeT, afterT = afterT, exnT = exnT}
                        | ["out", outPath] => read {inPath = inPath, outPath = expandPath outPath, pubPath = pubPath,
                                                    lib = lib, compiler = compiler, printFn = printFn,
-                                                   cm = cm, sml = sml}
+                                                   cm = cm, sml = sml,
+                                                   beforeT = beforeT, afterT = afterT, exnT = exnT}
                        | ["pub", pubPath] => read {inPath = inPath, outPath = outPath, pubPath = expandPath pubPath,
                                                    lib = lib, compiler = compiler, printFn = printFn,
-                                                   cm = cm, sml = sml}
+                                                   cm = cm, sml = sml,
+                                                   beforeT = beforeT, afterT = afterT, exnT = exnT}
                        | ["lib", lib] => read {inPath = inPath, outPath = outPath, pubPath = pubPath,
                                                lib = lib, compiler = compiler, printFn = printFn,
-                                               cm = cm, sml = sml}
+                                               cm = cm, sml = sml,
+                                               beforeT = beforeT, afterT = afterT, exnT = exnT}
                        | ["compiler", compiler] => read {inPath = inPath, outPath = outPath, pubPath = pubPath,
                                                          lib = lib, compiler = compiler, printFn = printFn,
-                                                         cm = cm, sml = sml}
+                                                         cm = cm, sml = sml,
+                                                         beforeT = beforeT, afterT = afterT, exnT = exnT}
                        | ["sml", sml] => read {inPath = inPath, outPath = outPath, pubPath = pubPath,
                                                lib = lib, compiler = compiler, printFn = printFn,
-                                               cm = cm, sml = sml}
+                                               cm = cm, sml = sml,
+                                               beforeT = beforeT, afterT = afterT, exnT = exnT}
+                       | ["before", beforeT] => read {inPath = inPath, outPath = expandPath outPath, pubPath = pubPath,
+                                                      lib = lib, compiler = compiler, printFn = printFn,
+                                                      cm = cm, sml = sml,
+                                                      beforeT = SOME beforeT, afterT = afterT, exnT = exnT}
+                       | ["after", afterT] => read {inPath = inPath, outPath = outPath, pubPath = expandPath pubPath,
+                                                    lib = lib, compiler = compiler, printFn = printFn,
+                                                    cm = cm, sml = sml,
+                                                    beforeT = beforeT, afterT = SOME afterT, exnT = exnT}
+                       | ["exn", exnT] => read {inPath = inPath, outPath = outPath, pubPath = pubPath,
+                                                lib = lib, compiler = compiler, printFn = printFn,
+                                                cm = cm, sml = sml,
+                                                beforeT = beforeT, afterT = afterT, exnT = SOME exnT}
                        | "print"::rest =>
                          let
                              fun split ([], _) = (print "Bad printFn directive\n";
@@ -90,7 +115,8 @@ struct
                                  in
                                      read {inPath = inPath, outPath = outPath, pubPath = pubPath,
                                            lib = lib, compiler = compiler, printFn = printFn,
-                                           cm = cm, sml = sml}
+                                           cm = cm, sml = sml,
+                                           beforeT = beforeT, afterT = afterT, exnT = exnT}
                                  end
                                | split (h::after, befor) = split (after, h::befor)
                          in
@@ -98,7 +124,8 @@ struct
                          end
                        | ["cm", fname] => read {inPath = inPath, outPath = outPath, pubPath = pubPath,
                                                 lib = lib, compiler = compiler, printFn = printFn,
-                                                cm = fname::cm, sml = sml}
+                                                cm = fname::cm, sml = sml,
+                                                beforeT = beforeT, afterT = afterT, exnT = exnT}
                        | _ => (print "Unknown config directive\n";
                                read fields)))
        in
@@ -111,13 +138,16 @@ struct
            val cwd = OS.FileSys.getDir ()
        
            val base = CONFIG {lib = "/usr/local/share/mlt/src/lib/sources.cm",
-                   compiler = "/usr/local/share/mlt/src/sources.cm",
-                   sml = "/usr/local/sml/bin",
-                   inPath = cwd,
-                   outPath = cwd,
-                   pubPath = cwd,
-                   printFn = StringMap.empty,
-                   cm = []}
+                              compiler = "/usr/local/share/mlt/src/sources.cm",
+                              sml = "/usr/local/sml/bin",
+                              inPath = cwd,
+                              outPath = cwd,
+                              pubPath = cwd,
+                              printFn = StringMap.empty,
+                              cm = [],
+                              beforeT = NONE,
+                              afterT = NONE,
+                              exnT = NONE}
        in
            read defaultFile base
        end

diff --git a/src/lib/main.sml b/src/lib/main.sml
index b058cce..157afaa 100644 (file)
--- a/src/lib/main.sml
+++ b/src/lib/main.sml
@@ -30,6 +30,7 @@ struct
            fun mapper name = (name, Cgi.cgi_field_strings name)
        in
            Web.pushParams (map mapper cgiFields);
+           Templates.beforeFn ();
            case args of
                [] => (print "Status: 500\nContent-type: text/html\n\n<html><head><title>500 error</title></head><body><h2>500 error</h2>No template was specified</body></html>\n";
                       OS.Process.failure)
@@ -38,12 +39,16 @@ struct
                     NONE => (print "Status: 404\nContent-type: text/html\n\n<html><head><title>404 error</title></head><body><h2>404 error</h2>Template not found</body></html>\n";
                              OS.Process.failure)
                   | SOME f => (f ();
+                               Templates.afterFn ();
                                Web.output ();
                                OS.Process.success))
-       end handle Fail msg => (print "Status: 500\nContent-type: text/plain\n\nFatal error: \n\n";
-                               print msg;
-                               OS.Process.failure)
-                | ex => (print "Status: 500\nContent-type: text/plain\n\nAn exception!\n\n";
-                         app (fn s => print (s ^ "\n")) (SMLofNJ.exnHistory ex);
+       end handle ex => (Web.setExn ex;
+                         Web.clear ();
+                         Templates.exnFn ();
+                         if Web.noOutput () then
+                             (print "Status: 500\nContent-type: text/plain\n\nAn exception!\n\n";
+                              app (fn s => print (s ^ "\n")) (SMLofNJ.exnHistory ex))
+                         else
+                             Web.output ();
                          OS.Process.failure)
 end
\ No newline at end of file

diff --git a/src/lib/templates.sig b/src/lib/templates.sig
index 54650ae..bb5137c 100644 (file)
--- a/src/lib/templates.sig
+++ b/src/lib/templates.sig
@@ -22,4 +22,8 @@
 signature TEMPLATES =
 sig
     val templates : (string * (unit -> unit)) list
+
+    val beforeFn : unit -> unit
+    val afterFn : unit -> unit
+    val exnFn : unit -> unit
 end
\ No newline at end of file

diff --git a/src/lib/web.sig b/src/lib/web.sig
index 1b1e690..b6b9830 100644 (file)
--- a/src/lib/web.sig
+++ b/src/lib/web.sig
@@ -24,6 +24,8 @@ sig
     val for : (int -> unit) -> int * int -> unit
 
     val print : string -> unit
+    val clear : unit -> unit
+    val noOutput : unit -> bool
     val output : unit -> unit
 
     val setParam : string * string list -> unit
@@ -45,4 +47,7 @@ sig
     val stor : string -> real
 
     val summary : unit -> string
+
+    val getExn : unit -> exn
+    val setExn : exn -> unit
 end
\ No newline at end of file

diff --git a/src/lib/web.sml b/src/lib/web.sml
index 6d81d5b..a446e62 100644 (file)
--- a/src/lib/web.sml
+++ b/src/lib/web.sml
@@ -81,7 +81,8 @@ struct
     val text = ref ([] : string list)
 
     fun print x = text := x :: (!text)
-
+    fun clear () = text := []
+    fun noOutput () = !text = []
     fun output () =
        (TextIO.print "Status: 200\nContent-type: text/html\n\n";
         TextIO.print (String.concat (List.rev (!text))))
@@ -128,4 +129,8 @@ struct
     fun summary () =
        StringMap.foldli (fn (n, vs, s) => foldl (fn (v, s) => s ^ " VALUE: " ^ v) (s ^ " NAME: " ^ n) vs)
        "" (!params)
+
+    val exn = ref (NONE : exn option)
+    fun setExn ex = exn := SOME ex
+    fun getExn () = valOf (!exn)
 end
\ No newline at end of file