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