src/config.sml

   1 (*
   2  * Dynamic web page generation with Standard ML
   3  * Copyright (C) 2003-2004  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     open Settings
  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                      NONE => CONFIG fields
  66                    | SOME 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 = mltdir ^ "/src/lib/sources.cm",
 141                                compiler = mltdir ^ "/src/sources.cm",
 142                                sml = smlbin,
 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