Catch the right Io exception

[bpt/mlt.git] / src / config.sml

(*
 * Dynamic web page generation with Standard ML
 * Copyright (C) 2003-2004  Adam Chlipala
 *
 * This library is free software; you can redistribute it and/or
 * modify it under the terms of the GNU Lesser General Public
 * License as published by the Free Software Foundation; either
 * version 2.1 of the License, or (at your option) any later version.
 *
 * This library is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 * Lesser General Public License for more details.
 * 
 * You should have received a copy of the GNU Lesser General Public
 * License along with this library; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 *)

(* User-specifed runtime configuration *)

structure Config :> CONFIG =
struct
    open Settings

    datatype config =
	     CONFIG of {inPath : string, (* Directory for input sources *)
                        outPath : string, (* Working directory *)
			pubPath : string, (* Directory in which to put actual CGI scripts *)
	                lib : string, (* Path to runtime library .cm file *)
         	        compiler : string, (* Path to compiler library .cm file *)
 		        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 *)
		        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
    fun pubPath (CONFIG {pubPath, ...}) = pubPath
    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)

    fun expandPath path =
	if size path >= 1 andalso String.sub (path, 0) <> #"/" then
	    OS.FileSys.getDir () ^ "/" ^ path
	else
	    path

    fun read fname (config as CONFIG fields) =
	let
	    val inf = TextIO.openIn fname

	    fun read (fields as {inPath, outPath, pubPath, lib, compiler, cm, sml, printFn, beforeT, afterT, exnT}) =
		(case TextIO.inputLine inf of
		     NONE => CONFIG fields
		   | SOME line =>
		     (case String.tokens Char.isSpace line of
			  [] => read fields
			| ["in", inPath] => read {inPath = expandPath inPath, outPath = outPath, pubPath = pubPath,
						  lib = lib, compiler = compiler, printFn = printFn,
						  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,
						    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,
						    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,
						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,
							  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,
						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";
						   read fields)
				| split ("="::after, befor) =
				  let
				      val befor = rev befor
				      fun toS [] = ""
					| toS (h::t) = foldl (fn (s, acc) => acc ^ " " ^ s) h t
				      val printFn = StringMap.insert (printFn, toS befor, toS after)
				  in
				      read {inPath = inPath, outPath = outPath, pubPath = pubPath,
					    lib = lib, compiler = compiler, printFn = printFn,
					    cm = cm, sml = sml,
					    beforeT = beforeT, afterT = afterT, exnT = exnT}
				  end
				| split (h::after, befor) = split (after, h::befor)
			  in
			      split (rest, [])
			  end
			| ["cm", fname] => read {inPath = inPath, outPath = outPath, pubPath = pubPath,
						 lib = lib, compiler = compiler, printFn = printFn,
						 cm = fname::cm, sml = sml,
						 beforeT = beforeT, afterT = afterT, exnT = exnT}
			| _ => (print "Unknown config directive\n";
				read fields)))
	in
	    read fields
	    before TextIO.closeIn inf
	end handle IO.Io _ => config

    fun default () =
	let
	    val cwd = OS.FileSys.getDir ()
	
	    val base = CONFIG {lib = mltdir ^ "/src/lib/sources.cm",
			       compiler = mltdir ^ "/src/sources.cm",
			       sml = smlbin,
			       inPath = cwd,
			       outPath = cwd,
			       pubPath = cwd,
			       printFn = StringMap.empty,
			       cm = [],
			       beforeT = NONE,
			       afterT = NONE,
			       exnT = NONE}
	in
	    read defaultFile base
	end
end