breezewiki/src/extwiki-generic.rkt

#lang racket/base
(require racket/list
         racket/match
         racket/string
         memo
         net/http-easy
         html-parsing
         "../lib/pure-utils.rkt"
         "../lib/syntax.rkt"
         "../lib/url-utils.rkt"
         "../lib/xexpr-utils.rkt")

(provide
 get-redirect-content)

(module+ test
  (require rackunit))

;; fandom wikinames * Title * Main Page * Search page override * API endpoint override
(define wikis
  '(((gallowmere) "Gallowmere Historia" "https://medievil.wiki/w/Main_Page" #f #f)
    ((fallout) "Fallout Wiki" "https://fallout.wiki/wiki/Fallout_Wiki" #f "https://fallout.wiki/api.php")
    ))

(define wikis-hash (make-hash))
(for ([w wikis])
  (for ([wikiname (car w)])
    (hash-set! wikis-hash (symbol->string wikiname) w)))
(module+ test
  (check-equal? (cadr (hash-ref wikis-hash "gallowmere"))
                "Gallowmere Historia"))

(define (parse-table table)
  (define rows (query-selector (λ (t a c) (eq? t 'tr)) table))
  (define header-row (rows))
  (define column-names
    (for/list ([th (in-producer (query-selector (λ (t a c) (eq? t 'th)) header-row) #f)])
      (string->symbol (string-downcase (string-trim (findf string? th))))))
  (define data-row (rows))
  (for/hasheq ([col-name column-names]
               [col-value (in-producer (query-selector (λ (t a c) (eq? t 'td)) data-row) #f)])
    (values col-name (filter element-is-content? (cdr col-value)))))
(module+ test
  (check-equal? (parse-table (html->xexp "<table> <tbody><tr> <th>Links</th></tr> <tr> <td><a target=\"_blank\" rel=\"nofollow noreferrer noopener\" class=\"external text\" href=\"https://sirdanielfortesque.proboards.com/\">Forum</a></td></tr></tbody></table>"))
                '#hasheq((links . ((a (@ (target "_blank") (rel "nofollow noreferrer noopener") (class "external text") (href "https://sirdanielfortesque.proboards.com/")) "Forum"))))))

(define (table->links table)
  (define v (hash-ref table 'links #f))
  (cond/var
   [(not v) (values null '("Data table must have a \"Links\" column"))]
   (var links (filter (λ (a) (and (pair? a) (eq? (car a) 'a))) v)) ; <a> elements
   [(null? links) (values null '("Links column must have at least one link"))]
   [#t (values links null)]))

(define (table->logo table)
  (define logo (hash-ref table 'logo #f))
  (cond/var
   [(not logo) (values #f '("Data table must have a \"Logo\" column"))]
   [(null? logo) (values #f '("Logo table column must have a link"))]
   (var href (get-attribute 'href (bits->attributes (car (hash-ref table 'logo)))))
   [(not href) (values #f '("Logo table column must have a link"))]
   [#t (values href null)]))

(define (get-api-endpoint wiki)
  (define main-page (third wiki))
  (define override (fifth wiki))
  (or override
      (match main-page
        [(regexp #rx"/$") (string-append main-page "api.php")]
        [(regexp #rx"^(.*)/wiki/" (list _ domain)) (string-append domain "/w/api.php")]
        [(regexp #rx"^(.*)/w/" (list _ domain)) (string-append domain "/api.php")]
        [_ (error 'get-api-endpoint "unknown url format: ~a" main-page)])))

(define (get-search-page wiki)
  (define main-page (third wiki))
  (define override (fourth wiki))
  (or override
      (match main-page
        [(regexp #rx"/$") (string-append main-page "Special:Search")]
        [(regexp #rx"^(.*/w[^./]*/)" (list _ wiki-prefix)) (string-append wiki-prefix "Special:Search")]
        [_ (error 'get-search-page "unknown url format: ~a" main-page)])))

(define/memoize (get-redirect-content wikiname) #:hash hash
  (define wiki (hash-ref wikis-hash wikiname #f))
  (cond
    [wiki
     (define display-name (cadr wiki))
     (define endpoint (string-append (get-api-endpoint wiki) "?action=parse&page=MediaWiki:BreezeWikiRedirect&prop=text&formatversion=2&format=json"))
     (define res (get endpoint))
     (define html (jp "/parse/text" (response-json res)))
     (define content ((query-selector (λ (t a c) (has-class? "mw-parser-output" a))
                                      (html->xexp html))))
     (define body (for/list ([p (in-producer (query-selector (λ (t a c) (eq? t 'p)) content) #f)]) p))
     (define table (parse-table ((query-selector (λ (t a c) (eq? t 'table)) content))))
     (define-values (links links-errors) (table->links table))
     (define-values (logo logo-errors) (table->logo table))
     (define construct-errors (append links-errors logo-errors))
     (λ (title)
       (define go
         (string-append (get-search-page wiki)
                        "?"
                        (params->query `(("search" . ,title)
                                         ("go" . "Go")))))
       `(aside (@ (class "niwa__notice"))
               (h1 (@ (class "niwa__header")) ,display-name " has its own website separate from Fandom.")
               (div (@ (class "niwa__cols"))
                    (div (@ (class "niwa__left"))
                         (a (@ (class "niwa__go") (href ,go)) "Read " ,title " on " ,display-name " →")
                         ,@body
                         (p "This wiki's core community has wholly migrated away from Fandom. You should "
                            (a (@ (href ,go)) "go to " ,display-name " now!")))
                    (div (@ (class "niwa__right"))
                         (img (@ (class "niwa__logo") (src ,logo)))))
               ,(if (pair? links)
                    `(p (@ (class "niwa__feedback"))
                        ,@(add-between links " / "))
                    "")
               ,(if (pair? construct-errors)
                    `(ul
                      ,@(for/list ([error construct-errors])
                          `(li ,error)))
                    "")))]
    [#t #f]))
(module+ test
  ((get-redirect-content "gallowmere") "Gallowmere Historia"))