Forum: Add score tracking

4 files changed, 75 insertions, 8 deletions

diff --git a/forum/forum.ur b/forum/forum.ur
index 2a43567..592b126 100644
--- a/forum/forum.ur
+++ b/forum/forum.ur
@@ -37,10 +37,29 @@ table entry : { Id : int,
 	      } PRIMARY KEY Id
 sequence entryIdS
 
+table vote : { QuestionId : int,
+	       Author : author,
+	       Value : Score.score
+	     }
+
 (* Grabs real name out of MIT certificate. *)
 val getName : transaction (option string) =
     getenv (blessEnvVar "SSL_CLIENT_S_DN_CN")
 
+(* Like query1', but automatically dereferences the field *)
+fun queryColumn [tab ::: Name] [field ::: Name] [state ::: Type]
+		(q : sql_query [] [] [tab = [field = state]] [])
+		(f : state -> state -> state)
+		(initial : state)
+    : transaction state =
+    query q (fn row state => return (f row.tab.field state)) initial
+
+(* Sum all the votes on a single question. *)
+fun getScore (questionId : int) : transaction Score.score =
+    queryColumn (SELECT Vote.Value FROM vote
+				   WHERE Vote.QuestionId = {[questionId]})
+          Score.update
+          Score.undecided
 
 (***************************** Single questions ******************************)
 
@@ -100,20 +119,22 @@ and reply qId submission =
 
 (**************************** Lists of questions *****************************)
 
-fun prettyPrintQuestion row : xbody =
+fun prettyPrintQuestion row score : xbody =
     <xml>
       <li>
 	<h3><a link={detail row.Entry.Id}>{[row.Entry.Title]}</a></h3>
 	{[row.Entry.Body]}
-	<span class={entryMetadata}>Asked by {[row.Entry.Author]}</span>
+	<span class={entryMetadata}>Asked by {[row.Entry.Author]}; score {[score]}</span>
       </li>
     </xml>
 
 val allQuestions : transaction page =
-    questionsList <- queryX (SELECT * FROM entry
-				      WHERE Entry.Class = {[EntryClass.question]}
-				      ORDER BY Entry.Id DESC)
-			    prettyPrintQuestion;
+    questionsList <- queryX' (SELECT * FROM entry
+				       WHERE Entry.Class = {[EntryClass.question]}
+				       ORDER BY Entry.Id DESC)
+			     (fn q =>
+				 score <- getScore q.Entry.Id;
+				 return (prettyPrintQuestion q score));
     return (
         Template.generic (Some "Forum – All questions") <xml>
 	  <div class={content}>
@@ -126,11 +147,13 @@ val allQuestions : transaction page =
     )
 
 fun main () : transaction page =
-    newestQuestions <- queryX (SELECT * FROM entry
+    newestQuestions <- queryX' (SELECT * FROM entry
 					WHERE Entry.Class = {[EntryClass.question]}
 					ORDER BY Entry.Id DESC
 					LIMIT 5)
-			      prettyPrintQuestion;
+			      (fn q =>
+				  score <- getScore q.Entry.Id;
+				  return (prettyPrintQuestion q score));
     askerOpt <- getName;
     return (
         Template.generic (Some "Forum") <xml>
diff --git a/forum/lib.urp b/forum/lib.urp
index d3eeb3d..6593a1d 100644
--- a/forum/lib.urp
+++ b/forum/lib.urp
@@ -7,4 +7,5 @@ $/option
 ../styles
 author
 entryClass
+score
 forum
diff --git a/forum/score.ur b/forum/score.ur
new file mode 100644
index 0000000..48bbc01
--- /dev/null
+++ b/forum/score.ur
@@ -0,0 +1,17 @@
+type score = int
+
+val update = plus
+
+val eq_score = eq_int
+
+val show_score = show_int
+
+val sql_score = sql_prim
+val sql_summable_score = sql_summable_int
+val nullify_score = @@nullify_prim [int] sql_int
+
+val insightful = 1
+val undecided = 0
+val inane = -1
+
+fun toInt s = s
diff --git a/forum/score.urs b/forum/score.urs
new file mode 100644
index 0000000..d3e3e18
--- /dev/null
+++ b/forum/score.urs
@@ -0,0 +1,26 @@
+type score
+
+val insightful : score
+val undecided : score
+val inane : score
+
+
+(********************************* Instances *********************************)
+
+val eq_score : eq score
+
+val show_score : show score
+
+val sql_score : sql_injectable score
+val sql_summable_score : sql_summable score
+val nullify_score : nullify score (option score)
+
+
+(********************************* Updating **********************************)
+
+val update : score -> score -> score
+
+
+(******************************** Conversion *********************************)
+
+val toInt : score -> int