src/lib/main.sml

   1 (*
   2  * Dynamic web page generation with Standard ML
   3  * Copyright (C) 2003  Adam Chlipala
   4  *
   5  * This library is free software; you can redistribute it and/or
   6  * modify it under the terms of the GNU Lesser General Public
   7  * License as published by the Free Software Foundation; either
   8  * version 2.1 of the License, or (at your option) any later version.
   9  *
  10  * This library is distributed in the hope that it will be useful,
  11  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  12  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13  * Lesser General Public License for more details.
  14  *
  15  * You should have received a copy of the GNU Lesser General Public
  16  * License along with this library; if not, write to the Free Software
  17  * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  18  *)
  19
  20 (* Main CGI program interface *)
  21
  22 functor MainFn (Templates : TEMPLATES) :> MAIN =
  23 struct
  24     val templates = foldl StringMap.insert' StringMap.empty Templates.templates
  25
  26     fun main (_, args) =
  27         let
  28             val _ = Cgi.init ()
  29             val cgiFields = Cgi.cgi_fieldnames ()
  30             fun mapper name = (name, Cgi.cgi_field_strings name)
  31         in
  32             Web.addHeader ("Content-type", "text/html");
  33             Web.pushParams (map mapper cgiFields);
  34             Templates.beforeFn ();
  35             case args of
  36                 [] => (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";
  37                        OS.Process.failure)
  38               | (name::_) =>
  39                 (case StringMap.find (templates, name) of
  40                      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";
  41                               OS.Process.failure)
  42                    | SOME f => (f ();
  43                                 Templates.afterFn ();
  44                                 Web.output ();
  45                                 OS.Process.success))
  46         end handle ex => (Web.setExn ex;
  47                           Web.clear ();
  48                           (Templates.exnFn ();
  49                            if Web.noOutput () then
  50                                (print "Status: 500\nContent-type: text/plain\n\nUncaught exception:\n\n";
  51                                 app (fn s => print (s ^ "\n")) (SMLofNJ.exnHistory ex))
  52                            else
  53                                Web.output ())
  54                           handle ex' => (print "Status: 500\nContent-type : text/plain\n\nUncaught exception:\n\n";
  55                                          app (fn s => print ("\t" ^ s ^ "\n")) (SMLofNJ.exnHistory ex);
  56                                          print "\nAnother exception raised in exception handler:\n\n";
  57                                          app (fn s => print ("\t" ^ s ^ "\n")) (SMLofNJ.exnHistory ex'));
  58                           OS.Process.failure)
  59 end