From 46105cabdf43df49d7d17496c7487005f1315ac4 Mon Sep 17 00:00:00 2001
From: saturn <saturn@glxl.net>
Date: Sun, 26 Jun 2022 01:56:24 -0500
Subject: [PATCH] Implement two-axis voting, part 1.

---
 src/data-viewers/comment.lisp |  6 ++++--
 src/interface-utils.lisp      | 43 +++++++++++++++++++++++++++++++++++--------
 2 files changed, 39 insertions(+), 10 deletions(-)

diff --git a/src/data-viewers/comment.lisp b/src/data-viewers/comment.lisp
index d19c5e45..c1d79152 100644
--- a/src/data-viewers/comment.lisp
+++ b/src/data-viewers/comment.lisp
@@ -18,6 +18,9 @@
    (tag list :backend-type backend-lw2-tags-comments :subfields (:--id :name :slug))
    (base-score (or null fixnum))
    (af-base-score (or null fixnum))
+   (vote-count (or null fixnum))
+   (extended-score list)
+   (all-votes list :subfields (:vote-type :extended-vote-type))
    (page-url (or null string) :context-not :user-index) ; page-url sometimes causes "Cannot read property '_id' of undefined" error
    (parent-comment list :backend-type backend-lw2-tags-comments :context :index :subfields (:--id :user-id :post-id (:tag :--id :name :slug)))
    (parent-comment list :context :index :subfields (:--id :user-id :post-id))
@@ -25,7 +28,6 @@
    (child-count (or null fixnum) :graphql-ignore t)
    (children list :graphql-ignore t)
    (af boolean :backend-type backend-alignment-forum)
-   (vote-count (or null fixnum))
    (retracted boolean)
    (deleted-public boolean)
    (answer boolean :backend-type backend-q-and-a)
@@ -69,7 +71,7 @@
 	          </a>)
 	      <a class="date" href=(comment-link post-id tag comment-id) data-js-date=js-time> (safe pretty-time) (safe (pretty-time-js))</a>
 	      (when replied <a class="replied" title="You have replied to this comment" href=(apply 'generate-item-link replied)></a>)
-	      (vote-buttons base-score :with-buttons *enable-voting* :vote-count vote-count :af-score (and af af-base-score))
+	      (vote-buttons base-score :with-buttons *enable-voting* :vote-count vote-count :af-score (and af af-base-score) :extended-score extended-score :all-votes all-votes)
 	      (when af <span class="alignment-forum">AF</span>)
 	      (when post-id
 	        <a class="permalink" href=("~A/~A/~A"
diff --git a/src/interface-utils.lisp b/src/interface-utils.lisp
index 2f4d72f0..b6e85bed 100644
--- a/src/interface-utils.lisp
+++ b/src/interface-utils.lisp
@@ -58,19 +58,46 @@
               (typecase votes (integer votes) (list (length votes))))
       ""))
 
-(defun vote-buttons (base-score &key (with-buttons t) vote-count post-id af-score as-text)
+(defun vote-buttons (base-score &key (with-buttons t) vote-count post-id af-score as-text extended-score all-votes)
   (labels ((button (vote-type)
 	     (when with-buttons
 	       <button type="button" class=("vote ~A" vote-type) data-vote-type=vote-type data-target-type=(if post-id "Posts" "Comments") tabindex="-1" disabled></button>))
 	   (text ()
 	     (if (and af-score (/= af-score 0))
 		 (format nil "LW: ~A AF: ~A" base-score af-score)
-		 (pretty-number base-score "point"))))
-    (when base-score
+		 (pretty-number base-score "point")))
+	   (score-counts ()
+	     (let ((hash (make-hash-table :test 'equal)))
+	       (loop for vote in all-votes
+		  for agreement = (cdr (assoc :agreement (cdr (assoc :extended-vote-type vote))))
+		  do (when agreement
+		       (incf (gethash agreement hash 0))))
+	       hash))
+	   (extended-text (agree-count disagree-count)
+	     (format nil "~D : ~D" agree-count disagree-count))
+	   (extended-tooltip (score-counts agree-count disagree-count)
+	     (format nil "~D agree (~D strongly), ~D disagree (~D strongly); meaningless number: ~D"
+		     agree-count
+		     (gethash "bigUpvote" score-counts 0)
+		     disagree-count
+		     (gethash "bigDownvote" score-counts 0)
+		     (cdr (assoc :agreement extended-score))))
+	   (voting (class tooltip text)
+	     <div class=class data-post-id=post-id>
+	       (button "upvote")
+	       <span class="karma-value" title=tooltip>(safe text)</span>
+	       (button "downvote")
+	     </div>))
+    (when (or base-score extended-score)
       (if as-text
 	  (text)
-	  <div class="karma" data-post-id=post-id>
-            (button "upvote")
-            <span class="karma-value" title=(votes-to-tooltip vote-count)>(safe (text))</span>
-            (button "downvote")
-          </div>))))
+	  (progn
+	    (when base-score
+	      (voting "karma" (votes-to-tooltip vote-count) (text)))
+	    (when extended-score
+	      (let* ((score-counts (score-counts))
+		     (agree-count (+ (gethash "smallUpvote" score-counts 0) (gethash "bigUpvote" score-counts 0)))
+		     (disagree-count (+ (gethash "smallDownvote" score-counts 0) (gethash "bigDownvote" score-counts 0))))
+		(voting "agreement"
+			(extended-tooltip score-counts agree-count disagree-count)
+			(extended-text agree-count disagree-count)))))))))
-- 
2.11.4.GIT