Add before, after, and exn config directives
[bpt/mlt.git] / src / config.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 (* User-specifed runtime configuration *)
21
22 structure Config :> CONFIG =
23 struct
24 val defaultFile = "/etc/mlt.conf"
25
26 datatype config =
27 CONFIG of {inPath : string, (* Directory for input sources *)
28 outPath : string, (* Working directory *)
29 pubPath : string, (* Directory in which to put actual CGI scripts *)
30 lib : string, (* Path to runtime library .cm file *)
31 compiler : string, (* Path to compiler library .cm file *)
32 sml : string, (* Path to sml program *)
33 printFn : string StringMap.map, (* Map from SML type names to text for functions to print
34 * their values *)
35 cm : string list, (* List of extra SML/CM files to use with this project *)
36 beforeT : string option, (* Template to run before every template execution *)
37 afterT : string option, (* Template to run after every successful template execution *)
38 exnT : string option (* Template to run after every template execution
39 * ending in an uncaught exception *)}
40
41 fun inPath (CONFIG {inPath, ...}) = inPath
42 fun outPath (CONFIG {outPath, ...}) = outPath
43 fun pubPath (CONFIG {pubPath, ...}) = pubPath
44 fun lib (CONFIG {lib, ...}) = lib
45 fun sml (CONFIG {sml, ...}) = sml
46 fun compiler (CONFIG {compiler, ...}) = compiler
47 fun beforeT (CONFIG {beforeT, ...}) = beforeT
48 fun afterT (CONFIG {afterT, ...}) = afterT
49 fun exnT (CONFIG {exnT, ...}) = exnT
50 fun cm (CONFIG {cm, ...}) = cm
51 fun printFn (CONFIG {printFn, ...}) s = StringMap.find (printFn, s)
52
53 fun expandPath path =
54 if size path >= 1 andalso String.sub (path, 0) <> #"/" then
55 OS.FileSys.getDir () ^ "/" ^ path
56 else
57 path
58
59 fun read fname (config as CONFIG fields) =
60 let
61 val inf = TextIO.openIn fname
62
63 fun read (fields as {inPath, outPath, pubPath, lib, compiler, cm, sml, printFn, beforeT, afterT, exnT}) =
64 (case TextIO.inputLine inf of
65 "" => CONFIG fields
66 | line =>
67 (case String.tokens Char.isSpace line of
68 [] => read fields
69 | ["in", inPath] => read {inPath = expandPath inPath, outPath = outPath, pubPath = pubPath,
70 lib = lib, compiler = compiler, printFn = printFn,
71 cm = cm, sml = sml,
72 beforeT = beforeT, afterT = afterT, exnT = exnT}
73 | ["out", outPath] => read {inPath = inPath, outPath = expandPath outPath, pubPath = pubPath,
74 lib = lib, compiler = compiler, printFn = printFn,
75 cm = cm, sml = sml,
76 beforeT = beforeT, afterT = afterT, exnT = exnT}
77 | ["pub", pubPath] => read {inPath = inPath, outPath = outPath, pubPath = expandPath pubPath,
78 lib = lib, compiler = compiler, printFn = printFn,
79 cm = cm, sml = sml,
80 beforeT = beforeT, afterT = afterT, exnT = exnT}
81 | ["lib", lib] => read {inPath = inPath, outPath = outPath, pubPath = pubPath,
82 lib = lib, compiler = compiler, printFn = printFn,
83 cm = cm, sml = sml,
84 beforeT = beforeT, afterT = afterT, exnT = exnT}
85 | ["compiler", compiler] => read {inPath = inPath, outPath = outPath, pubPath = pubPath,
86 lib = lib, compiler = compiler, printFn = printFn,
87 cm = cm, sml = sml,
88 beforeT = beforeT, afterT = afterT, exnT = exnT}
89 | ["sml", sml] => read {inPath = inPath, outPath = outPath, pubPath = pubPath,
90 lib = lib, compiler = compiler, printFn = printFn,
91 cm = cm, sml = sml,
92 beforeT = beforeT, afterT = afterT, exnT = exnT}
93 | ["before", beforeT] => read {inPath = inPath, outPath = expandPath outPath, pubPath = pubPath,
94 lib = lib, compiler = compiler, printFn = printFn,
95 cm = cm, sml = sml,
96 beforeT = SOME beforeT, afterT = afterT, exnT = exnT}
97 | ["after", afterT] => read {inPath = inPath, outPath = outPath, pubPath = expandPath pubPath,
98 lib = lib, compiler = compiler, printFn = printFn,
99 cm = cm, sml = sml,
100 beforeT = beforeT, afterT = SOME afterT, exnT = exnT}
101 | ["exn", exnT] => read {inPath = inPath, outPath = outPath, pubPath = pubPath,
102 lib = lib, compiler = compiler, printFn = printFn,
103 cm = cm, sml = sml,
104 beforeT = beforeT, afterT = afterT, exnT = SOME exnT}
105 | "print"::rest =>
106 let
107 fun split ([], _) = (print "Bad printFn directive\n";
108 read fields)
109 | split ("="::after, befor) =
110 let
111 val befor = rev befor
112 fun toS [] = ""
113 | toS (h::t) = foldl (fn (s, acc) => acc ^ " " ^ s) h t
114 val printFn = StringMap.insert (printFn, toS befor, toS after)
115 in
116 read {inPath = inPath, outPath = outPath, pubPath = pubPath,
117 lib = lib, compiler = compiler, printFn = printFn,
118 cm = cm, sml = sml,
119 beforeT = beforeT, afterT = afterT, exnT = exnT}
120 end
121 | split (h::after, befor) = split (after, h::befor)
122 in
123 split (rest, [])
124 end
125 | ["cm", fname] => read {inPath = inPath, outPath = outPath, pubPath = pubPath,
126 lib = lib, compiler = compiler, printFn = printFn,
127 cm = fname::cm, sml = sml,
128 beforeT = beforeT, afterT = afterT, exnT = exnT}
129 | _ => (print "Unknown config directive\n";
130 read fields)))
131 in
132 read fields
133 before TextIO.closeIn inf
134 end handle Io => config
135
136 fun default () =
137 let
138 val cwd = OS.FileSys.getDir ()
139
140 val base = CONFIG {lib = "/usr/local/share/mlt/src/lib/sources.cm",
141 compiler = "/usr/local/share/mlt/src/sources.cm",
142 sml = "/usr/local/sml/bin",
143 inPath = cwd,
144 outPath = cwd,
145 pubPath = cwd,
146 printFn = StringMap.empty,
147 cm = [],
148 beforeT = NONE,
149 afterT = NONE,
150 exnT = NONE}
151 in
152 read defaultFile base
153 end
154 end