Mercurial > urweb
comparison src/tag.sml @ 1946:f1485ed65d6c
Avoid some spurious error messages about link/form incompatibility; change the text of that error message to include RPC handlers
author | Adam Chlipala <adam@chlipala.net> |
---|---|
date | Sun, 29 Dec 2013 10:29:26 -0500 |
parents | 6745eafff617 |
children |
comparison
equal
deleted
inserted
replaced
1945:8b1692660dac | 1946:f1485ed65d6c |
---|---|
39 end) | 39 end) |
40 | 40 |
41 fun kind (k, s) = (k, s) | 41 fun kind (k, s) = (k, s) |
42 fun con (c, s) = (c, s) | 42 fun con (c, s) = (c, s) |
43 | 43 |
44 fun both (loc, f) = (ErrorMsg.errorAt loc ("Function " ^ f ^ " needed for both a link and a form"); | 44 fun both (loc, f) = (ErrorMsg.errorAt loc ("Function " ^ f ^ " needed for multiple modes (link, form, RPC handler)."); |
45 TextIO.output (TextIO.stdErr, | 45 TextIO.output (TextIO.stdErr, |
46 "Make sure that the signature of the containing module hides any form handlers.\n")) | 46 "Make sure that the signature of the containing module hides any form/RPC handlers.\n")) |
47 | 47 |
48 fun exp env (e, s) = | 48 fun exp env (e, s) = |
49 let | 49 let |
50 fun tagIt (e, ek : export_kind, newAttr, (count, tags, byTag, newTags)) = | 50 fun tagIt (e, ek : export_kind, newAttr, (count, tags, byTag, newTags)) = |
51 let | 51 let |
143 in | 143 in |
144 (((CName newAttr, loc), e', t), s) | 144 (((CName newAttr, loc), e', t), s) |
145 end | 145 end |
146 in | 146 in |
147 case x of | 147 case x of |
148 (CName "Link", _) => tagIt' (Link ReadWrite, "Link") | 148 (CName "Link", _) => tagIt' (Link ReadCookieWrite, "Link") |
149 | (CName "Action", _) => tagIt' (Action ReadWrite, "Action") | 149 | (CName "Action", _) => tagIt' (Action ReadWrite, "Action") |
150 | _ => ((x, e, t), s) | 150 | _ => ((x, e, t), s) |
151 end) | 151 end) |
152 s xets | 152 s xets |
153 in | 153 in |
178 | 178 |
179 | EFfiApp ("Basis", "url", [((ERel 0, _), _)]) => (e, s) | 179 | EFfiApp ("Basis", "url", [((ERel 0, _), _)]) => (e, s) |
180 | 180 |
181 | EFfiApp ("Basis", "url", [(e, t)]) => | 181 | EFfiApp ("Basis", "url", [(e, t)]) => |
182 let | 182 let |
183 val (e, s) = tagIt (e, Link ReadWrite, "Url", s) | 183 val (e, s) = tagIt (e, Link ReadCookieWrite, "Url", s) |
184 in | 184 in |
185 (EFfiApp ("Basis", "url", [(e, t)]), s) | 185 (EFfiApp ("Basis", "url", [(e, t)]), s) |
186 end | 186 end |
187 | 187 |
188 | EFfiApp ("Basis", "effectfulUrl", [((ERel 0, _), _)]) => (e, s) | 188 | EFfiApp ("Basis", "effectfulUrl", [((ERel 0, _), _)]) => (e, s) |
199 val (_, _, eo, _) = E.lookupENamed env n | 199 val (_, _, eo, _) = E.lookupENamed env n |
200 in | 200 in |
201 case eo of | 201 case eo of |
202 SOME (EAbs (_, _, _, (EFfiApp ("Basis", "url", [((ERel 0, _), t)]), _)), _) => | 202 SOME (EAbs (_, _, _, (EFfiApp ("Basis", "url", [((ERel 0, _), t)]), _)), _) => |
203 let | 203 let |
204 val (e, s) = tagIt (e', Link ReadWrite, "Url", s) | 204 val (e, s) = tagIt (e', Link ReadCookieWrite, "Url", s) |
205 in | 205 in |
206 (EFfiApp ("Basis", "url", [(e, t)]), s) | 206 (EFfiApp ("Basis", "url", [(e, t)]), s) |
207 end | 207 end |
208 | _ => (e, s) | 208 | _ => (e, s) |
209 end | 209 end |