diff options
| -rw-r--r-- | forum/asker.ur | 26 | ||||
| -rw-r--r-- | forum/asker.urs | 17 | ||||
| -rw-r--r-- | forum/forum.ur | 19 | ||||
| -rw-r--r-- | forum/lib.urp | 2 |
4 files changed, 50 insertions, 14 deletions
diff --git a/forum/asker.ur b/forum/asker.ur new file mode 100644 index 0000000..947f20c --- /dev/null +++ b/forum/asker.ur @@ -0,0 +1,26 @@ +type asker = option string + +val eq_asker = Option.eq + +val show_asker = + mkShow ( + fn nameOpt => + case nameOpt of + None => "Anonymous" + | Some nam => nam + ) + +val read_asker = + let fun parse text = + case text of + "Anonymous" => None + | nam => Some nam + in + mkRead parse (compose Some parse) + end + +val sql_asker = sql_option_prim + +val anonymous = None + +val namedAsker = Some diff --git a/forum/asker.urs b/forum/asker.urs new file mode 100644 index 0000000..99be711 --- /dev/null +++ b/forum/asker.urs @@ -0,0 +1,17 @@ +type asker + +val anonymous : asker +val namedAsker : string -> asker + + +(********************************* Instances *********************************) + +val eq_asker : eq asker + +val show_asker : show asker + +(* 'read' producing an 'asker' is guaranteed to never fail, so you can use +'readError' with impunity. *) +val read_asker : read asker + +val sql_asker : sql_injectable asker diff --git a/forum/forum.ur b/forum/forum.ur index 9556068..2dbfcb0 100644 --- a/forum/forum.ur +++ b/forum/forum.ur @@ -21,30 +21,21 @@ functor Make(Template : sig end) = struct open Styles +open Asker table question : { Id : int, Title : string, Body : string, - Asker : option string (* 'None' if anonymous *) + Asker : asker } PRIMARY KEY Id sequence questionIdS -fun showAskerOpt (askerOpt : option string) : string = - case askerOpt of - None => "Anonymous" - | Some nam => nam - -fun readAskerOpt (text : string) : option string = - case text of - "Anonymous" => None - | nam => Some nam - (* Grabs real name out of MIT certificate. *) val getName = getenv (blessEnvVar "SSL_CLIENT_S_DN_CN") fun prettyPrintQuestion row : xbody = <xml> - <p>{[row.Question.Title]}: {[row.Question.Body]} (asked by {[showAskerOpt row.Question.Asker]})</p> + <p>{[row.Question.Title]}: {[row.Question.Body]} (asked by {[row.Question.Asker]})</p> </xml> fun main () : transaction page = @@ -61,7 +52,7 @@ fun main () : transaction page = <textarea {#Body} rows=12 cols=80 /><br /> Asking as: <select {#Asker}> - <option>{[showAskerOpt askerOpt]}</option> + <option>{[askerOpt]}</option> <option>Anonymous</option> </select> <submit action={ask} value="Ask" /> @@ -73,7 +64,7 @@ fun main () : transaction page = and ask submission = id <- nextval questionIdS; dml (INSERT INTO question (Id, Title, Body, Asker) - VALUES ({[id]}, {[submission.Title]}, {[submission.Body]}, {[readAskerOpt submission.Asker]})); + VALUES ({[id]}, {[submission.Title]}, {[submission.Body]}, {[readError submission.Asker]})); main () end diff --git a/forum/lib.urp b/forum/lib.urp index 8f0ef71..dd3456d 100644 --- a/forum/lib.urp +++ b/forum/lib.urp @@ -1,4 +1,6 @@ allow env SSL_CLIENT_S_DN_CN +$/option ../styles +asker forum |