From 52404be75d2996ab911800167570b103abd57aaa Mon Sep 17 00:00:00 2001
From: saturn <saturn@glxl.net>
Date: Thu, 9 Mar 2023 20:51:51 -0600
Subject: [PATCH] Initial implementation of collections.

---
 lw2.lisp         | 54 +++++++++++++++++++++++++++++++++++++++++++++++++++++-
 src/backend.lisp | 11 +++++++++++
 2 files changed, 64 insertions(+), 1 deletion(-)

diff --git a/lw2.lisp b/lw2.lisp
index ab878111..05450951 100644
--- a/lw2.lisp
+++ b/lw2.lisp
@@ -155,6 +155,45 @@
               pretty-time
 	      (pretty-time-js)))))
 
+(defun collection-to-html (collection &optional (heading-level 1))
+  (alist-bind ((title (or string null))
+	       (subtitle (or string null))
+	       (number (or fixnum null))
+	       (contents list)
+	       (posts list))
+	      collection
+	      (let* ((subcollections (cdr
+				      (find-if (lambda (x) (member (car x) '(:books :sequences :chapters) :test #'eq))
+					       collection)))
+		     (html-body (cdr (assoc :html contents))))
+		(cond
+		  ((or html-body title posts)
+		   <section>
+		     (when (or html-body title)
+		       <div class="body-text sequence-text">
+		         (when title
+			   (with-html-stream-output (:stream stream)
+			     (format stream "<h~A class=\"sequence-chapter\">~@[~A. ~]~A</h~A>"
+				     heading-level
+				     number
+				     (clean-text-to-html title)
+				     heading-level)))
+			 (when subtitle
+			   <div class="sequence-subtitle">(safe (clean-text-to-html subtitle))</div>)
+			 (when html-body
+			   (with-html-stream-output (:stream stream)
+			     (let ((*memoized-output-stream* stream)) (clean-html* html-body))))
+			 </div>)
+		     (if posts
+			 (dolist (post posts)
+			   (post-headline-to-html post))
+			 (dolist (subcollection subcollections)
+			   (collection-to-html subcollection (1+ heading-level))))
+		   </section>)
+		  (:otherwise
+		   (dolist (subcollection subcollections)
+		     (collection-to-html subcollection)))))))
+
 (defun sequence-to-html (sequence)
   (labels ((contents-to-html (contents &key title subtitle number)
 	     (let ((html-body (cdr (assoc :html contents))))
@@ -1970,7 +2009,7 @@ signaled condition to *HTML-OUTPUT*."
       (t
        (emit-rpw-page)))))
 
-(define-page view-sequences "/library"
+(define-page view-library "/library"
                             ((view :member '(:featured :community) :default :featured))
   (let ((sequences
 	 (lw2-graphql-query
@@ -2000,6 +2039,19 @@ signaled condition to *HTML-OUTPUT*."
 		  :content-class "sequence-page")
 		 (sequence-to-html sequence)))))
 
+(define-component view-collection (collection-id) ()
+		  (let ((collection (get-collection collection-id)))
+		    (renderer ()
+			      (emit-page (out-stream :title (cdr (assoc :title collection)))
+					 (collection-to-html collection)))))
+
+(define-component-routes lesswrong-viewer-site (view-sequences (standard-route :uri "/sequences") () (view-collection "oneQyj4pw77ynzwAF")))
+(define-component-routes lesswrong-viewer-site (view-codex (standard-route :uri "/codex") () (view-collection "2izXHCrmJ684AnZ5X")))
+(define-component-routes lesswrong-viewer-site (view-hpmor (standard-route :uri "/hpmor") () (view-collection "ywQvGBSojSQZTMpLh")))
+(define-component-routes ea-forum-viewer-site (view-handbook (standard-route :uri "/handbook") () (view-collection "MobebwWs2o86cS9Rd")))
+
+(define-component-routes forum-site (view-tags-index (standard-route :uri "/tags") () (view-tags-index)))
+
 (define-page view-archive (:regex "^/archive(?:/(\\d{4})|/?(?:$|\\?.*$))(?:/(\\d{1,2})|/?(?:$|\\?.*$))(?:/(\\d{1,2})|/?(?:$|\\?.*$))"
                            (year :type (mod 10000))
                            (month :type (integer 1 12))
diff --git a/src/backend.lisp b/src/backend.lisp
index 1cd1041f..c303217d 100644
--- a/src/backend.lisp
+++ b/src/backend.lisp
@@ -24,6 +24,7 @@
 	   #:get-post-comments-votes
 	   #:get-tag-comments-votes
 	   #:get-recent-comments #:get-recent-comments-json
+	   #:get-collection
 	   #:sequence-post-ids #:get-sequence #:get-post-sequence-ids #:get-sequence-post
 	   #:get-conversation-messages
 	   #:markdown-source
@@ -807,6 +808,16 @@
 		  (get-post-answer-replies post-id answers)))))))
     (lw2-graphql-query-timeout-cached fn "post-answers-json" post-id :revalidate revalidate :force-revalidate force-revalidate)))
 
+(define-backend-function get-collection (collection-id)
+  (backend-graphql
+   (lw2-graphql-query
+    (lw2-query-string :collection :single
+		      (alist :document-id collection-id)
+		      :fields `(:--id :title (:contents :html) :grid-image-id :----typename
+				      (:books :title :subtitle (:contents :html) :----typename
+					      (:sequences :title (:contents :html) :grid-image-id :----typename
+							  (:chapters :title :subtitle :number (:contents :html) (:posts ,@(request-fields :post :list nil))))))))))
+
 (defun sequence-iterate (sequence fn)
   (dolist (chapter (cdr (assoc :chapters sequence)))
     (dolist (post (cdr (assoc :posts chapter)))
-- 
2.11.4.GIT