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    (all-votes list :subfields (:vote-type :extended-vote-type))
  24    (page-url (or null string) :context-not :user-index) ; page-url sometimes causes "Cannot read property '_id' of undefined" error
  25    (parent-comment list :backend-type backend-lw2-tags-comments :context :index :subfields (:--id :user-id :post-id (:tag :--id :name :slug)))
  26    (parent-comment list :context :index :subfields (:--id :user-id :post-id))
  27    (parent-comment-id (or null string))
  28    (child-count (or null fixnum) :graphql-ignore t)
  29    (children list :graphql-ignore t)
  30    (af boolean :backend-type backend-alignment-forum)
  31    (retracted boolean)
  32    (deleted-public boolean)
  33    (answer boolean :backend-type backend-q-and-a)
  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)))
  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                data-post-id=post-id
  62                data-tag-id=(cdr (assoc :--id tag))>
  63             <div class="comment-meta">
  64               (if (user-deleted user-id)
  65                   <span class="author">[deleted]</span>
  66                   <a class=("author~:[~; own-user-author~]" (logged-in-userid user-id))
  67                      href=("/users/~A" (encode-entities (get-user-slug user-id)))
  68                      data-userid=user-id
  69                      data-full-name=(get-user-full-name user-id)>
  70                     (get-username user-id)
  71                   </a>)
  72               <a class="date" href=(comment-link post-id tag comment-id) data-js-date=js-time> (safe pretty-time) (safe (pretty-time-js))</a>
  73               (when replied <a class="replied" title="You have replied to this comment" href=(apply 'generate-item-link replied)></a>)
  74               (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)
  75               (when af <span class="alignment-forum">AF</span>)
  76               (when post-id
  77                 <a class="permalink" href=("~A/~A/~A"
  78                                            (generate-item-link :post post-id)
  79                                            (cond ((or answer parent-answer-id) "answer") (t "comment"))
  80                                            comment-id)
  81                    title="Permalink"></a>)
  82               (with-html-stream-output
  83                 (when page-url
  84                   <a class="lw2-link" href=(clean-lw-link page-url) title=(main-site-abbreviation *current-site*)></a>)
  85                 (if with-post-title
  86                     <div class="comment-post-title">
  87                       (with-html-stream-output
  88                           (when parent-comment
  89                             (alist-bind ((user-id simple-string)
  90                                          (post-id (or null simple-string))
  91                                          (tag list)
  92                                          (parent-id simple-string :--id))
  93                                         parent-comment
  94                               <span class="comment-in-reply-to">in reply to:
  95                                 <a href=("/users/~A" (get-user-slug user-id))
  96                                    class=("inline-author~:[~; own-user-author~]" (logged-in-userid user-id))
  97                                    data-userid=(progn user-id)>
  98                                    (get-username user-id)</a>’s
  99                                 <a href=(comment-link post-id tag parent-id)>comment</a>
 100                                 (progn " ")
 101                               </span>)))
 102                       <span class="comment-post-title2">on: <a href=(comment-link post-id tag)>(safe (if (or post-id tag)
 103                                                                                                          (clean-text-to-html (if post-id
 104                                                                                                                                  (get-post-title post-id)
 105                                                                                                                                  (cdr (assoc :name tag))))
 106                                                                                                          "[unknown]"))</a></span>
 107                       </div>
 108                   (when parent-comment-id
 109                     (if *comment-individual-link*
 110                         <a class="comment-parent-link" href=(progn parent-comment-id) title="Parent"></a>
 111                         <a class="comment-parent-link" href=("#comment-~A" parent-comment-id)>Parent</a>)))
 112                 (when children
 113                   <div class="comment-child-links">
 114                     Replies:
 115                     (with-html-stream-output
 116                       (dolist (child children)
 117                         (alist-bind ((comment-id string)
 118                                      (user-id string))
 119                                     child
 120                           <a href=("#comment-~A" comment-id)>(">~A" (get-username user-id))</a>)))
 121                   </div>)
 122                 <div class="comment-minimize-button"
 123                      data-child-count=(progn child-count)>
 124                 </div>)
 125               </div>
 126               <div class="body-text comment-body" (safe ("~@[ data-markdown-source=\"~A\"~]"
 127                                                          (if (logged-in-userid user-id)
 128                                                              (encode-entities
 129                                                               (or (markdown-source :comment comment-id html-body)
 130                                                                   html-body)))))>
 131                 (with-html-stream-output (:stream stream)
 132                     (if post-id
 133                         (let ((*before-clean-hook* (lambda () (clear-backlinks post-id comment-id)))
 134                               (*link-hook* (lambda (link)
 135                                              (add-backlink link post-id comment-id)))
 136                               (lw2.lmdb:*memoized-output-stream* stream))
 137                           (clean-html* html-body))
 138                         (let ((lw2.lmdb:*memoized-output-stream* stream))
 139                           (clean-html* html-body))))
 140               </div>
 141               (when post-id (backlinks-to-html (get-backlinks post-id comment-id) (format nil "~A-~A" post-id comment-id)))
 142               (when *enable-voting*
 143                 <script>initializeCommentControls\(\)</script>)
 144             </div>))))