src/data-viewers/comment.lisp

   1 (uiop:define-package #:lw2.data-viewers.comment
   2   (:use #:cl #:lw2.html-reader #:lw2.utils #:lw2.schema-type #:lw2.context #:lw2.user-context #:lw2.backend #:lw2.links #:lw2.interface-utils #:lw2.sites #:lw2.clean-html #:lw2.lmdb #:lw2.backlinks)
   3   (:export #:*comment-individual-link* #:comment-to-html))
   4
   5 (in-package #:lw2.data-viewers.comment)
   6
   7 (named-readtables:in-readtable html-reader)
   8
   9 (defparameter *comment-individual-link* nil)
  10
  11 (define-schema-type :comment ()
  12   ((comment-id string :alias :--id)
  13    (user-id string)
  14    (posted-at string)
  15    (highlight-new boolean :graphql-ignore t)
  16    (replied list :graphql-ignore t)
  17    (post-id (or null simple-string))
  18    (tag list :backend-type backend-lw2-tags-comments :subfields (:--id :name :slug))
  19    (base-score (or null fixnum))
  20    (af-base-score (or null fixnum))
  21    (vote-count (or null fixnum))
  22    (extended-score list)
  23    (page-url (or null string) :context-not :user-index) ; page-url sometimes causes "Cannot read property '_id' of undefined" error
  24    (parent-comment list :backend-type backend-lw2-tags-comments :context :index :subfields (:--id :user-id :post-id (:tag :--id :name :slug)))
  25    (parent-comment list :context :index :subfields (:--id :user-id :post-id))
  26    (parent-comment-id (or null string))
  27    (child-count (or null fixnum) :graphql-ignore t)
  28    (children list :graphql-ignore t)
  29    (af boolean :backend-type backend-alignment-forum)
  30    (retracted boolean)
  31    (deleted-public boolean)
  32    (answer boolean :backend-type backend-q-and-a)
  33    (debate-response boolean :backend-type backend-debates)
  34    (parent-answer-id (or null string) :backend-type backend-q-and-a)
  35    (nominated-for-review t :backend-type backend-lw2)
  36    (reviewing-for-review t :backend-type backend-lw2)
  37    (top-level-comment list :backend-type backend-lw2 :subfields (:nominated-for-review :reviewing-for-review))
  38    (latest-children list
  39                     :backend-type backend-shortform
  40                     :context :shortform
  41                     :subfields (:--id :user-id :posted-at :post-id :base-score :af-base-score :page-url
  42                                 :parent-comment-id :af :vote-count :retracted :deleted-public :html-body))
  43    (html-body string)))
  44
  45 (defun comment-link (post-id tag &optional comment-id)
  46   (when (or post-id tag)
  47     (generate-item-link (if post-id :post :tag) (or post-id (cdr (assoc :slug tag))) :comment-id comment-id)))
  48
  49 (defun comment-to-html (out-stream comment &key with-post-title)
  50   (if (or (cdr (assoc :deleted comment)) (cdr (assoc :deleted-public comment)) (not (cdr (assoc :html-body comment))))
  51       (format out-stream "<div class=\"comment deleted-comment\"><div class=\"comment-meta\"><span class=\"deleted-meta\">[ ]</span></div><div class=\"body-text comment-body\">[deleted]</div></div>")
  52       (schema-bind (:comment comment :auto :context :index)
  53         (multiple-value-bind (pretty-time js-time) (pretty-time posted-at)
  54           <div class=("comment~{ ~A~}"
  55                       (list-cond
  56                        ((and (logged-in-userid user-id)
  57                              (< (* 1000 (local-time:timestamp-to-unix (local-time:now))) (+ js-time 15000)))
  58                         "just-posted-comment")
  59                        (highlight-new "comment-item-highlight")
  60                        (retracted "retracted")
  61                        (debate-response "debate-response")))
  62                data-post-id=post-id
  63                data-tag-id=(cdr (assoc :--id tag))>
  64             <div class="comment-meta">
  65               (if (user-deleted user-id)
  66                   <span class="author">[deleted]</span>
  67                   <a class=("author~:[~; own-user-author~]" (logged-in-userid user-id))
  68                      href=("/users/~A" (encode-entities (get-user-slug user-id)))
  69                      data-userid=user-id
  70                      data-full-name=(get-user-full-name user-id)>
  71                     (get-username user-id)
  72                   </a>)
  73               <a class="date" href=(comment-link post-id tag comment-id) data-js-date=js-time> (safe pretty-time) (safe (pretty-time-js))</a>
  74               (when replied <a class="replied" title="You have replied to this comment" href=(apply 'generate-item-link replied)></a>)
  75               (vote-buttons base-score :with-buttons *enable-voting* :vote-count vote-count :af-score (and af af-base-score) :extended-score extended-score :ea-agreement-voting (typep *current-site* 'ea-forum-viewer-site))
  76               (when af <span class="alignment-forum">AF</span>)
  77               (when post-id
  78                 <a class="permalink" href=("~A/~A/~A"
  79                                            (generate-item-link :post post-id)
  80                                            (cond ((or answer parent-answer-id) "answer") (t "comment"))
  81                                            comment-id)
  82                    title="Permalink"></a>)
  83               (with-html-stream-output
  84                 (when page-url
  85                   <a class="lw2-link" href=(clean-lw-link page-url) title=(main-site-abbreviation *current-site*)></a>)
  86                 (if with-post-title
  87                     <div class="comment-post-title">
  88                       (with-html-stream-output
  89                           (when parent-comment
  90                             (alist-bind ((user-id simple-string)
  91                                          (post-id (or null simple-string))
  92                                          (tag list)
  93                                          (parent-id simple-string :--id))
  94                                         parent-comment
  95                               <span class="comment-in-reply-to">in reply to:
  96                                 <a href=("/users/~A" (get-user-slug user-id))
  97                                    class=("inline-author~:[~; own-user-author~]" (logged-in-userid user-id))
  98                                    data-userid=(progn user-id)>
  99                                    (get-username user-id)</a>’s
 100                                 <a href=(comment-link post-id tag parent-id)>comment</a>
 101                                 (progn " ")
 102                               </span>)))
 103                       <span class="comment-post-title2">on: <a href=(comment-link post-id tag)>(safe (if (or post-id tag)
 104                                                                                                          (clean-text-to-html (if post-id
 105                                                                                                                                  (get-post-title post-id)
 106                                                                                                                                  (cdr (assoc :name tag))))
 107                                                                                                          "[unknown]"))</a></span>
 108                       </div>
 109                   (when parent-comment-id
 110                     (if *comment-individual-link*
 111                         <a class="comment-parent-link" href=(progn parent-comment-id) title="Parent"></a>
 112                         <a class="comment-parent-link" href=("#comment-~A" parent-comment-id)>Parent</a>)))
 113                 (when children
 114                   <div class="comment-child-links">
 115                     Replies:
 116                     (with-html-stream-output
 117                       (dolist (child children)
 118                         (alist-bind ((comment-id string)
 119                                      (user-id string))
 120                                     child
 121                           <a href=("#comment-~A" comment-id)>(">~A" (get-username user-id))</a>)))
 122                   </div>)
 123                 <div class="comment-minimize-button"
 124                      data-child-count=(progn child-count)>
 125                 </div>)
 126               </div>
 127               <div class="body-text comment-body" (safe ("~@[ data-markdown-source=\"~A\"~]"
 128                                                          (if (logged-in-userid user-id)
 129                                                              (encode-entities
 130                                                               (or (markdown-source :comment comment-id html-body)
 131                                                                   html-body)))))>
 132                 (with-html-stream-output (:stream stream)
 133                     (if post-id
 134                         (let ((*before-clean-hook* (lambda () (clear-backlinks post-id comment-id)))
 135                               (*link-hook* (lambda (link)
 136                                              (add-backlink link post-id comment-id)))
 137                               (lw2.lmdb:*memoized-output-stream* stream))
 138                           (clean-html* html-body))
 139                         (let ((lw2.lmdb:*memoized-output-stream* stream))
 140                           (clean-html* html-body))))
 141               </div>
 142               (when post-id (backlinks-to-html (get-backlinks post-id comment-id) (format nil "~A-~A" post-id comment-id)))
 143               (when *enable-voting*
 144                 <script>initializeCommentControls\(\)</script>)
 145             </div>))))