Mercurial > urweb

comparison src/settings.sml @ 768:3b7e46790fa7

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Path rewriting
author Adam Chlipala <adamc@hcoop.net>
date Sat, 02 May 2009 13:23:07 -0400
parents df09c95085f8
children efceae06df17
comparison
equal deleted inserted replaced
767:d27ed5ddeb52 768:3b7e46790fa7
145 ("onServerError", "onServerError")] 145 ("onServerError", "onServerError")]
146 val jsFuncs = ref jsFuncsBase 146 val jsFuncs = ref jsFuncsBase
147 fun setJsFuncs ls = jsFuncs := foldl (fn ((k, v), m) => M.insert (m, k, v)) jsFuncsBase ls 147 fun setJsFuncs ls = jsFuncs := foldl (fn ((k, v), m) => M.insert (m, k, v)) jsFuncsBase ls
148 fun jsFunc x = M.find (!jsFuncs, x) 148 fun jsFunc x = M.find (!jsFuncs, x)
149 149
150 datatype pattern_kind = Exact | Prefix
151 datatype action = Allow | Deny
152 type rule = { action : action, kind : pattern_kind, pattern : string }
153
154 datatype path_kind = Any | Url | Table | Sequence | View | Relation | Cookie | Style
155 type rewrite = { pkind : path_kind, kind : pattern_kind, from : string, to : string }
156
157 val rewrites = ref ([] : rewrite list)
158
159 fun subsume (pk1, pk2) =
160 pk1 = pk2
161 orelse pk2 = Any
162 orelse pk2 = Relation andalso (pk1 = Table orelse pk1 = Sequence orelse pk1 = View)
163
164 fun setRewriteRules ls = rewrites := ls
165 fun rewrite pk s =
166 let
167 fun rew (ls : rewrite list) =
168 case ls of
169 [] => s
170 | rewr :: ls =>
171 let
172 fun match () =
173 case #kind rewr of
174 Exact => if #from rewr = s then
175 SOME (size s)
176 else
177 NONE
178 | Prefix => if String.isPrefix (#from rewr) s then
179 SOME (size (#from rewr))
180 else
181 NONE
182 in
183 if subsume (pk, #pkind rewr) then
184 case match () of
185 NONE => rew ls
186 | SOME suffixStart => #to rewr ^ String.extract (s, suffixStart, NONE)
187 else
188 rew ls
189 end
190 in
191 rew (!rewrites)
192 end
193
150 end 194 end