summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--forum/asker.ur26
-rw-r--r--forum/asker.urs17
-rw-r--r--forum/forum.ur19
-rw-r--r--forum/lib.urp2
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