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    (parent-answer-id (or null string) :backend-type backend-q-and-a)
  34    (nominated-for-review t :backend-type backend-lw2)
  35    (reviewing-for-review t :backend-type backend-lw2)
  36    (top-level-comment list :backend-type backend-lw2 :subfields (:nominated-for-review :reviewing-for-review))
  37    (latest-children list
  38                     :backend-type backend-shortform
  39                     :context :shortform
  40                     :subfields (:--id :user-id :posted-at :post-id :base-score :af-base-score :page-url
  41                                 :parent-comment-id :af :vote-count :retracted :deleted-public :html-body))
  42    (html-body string)))
  43
  44 (defun comment-link (post-id tag &optional comment-id)
  45   (when (or post-id tag)
  46     (generate-item-link (if post-id :post :tag) (or post-id (cdr (assoc :slug tag))) :comment-id comment-id)))
  47
  48 (defun comment-to-html (out-stream comment &key with-post-title)
  49   (if (or (cdr (assoc :deleted comment)) (cdr (assoc :deleted-public comment)))
  50       (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>")
  51       (schema-bind (:comment comment :auto :context :index)
  52         (multiple-value-bind (pretty-time js-time) (pretty-time posted-at)
  53           <div class=("comment~{ ~A~}"
  54                       (list-cond
  55                        ((and (logged-in-userid user-id)
  56                              (< (* 1000 (local-time:timestamp-to-unix (local-time:now))) (+ js-time 15000)))
  57                         "just-posted-comment")
  58                        (highlight-new "comment-item-highlight")
  59                        (retracted "retracted")))
  60                data-post-id=post-id
  61                data-tag-id=(cdr (assoc :--id tag))>
  62             <div class="comment-meta">
  63               (if (user-deleted user-id)
  64                   <span class="author">[deleted]</span>
  65                   <a class=("author~:[~; own-user-author~]" (logged-in-userid user-id))
  66                      href=("/users/~A" (encode-entities (get-user-slug user-id)))
  67                      data-userid=user-id
  68                      data-full-name=(get-user-full-name user-id)>
  69                     (get-username user-id)
  70                   </a>)
  71               <a class="date" href=(comment-link post-id tag comment-id) data-js-date=js-time> (safe pretty-time) (safe (pretty-time-js))</a>
  72               (when replied <a class="replied" title="You have replied to this comment" href=(apply 'generate-item-link replied)></a>)
  73               (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))
  74               (when af <span class="alignment-forum">AF</span>)
  75               (when post-id
  76                 <a class="permalink" href=("~A/~A/~A"
  77                                            (generate-item-link :post post-id)
  78                                            (cond ((or answer parent-answer-id) "answer") (t "comment"))
  79                                            comment-id)
  80                    title="Permalink"></a>)
  81               (with-html-stream-output
  82                 (when page-url
  83                   <a class="lw2-link" href=(clean-lw-link page-url) title=(main-site-abbreviation *current-site*)></a>)
  84                 (if with-post-title
  85                     <div class="comment-post-title">
  86                       (with-html-stream-output
  87                           (when parent-comment
  88                             (alist-bind ((user-id simple-string)
  89                                          (post-id (or null simple-string))
  90                                          (tag list)
  91                                          (parent-id simple-string :--id))
  92                                         parent-comment
  93                               <span class="comment-in-reply-to">in reply to:
  94                                 <a href=("/users/~A" (get-user-slug user-id))
  95                                    class=("inline-author~:[~; own-user-author~]" (logged-in-userid user-id))
  96                                    data-userid=(progn user-id)>
  97                                    (get-username user-id)</a>’s
  98                                 <a href=(comment-link post-id tag parent-id)>comment</a>
  99                                 (progn " ")
 100                               </span>)))
 101                       <span class="comment-post-title2">on: <a href=(comment-link post-id tag)>(safe (if (or post-id tag)
 102                                                                                                          (clean-text-to-html (if post-id
 103                                                                                                                                  (get-post-title post-id)
 104                                                                                                                                  (cdr (assoc :name tag))))
 105                                                                                                          "[unknown]"))</a></span>
 106                       </div>
 107                   (when parent-comment-id
 108                     (if *comment-individual-link*
 109                         <a class="comment-parent-link" href=(progn parent-comment-id) title="Parent"></a>
 110                         <a class="comment-parent-link" href=("#comment-~A" parent-comment-id)>Parent</a>)))
 111                 (when children
 112                   <div class="comment-child-links">
 113                     Replies:
 114                     (with-html-stream-output
 115                       (dolist (child children)
 116                         (alist-bind ((comment-id string)
 117                                      (user-id string))
 118                                     child
 119                           <a href=("#comment-~A" comment-id)>(">~A" (get-username user-id))</a>)))
 120                   </div>)
 121                 <div class="comment-minimize-button"
 122                      data-child-count=(progn child-count)>
 123                 </div>)
 124               </div>
 125               <div class="body-text comment-body" (safe ("~@[ data-markdown-source=\"~A\"~]"
 126                                                          (if (logged-in-userid user-id)
 127                                                              (encode-entities
 128                                                               (or (markdown-source :comment comment-id html-body)
 129                                                                   html-body)))))>
 130                 (with-html-stream-output (:stream stream)
 131                     (if post-id
 132                         (let ((*before-clean-hook* (lambda () (clear-backlinks post-id comment-id)))
 133                               (*link-hook* (lambda (link)
 134                                              (add-backlink link post-id comment-id)))
 135                               (lw2.lmdb:*memoized-output-stream* stream))
 136                           (clean-html* html-body))
 137                         (let ((lw2.lmdb:*memoized-output-stream* stream))
 138                           (clean-html* html-body))))
 139               </div>
 140               (when post-id (backlinks-to-html (get-backlinks post-id comment-id) (format nil "~A-~A" post-id comment-id)))
 141               (when *enable-voting*
 142                 <script>initializeCommentControls\(\)</script>)
 143             </div>))))