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.pushParams (map mapper cgiFields);
  33             case args of
  34                 [] => (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";
  35                        OS.Process.failure)
  36               | (name::_) =>
  37                 (case StringMap.find (templates, name) of
  38                      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";
  39                               OS.Process.failure)
  40                    | SOME f => (f ();
  41                                 Web.output ();
  42                                 OS.Process.success))
  43         end handle Fail msg => (print "Status: 500\nContent-type: text/plain\n\nFatal error: \n\n";
  44                                 print msg;
  45                                 OS.Process.failure)
  46                  | ex => (print "Status: 500\nContent-type: text/plain\n\nAn exception!\n\n";
  47                           app (fn s => print (s ^ "\n")) (SMLofNJ.exnHistory ex);
  48                           OS.Process.failure)
  49 end