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 | (* Common convenience stuff to open in several places *) | |
21 | ||
22 | structure Common = | |
23 | struct | |
24 | exception Skip | |
25 | exception Format of string | |
26 | ||
27 | fun error (pos, msg) = (ErrorMsg.error pos msg; | |
28 | raise Skip) | |
29 | ||
30 | fun error' (pos, msg) = ErrorMsg.error pos msg | |
31 | ||
32 | type 'a map = 'a StringMap.map | |
33 | ||
34 | val insert = StringMap.insert | |
35 | fun contains x = isSome (StringMap.find x) | |
36 | ||
37 | fun lookup (D, v, pos) = | |
38 | (case StringMap.find (D, v) of | |
39 | NONE => error (pos, "Unbound tycon " ^ v) | |
40 | | SOME r => r) | |
41 | ||
42 | type 'a nmap = 'a IntBinaryMap.map | |
43 | ||
44 | val ninsert = IntBinaryMap.insert | |
45 | fun ncontains x = isSome (IntBinaryMap.find x) | |
46 | ||
47 | fun nlookup (D, v, pos) = | |
48 | (case IntBinaryMap.find (D, v) of | |
49 | NONE => error (pos, "BAD: Unbound tyname or tvname " ^ Int.toString v) | |
50 | | SOME r => r) | |
51 | ||
52 | type ident = string | |
53 | ||
54 | fun indexAfter (str, i, ch) = | |
55 | let | |
56 | val sz = size str | |
57 | fun search i = | |
58 | if i >= sz then | |
59 | NONE | |
60 | else if String.sub(str, i) = ch then | |
61 | SOME i | |
62 | else | |
63 | search (i+1) | |
64 | in | |
65 | search i | |
66 | end | |
67 | ||
68 | fun indexDoubleAfter (str, i, ch) = | |
69 | let | |
70 | val sz = size str-1 | |
71 | fun search i = | |
72 | if i >= sz then | |
73 | NONE | |
74 | else if String.sub(str, i) = ch andalso String.sub(str, i+1) = ch then | |
75 | SOME i | |
76 | else | |
77 | search (i+1) | |
78 | in | |
79 | search i | |
80 | end | |
81 | ||
82 | fun index (str, ch) = indexAfter (str, 0, ch) | |
83 | ||
84 | fun strLower str = String.implode (map Char.toLower (String.explode str)) | |
85 | ||
86 | fun trim str = | |
87 | let | |
88 | fun killFront L = | |
89 | (case L of | |
90 | ch::rest => | |
91 | if Char.isSpace ch then | |
92 | killFront rest | |
93 | else | |
94 | L | |
95 | | [] => []) | |
96 | in | |
97 | String.implode (rev (killFront (rev (killFront (String.explode str))))) | |
98 | end | |
99 | ||
100 | fun copyFile (src, dst) = | |
101 | if src = dst then | |
102 | () | |
103 | else | |
104 | let | |
105 | val inf = TextIO.openIn src | |
106 | val outf = TextIO.openOut dst | |
107 | ||
108 | fun copy () = | |
109 | (case TextIO.inputLine inf of | |
110 | "" => () | |
111 | | line => (TextIO.output (outf, line); | |
112 | copy ())) | |
113 | in | |
114 | copy (); | |
115 | TextIO.closeIn inf; | |
116 | TextIO.closeOut outf | |
117 | end | |
118 | ||
119 | fun writeToFile (fname, txt) = | |
120 | let | |
121 | val outf = TextIO.openOut fname | |
122 | in | |
123 | TextIO.output (outf, txt); | |
124 | TextIO.closeOut outf | |
125 | end | |
126 | ||
127 | fun readFromFile fname = | |
128 | let | |
129 | val inf = TextIO.openIn fname | |
130 | fun read acc = | |
131 | (case TextIO.inputLine inf of | |
132 | "" => String.concat (rev acc) | |
133 | | line => read (line::acc)) | |
134 | in | |
135 | read [] | |
136 | before TextIO.closeIn inf | |
137 | end | |
138 | ||
139 | ||
140 | fun listToString (f, F, L) [] = "" | |
141 | | listToString (f, F, L) [id] = F ^ f id ^ L | |
142 | | listToString (f, F, L) (h::t) = foldl (fn (id, s) => s ^ ", " ^ f id) (F ^ f h) t ^ L | |
143 | ||
144 | fun idListToString (F, L) list = listToString (fn x => x, F, L) list | |
145 | ||
146 | val stringListToString = idListToString ("[", "]") | |
147 | ||
148 | fun urlDecode s = | |
149 | let | |
150 | fun decode (L, acc) = | |
151 | (case L of | |
152 | [] => String.implode (rev acc) | |
153 | | #"+"::L => decode (L, #" "::acc) | |
154 | | #"%"::MS::LS::L => | |
155 | (case StringCvt.scanString (Int.scan StringCvt.HEX) (str MS ^ str LS) of | |
156 | NONE => decode (L, LS::MS:: #"%"::acc) | |
157 | | SOME n => decode (L, chr n :: acc)) | |
158 | | ch::L => decode (L, ch::acc)) | |
159 | in | |
160 | decode (String.explode s, []) | |
161 | end | |
162 | ||
163 | fun pad (s, n) = | |
164 | if size s < n then | |
165 | pad ("0" ^ s, n) | |
166 | else | |
167 | s | |
168 | ||
169 | fun urlEncode s = | |
170 | let | |
171 | fun xch ch = | |
172 | if Char.isAlphaNum ch orelse ch = #"_" orelse ch = #"." orelse ch = #"-" then | |
173 | str ch | |
174 | else if ch = #" " then | |
175 | "+" | |
176 | else | |
177 | "%" ^ pad (Int.fmt StringCvt.HEX (ord ch), 2) | |
178 | in | |
179 | String.concat (map xch (String.explode s)) | |
180 | end | |
181 | ||
182 | fun stoiOpt s = Int.fromString s | |
183 | fun stoi s = | |
184 | (case Int.fromString s of | |
185 | NONE => raise Format s | |
186 | | SOME i => i) | |
187 | fun itos n = | |
188 | if n < 0 then | |
189 | "-" ^ Int.toString (~n) | |
190 | else | |
191 | Int.toString n | |
192 | ||
193 | fun storOpt s = Real.fromString s | |
194 | fun stor s = | |
195 | (case Real.fromString s of | |
196 | NONE => raise Format s | |
197 | | SOME r => r) | |
198 | fun rtos r = | |
199 | if r < 0.0 then | |
200 | "-" ^ Real.toString (~r) | |
201 | else | |
202 | Real.toString r | |
203 | ||
204 | fun html s = | |
205 | let | |
206 | fun xch #"<" = "<" | |
207 | | xch #">" = ">" | |
208 | | xch #"&" = "&" | |
209 | | xch #"\"" = """ | |
210 | | xch ch = str ch | |
211 | in | |
212 | foldr op^ "" (map xch (String.explode s)) | |
213 | end | |
214 | ||
215 | fun htmlNl s = | |
216 | let | |
217 | fun xch #"<" = "<" | |
218 | | xch #">" = ">" | |
219 | | xch #"&" = "&" | |
220 | | xch #"\"" = """ | |
221 | | xch #"\n" = "<br />" | |
222 | | xch ch = str ch | |
223 | in | |
224 | foldr op^ "" (map xch (String.explode s)) | |
225 | end | |
226 | ||
227 | fun killLf s = String.implode (List.filter (fn ch => ch <> #"\r") (String.explode s)) | |
228 | end |