;;; Copyright © 2019 - 2022 Jakob L. Kreuze <zerodaysfordays@sdf.org>
;;;
;;; This program is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License as
;;; published by the Free Software Foundation; either version 3 of the
;;; License, or (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program. If not, see
;;; <http://www.gnu.org/licenses/>.

(define-module (jakob utils webmention)
  #:use-module (ice-9 receive)
  #:use-module (ice-9 iconv)
  #:use-module (ice-9 match)
  #:use-module (srfi srfi-19)
  #:use-module (srfi srfi-43)
  #:use-module (json)
  #:use-module (web client)
  #:use-module (web response)
  #:use-module (oop goops)
  #:export (render-comment-view
            fetch-webmentions))

(define (strip uri)
  (let* ((needle "://")
         (index (string-contains uri needle)))
    (if index
        (strip (substring uri (+ index (string-length needle))))
        uri)))

(define (format-comment object)
  (let* ((author (assoc-ref object "author"))
         (author-name (assoc-ref author "name"))
         (author-photo (assoc-ref author "photo"))
         (author-url (assoc-ref author "url"))
         (content (assoc-ref object "content"))
         (content-text (assoc-ref content "text"))
         (published-time (assoc-ref object "published"))
         (received-time (assoc-ref object "wm-received"))
         (url (assoc-ref object "url")))
    `(li (@ (class "p-comment h-cite comment comment-source-webmention"))
         (img (@ (class "comment-source-identifier")
                 (alt "Webmention logo")
                 (src "/static/image/webmention-logo.png")))
         (div (@ (class "p-author h-card author"))
              (img (@ (class "u-photo")
                      (src ,(if (string-prefix? author-url "https://lobste.rs/")
                                "/static/image/lobsters.png"
                                (or author-photo "/static/image/default-icon.png")))))
              (a (@ (class "p-name u-url")
                    (href ,author-url))
                 ,author-name)
              (a (@ (class "author-url")
                    (href ,author-url))
                 ,(strip author-url)))
         (div (@ (class "e-content p-name comment-content"))
              ,content-text)
         (div (@ (class "metaline"))
              (a (@ (class "u-url")
                    (href ,url))
                 (time (@ (class "dt-published")
                          (datetime ,(or published-time received-time)))
                       ,(date->string
                         (string->date (if (eqv? 'null published-time)
                                           (if (eqv? 'null received-time)
                                               (current-time)
                                               received-time)
                                           published-time)
                                       "~Y~m~d~H~M~S")
                         "~B ~e, ~Y at ~H:~M")))))))

(define (format-interaction object)
  (let* ((author (assoc-ref object "author"))
         (author-name (assoc-ref author "name"))
         (author-photo (assoc-ref author "photo"))
         (author-url (assoc-ref author "url")))
    `(li (@ (class "p-comment h-cite interaction comment-source-webmention"))
         (a (@ (href ,author-url))
            (img (@ (class "u-photo")
                    (src ,(if (string-prefix? author-url "https://lobste.rs/")
                              "/static/image/lobsters.png"
                              (or author-photo "/static/image/default-icon.png"))))))
         (div (@ (class "e-content p-name comment-content"))
              (em
               ,(match (assoc-ref object "wm-property")
                  ("repost-of" "Reposted this!")
                  ("like-of" "Favorited this!")
                  (_ "[No Text Provided!]"))))
         (img (@ (class "comment-source-identifier")
                 (alt "Webmention logo")
                 (src "/static/image/webmention-logo.png"))))))

(define (render-comment-view response)
  (vector->list
   (vector-map (lambda (_ x)
                 (if (and (assoc-ref x "wm-property")
                          (or (string= (assoc-ref x "wm-property") "in-reply-to")
                              (string= (assoc-ref x "wm-property") "mention-of")))
                     (format-comment x)
                     (format-interaction x)))
               (assoc-ref response "children"))))

(define (fetch-webmentions slug)
  (define prefixes '("http://jakob.space/" "https://jakob.space/"
                     "http://jakob.space/blog/" "https://jakob.space/blog/"))
  (let ((url (format #f "https://webmention.io/api/mentions.jf2?per-page=200&page=0&~a"
                     (string-join
                      (map (lambda (pre)
                             (format #f "target[]=~a~a.html" pre slug))
                           prefixes)
                      "&"))))
    (receive (response-status response-body)
        (http-request url)
      (call-with-input-string (bytevector->string response-body "UTF-8") json->scm))))