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
  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