diff options
| -rw-r--r-- | forum/entryClass.ur | 9 | ||||
| -rw-r--r-- | forum/entryClass.urs | 11 | ||||
| -rw-r--r-- | forum/forum.ur | 56 | ||||
| -rw-r--r-- | forum/lib.urp | 1 |
4 files changed, 74 insertions, 3 deletions
diff --git a/forum/entryClass.ur b/forum/entryClass.ur new file mode 100644 index 0000000..26f3c58 --- /dev/null +++ b/forum/entryClass.ur @@ -0,0 +1,9 @@ +type entryClass = int + +val eq_entryClass = eq_int + +val sql_entryClass = sql_prim + +val question = 0 + +val answer = 1 diff --git a/forum/entryClass.urs b/forum/entryClass.urs new file mode 100644 index 0000000..acd5c79 --- /dev/null +++ b/forum/entryClass.urs @@ -0,0 +1,11 @@ +type entryClass + +val question : entryClass +val answer : entryClass + + +(********************************* Instances *********************************) + +val eq_entryClass : eq entryClass + +val sql_entryClass : sql_injectable entryClass diff --git a/forum/forum.ur b/forum/forum.ur index 3c376ec..6dc451a 100644 --- a/forum/forum.ur +++ b/forum/forum.ur @@ -29,6 +29,7 @@ style entryTitle style entryBody table entry : { Id : int, + Class : EntryClass.entryClass, Title : string, Body : string, Author : author @@ -39,10 +40,53 @@ sequence entryIdS val getName : transaction (option string) = getenv (blessEnvVar "SSL_CLIENT_S_DN_CN") + +(***************************** Single questions ******************************) + +fun detail (id : int) : transaction page = + authorOpt <- getName; + queryX (SELECT * FROM entry + WHERE Entry.Class = {[EntryClass.question]} + AND Entry.Id = {[id]}) (fn q => + Template.generic (Some "Forum") <xml> + <div class={content}> + <h2>{[q.Entry.Title]}</h2> + <p>{[q.Entry.Body]}</p> + <p class={entryMetadata}>Asked by {[q.Entry.Author]}</p> + + <h3>Your answer</h3> + <form> + <textarea {#Body} class={entryBody} /><br /> + Answering as: + <select {#Author}> + {case authorOpt of + None => <xml/> + | Some nam => <xml><option>{[nam]}</option></xml>} + <option>Anonymous</option> + </select> + <submit action={reply id} value="Answer" /> + </form> + </div> + </xml> + ) + +and reply qId submission = + id <- nextval entryIdS; + dml (INSERT INTO entry (Id, Class, Title, Body, Author) + VALUES ({[id]}, + {[EntryClass.answer]}, + {[""]}, + {[submission.Body]}, + {[readError submission.Author]})); + detail qId + + +(**************************** Lists of questions *****************************) + fun prettyPrintQuestion row : xbody = <xml> <li> - <h3>{[row.Entry.Title]}</h3> + <h3><a link={detail row.Entry.Id}>{[row.Entry.Title]}</a></h3> {[row.Entry.Body]} <span class={entryMetadata}>Asked by {[row.Entry.Author]}</span> </li> @@ -50,6 +94,7 @@ fun prettyPrintQuestion row : xbody = val allQuestions : transaction page = questionsList <- queryX (SELECT * FROM entry + WHERE Entry.Class = {[EntryClass.question]} ORDER BY Entry.Id DESC) prettyPrintQuestion; return ( @@ -65,6 +110,7 @@ val allQuestions : transaction page = fun main () : transaction page = newestQuestions <- queryX (SELECT * FROM entry + WHERE Entry.Class = {[EntryClass.question]} ORDER BY Entry.Id DESC LIMIT 5) prettyPrintQuestion; @@ -97,8 +143,12 @@ fun main () : transaction page = and ask submission = id <- nextval entryIdS; - dml (INSERT INTO entry (Id, Title, Body, Author) - VALUES ({[id]}, {[submission.Title]}, {[submission.Body]}, {[readError submission.Author]})); + dml (INSERT INTO entry (Id, Class, Title, Body, Author) + VALUES ({[id]}, + {[EntryClass.question]}, + {[submission.Title]}, + {[submission.Body]}, + {[readError submission.Author]})); main () end diff --git a/forum/lib.urp b/forum/lib.urp index 687859e..d3eeb3d 100644 --- a/forum/lib.urp +++ b/forum/lib.urp @@ -6,4 +6,5 @@ rewrite style Main/Forum/ Forum/ $/option ../styles author +entryClass forum |