Match original light/dark page theme reliably

- Use keyword parameters for generate-wiki-page
- Apply body classes (including page theme) from original source
This commit is contained in:
Cadence Ember 2022-09-17 00:56:05 +12:00
parent 33ee6a0624
commit 0172034319
5 changed files with 86 additions and 40 deletions

View file

@ -55,7 +55,15 @@
" Media files and official Fandom documents have different copying restrictions.") " Media files and official Fandom documents have different copying restrictions.")
(p ,(format "Fandom is a trademark of Fandom, Inc. ~a is not affiliated with Fandom." (config-get 'application_name)))))))) (p ,(format "Fandom is a trademark of Fandom, Inc. ~a is not affiliated with Fandom." (config-get 'application_name))))))))
(define (generate-wiki-page source-url wikiname title content) (define (generate-wiki-page
content
#:source-url source-url
#:wikiname wikiname
#:title title
#:body-class [body-class-in ""])
(define body-class (if (equal? "" body-class-in)
"skin-fandomdesktop"
body-class-in))
(define (required-styles origin) (define (required-styles origin)
(map (λ (dest-path) (map (λ (dest-path)
(define url (format dest-path origin)) (define url (format dest-path origin))
@ -76,7 +84,7 @@
`(link (@ (rel "stylesheet") (type "text/css") (href ,url)))) `(link (@ (rel "stylesheet") (type "text/css") (href ,url))))
(required-styles (format "https://~a.fandom.com" wikiname))) (required-styles (format "https://~a.fandom.com" wikiname)))
(link (@ (rel "stylesheet") (type "text/css") (href "/static/main.css")))) (link (@ (rel "stylesheet") (type "text/css") (href "/static/main.css"))))
(body (@ (class "skin-fandomdesktop theme-fandomdesktop-light")) (body (@ (class ,body-class))
(div (@ (class "main-container")) (div (@ (class "main-container"))
(div (@ (class "fandom-community-header__background tileHorizontally header"))) (div (@ (class "fandom-community-header__background tileHorizontally header")))
(div (@ (class "page")) (div (@ (class "page"))
@ -94,7 +102,11 @@
(module+ test (module+ test
(define page (define page
(parameterize ([(config-parameter 'strict_proxy) "true"]) (parameterize ([(config-parameter 'strict_proxy) "true"])
(generate-wiki-page "" "test" "test" '(template)))) (generate-wiki-page
'(template)
#:source-url ""
#:title "test"
#:wikiname "test")))
; check the page is a valid xexp ; check the page is a valid xexp
(check-not-false (xexp->html page)) (check-not-false (xexp->html page))
; check the stylesheet is proxied ; check the stylesheet is proxied

View file

@ -12,9 +12,7 @@
(provide (provide
; syntax to make the hashmap from names ; syntax to make the hashmap from names
dispatcher-tree dispatcher-tree)
; procedure to make the tree from the hashmap
make-dispatcher-tree)
; make a hashmap out of the provided names and call make-dispatcher-tree with it ; make a hashmap out of the provided names and call make-dispatcher-tree with it
(define-syntax (dispatcher-tree stx) (define-syntax (dispatcher-tree stx)

View file

@ -1,6 +1,7 @@
#lang racket/base #lang racket/base
(require racket/dict (require racket/dict
racket/list racket/list
racket/match
racket/string racket/string
(prefix-in easy: net/http-easy) (prefix-in easy: net/http-easy)
; html libs ; html libs
@ -26,12 +27,19 @@
(define category-json-data (define category-json-data
'#hasheq((batchcomplete . #t) (continue . #hasheq((cmcontinue . "page|4150504c45|41473") (continue . "-||"))) (query . #hasheq((categorymembers . (#hasheq((ns . 0) (pageid . 25049) (title . "Item (entity)")) #hasheq((ns . 0) (pageid . 128911) (title . "3D")) #hasheq((ns . 0) (pageid . 124018) (title . "A Very Fine Item")) #hasheq((ns . 0) (pageid . 142208) (title . "Amethyst Shard")) #hasheq((ns . 0) (pageid . 121612) (title . "Ankle Monitor"))))))))) '#hasheq((batchcomplete . #t) (continue . #hasheq((cmcontinue . "page|4150504c45|41473") (continue . "-||"))) (query . #hasheq((categorymembers . (#hasheq((ns . 0) (pageid . 25049) (title . "Item (entity)")) #hasheq((ns . 0) (pageid . 128911) (title . "3D")) #hasheq((ns . 0) (pageid . 124018) (title . "A Very Fine Item")) #hasheq((ns . 0) (pageid . 142208) (title . "Amethyst Shard")) #hasheq((ns . 0) (pageid . 121612) (title . "Ankle Monitor")))))))))
(define (generate-results-page dest-url wikiname prefixed-category members-data page) (define (generate-results-page
#:source-url source-url
#:wikiname wikiname
#:prefixed-category prefixed-category
#:members-data members-data
#:page page
#:body-class body-class)
(define members (jp "/query/categorymembers" members-data)) (define members (jp "/query/categorymembers" members-data))
(generate-wiki-page (generate-wiki-page
dest-url #:source-url source-url
wikiname #:wikiname wikiname
prefixed-category #:title prefixed-category
#:body-class body-class
`(div `(div
,(update-tree-wiki page wikiname) ,(update-tree-wiki page wikiname)
(hr) (hr)
@ -55,7 +63,8 @@
(define source-url (format "~a/wiki/~a" origin prefixed-category)) (define source-url (format "~a/wiki/~a" origin prefixed-category))
(thread-let (thread-let
([members-data (define dest-url (format "~a/api.php?~a" ([members-data (define dest-url
(format "~a/api.php?~a"
origin origin
(params->query `(("action" . "query") (params->query `(("action" . "query")
("list" . "categorymembers") ("list" . "categorymembers")
@ -66,11 +75,12 @@
(printf "out: ~a~n" dest-url) (printf "out: ~a~n" dest-url)
(define dest-res (easy:get dest-url #:timeouts timeouts)) (define dest-res (easy:get dest-url #:timeouts timeouts))
(easy:response-json dest-res)] (easy:response-json dest-res)]
[page-data (define dest-url (format "~a/api.php?~a" [page-data (define dest-url
(format "~a/api.php?~a"
origin origin
(params->query `(("action" . "parse") (params->query `(("action" . "parse")
("page" . ,prefixed-category) ("page" . ,prefixed-category)
("prop" . "text") ("prop" . "text|headhtml|langlinks")
("formatversion" . "2") ("formatversion" . "2")
("format" . "json"))))) ("format" . "json")))))
(printf "out: ~a~n" dest-url) (printf "out: ~a~n" dest-url)
@ -79,7 +89,19 @@
(define page-html (preprocess-html-wiki (jp "/parse/text" page-data ""))) (define page-html (preprocess-html-wiki (jp "/parse/text" page-data "")))
(define page (html->xexp page-html)) (define page (html->xexp page-html))
(define body (generate-results-page source-url wikiname prefixed-category members-data page)) (define head-html (jp "/parse/headhtml" page-data ""))
(define body-class (match (regexp-match #rx"<body [^>]*class=\"([^\"]*)" head-html)
[(list _ classes) classes]
[_ ""]))
(println head-html)
(println body-class)
(define body (generate-results-page
#:source-url source-url
#:wikiname wikiname
#:prefixed-category prefixed-category
#:members-data members-data
#:page page
#:body-class body-class))
(when (config-true? 'debug) (when (config-true? 'debug)
; used for its side effects ; used for its side effects
@ -91,5 +113,9 @@
(write-html body out)))))) (write-html body out))))))
(module+ test (module+ test
(check-not-false ((query-selector (attribute-selector 'href "/test/wiki/Ankle_Monitor") (check-not-false ((query-selector (attribute-selector 'href "/test/wiki/Ankle_Monitor")
(generate-results-page "" "test" "Category:Items" category-json-data (generate-results-page
'(div "page text")))))) #:source-url ""
#:wikiname "test"
#:prefixed-category "Category:Items"
#:category-data category-json-data
#:page '(div "page text"))))))

View file

@ -26,9 +26,9 @@
(define (generate-results-page dest-url wikiname query data) (define (generate-results-page dest-url wikiname query data)
(define search-results (jp "/query/search" data)) (define search-results (jp "/query/search" data))
(generate-wiki-page (generate-wiki-page
dest-url #:source-url dest-url
wikiname #:wikiname wikiname
"Search Results" #:title "Search Results"
`(div (@ (class "mw-parser-output")) `(div (@ (class "mw-parser-output"))
(p ,(format "~a results found for " (length search-results)) (p ,(format "~a results found for " (length search-results))
(strong ,query)) (strong ,query))

View file

@ -2,6 +2,7 @@
(require racket/dict (require racket/dict
racket/function racket/function
racket/list racket/list
racket/match
racket/string racket/string
; libs ; libs
(prefix-in easy: net/http-easy) (prefix-in easy: net/http-easy)
@ -238,7 +239,7 @@
origin origin
(params->query `(("action" . "parse") (params->query `(("action" . "parse")
("page" . ,path) ("page" . ,path)
("prop" . "text") ("prop" . "text|headhtml|langlinks")
("formatversion" . "2") ("formatversion" . "2")
("format" . "json"))))) ("format" . "json")))))
(printf "out: ~a~n" dest-url) (printf "out: ~a~n" dest-url)
@ -250,12 +251,21 @@
[title (jp "/parse/title" data "")] [title (jp "/parse/title" data "")]
[page-html (jp "/parse/text" data "")] [page-html (jp "/parse/text" data "")]
[page-html (preprocess-html-wiki page-html)] [page-html (preprocess-html-wiki page-html)]
[page (html->xexp page-html)]) [page (html->xexp page-html)]
[head-html (jp "/parse/headhtml" data "")]
[body-class (match (regexp-match #rx"<body [^>]*class=\"([^\"]*)" head-html)
[(list _ classes) classes]
[_ ""])])
(if (equal? "missingtitle" (jp "/error/code" data #f)) (if (equal? "missingtitle" (jp "/error/code" data #f))
(next-dispatcher) (next-dispatcher)
(response-handler (response-handler
(define body (define body
(generate-wiki-page source-url wikiname title (update-tree-wiki page wikiname))) (generate-wiki-page
(update-tree-wiki page wikiname)
#:source-url source-url
#:wikiname wikiname
#:title title
#:body-class body-class))
(define redirect-msg ((query-selector (attribute-selector 'class "redirectMsg") body))) (define redirect-msg ((query-selector (attribute-selector 'class "redirectMsg") body)))
(define headers (if redirect-msg (define headers (if redirect-msg
(let* ([dest (get-attribute 'href (bits->attributes ((query-selector (λ (t a c) (eq? t 'a)) redirect-msg))))] (let* ([dest (get-attribute 'href (bits->attributes ((query-selector (λ (t a c) (eq? t 'a)) redirect-msg))))]