Commit | Line | Data |
---|---|---|
c0a3b488 AC |
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 | ||
37 | fun inPath (CONFIG {inPath, ...}) = inPath | |
38 | fun outPath (CONFIG {outPath, ...}) = outPath | |
39 | fun pubPath (CONFIG {pubPath, ...}) = pubPath | |
40 | fun lib (CONFIG {lib, ...}) = lib | |
41 | fun sml (CONFIG {sml, ...}) = sml | |
42 | fun compiler (CONFIG {compiler, ...}) = compiler | |
43 | fun cm (CONFIG {cm, ...}) = cm | |
44 | fun printFn (CONFIG {printFn, ...}) s = StringMap.find (printFn, s) | |
45 | ||
46 | fun expandPath path = | |
47 | if size path >= 1 andalso String.sub (path, 0) <> #"/" then | |
48 | OS.FileSys.getDir () ^ "/" ^ path | |
49 | else | |
50 | path | |
51 | ||
52 | fun read fname (config as CONFIG fields) = | |
53 | let | |
54 | val inf = TextIO.openIn fname | |
55 | ||
56 | fun read (fields as {inPath, outPath, pubPath, lib, compiler, cm, sml, printFn}) = | |
57 | (case TextIO.inputLine inf of | |
58 | "" => CONFIG fields | |
59 | | line => | |
60 | (case String.tokens Char.isSpace line of | |
61 | [] => read fields | |
62 | | ["in", inPath] => read {inPath = expandPath inPath, outPath = outPath, pubPath = pubPath, | |
63 | lib = lib, compiler = compiler, printFn = printFn, | |
64 | cm = cm, sml = sml} | |
65 | | ["out", outPath] => read {inPath = inPath, outPath = expandPath outPath, pubPath = pubPath, | |
66 | lib = lib, compiler = compiler, printFn = printFn, | |
67 | cm = cm, sml = sml} | |
68 | | ["pub", pubPath] => read {inPath = inPath, outPath = outPath, pubPath = expandPath pubPath, | |
69 | lib = lib, compiler = compiler, printFn = printFn, | |
70 | cm = cm, sml = sml} | |
71 | | ["lib", lib] => read {inPath = inPath, outPath = outPath, pubPath = pubPath, | |
72 | lib = lib, compiler = compiler, printFn = printFn, | |
73 | cm = cm, sml = sml} | |
74 | | ["compiler", compiler] => read {inPath = inPath, outPath = outPath, pubPath = pubPath, | |
75 | lib = lib, compiler = compiler, printFn = printFn, | |
76 | cm = cm, sml = sml} | |
77 | | ["sml", sml] => read {inPath = inPath, outPath = outPath, pubPath = pubPath, | |
78 | lib = lib, compiler = compiler, printFn = printFn, | |
79 | cm = cm, sml = sml} | |
80 | | "print"::rest => | |
81 | let | |
82 | fun split ([], _) = (print "Bad printFn directive\n"; | |
83 | read fields) | |
84 | | split ("="::after, befor) = | |
85 | let | |
86 | val befor = rev befor | |
87 | fun toS [] = "" | |
88 | | toS (h::t) = foldl (fn (s, acc) => acc ^ " " ^ s) h t | |
89 | val printFn = StringMap.insert (printFn, toS befor, toS after) | |
90 | in | |
91 | read {inPath = inPath, outPath = outPath, pubPath = pubPath, | |
92 | lib = lib, compiler = compiler, printFn = printFn, | |
93 | cm = cm, sml = sml} | |
94 | end | |
95 | | split (h::after, befor) = split (after, h::befor) | |
96 | in | |
97 | split (rest, []) | |
98 | end | |
99 | | ["cm", fname] => read {inPath = inPath, outPath = outPath, pubPath = pubPath, | |
100 | lib = lib, compiler = compiler, printFn = printFn, | |
101 | cm = fname::cm, sml = sml} | |
102 | | _ => (print "Unknown config directive\n"; | |
103 | read fields))) | |
104 | in | |
105 | read fields | |
106 | before TextIO.closeIn inf | |
107 | end handle Io => config | |
108 | ||
109 | fun default () = | |
110 | let | |
111 | val cwd = OS.FileSys.getDir () | |
112 | ||
113 | val base = CONFIG {lib = "/usr/local/share/mlt/src/lib/sources.cm", | |
114 | compiler = "/usr/local/share/mlt/src/sources.cm", | |
115 | sml = "/usr/local/sml/bin", | |
116 | inPath = cwd, | |
117 | outPath = cwd, | |
118 | pubPath = cwd, | |
119 | printFn = StringMap.empty, | |
120 | cm = []} | |
121 | in | |
122 | read defaultFile base | |
123 | end | |
124 | end |