From 0172034319b6b1a51ae2f610f7a16e51b78f5d62 Mon Sep 17 00:00:00 2001 From: Cadence Ember Date: Sat, 17 Sep 2022 00:56:05 +1200 Subject: [PATCH] Match original light/dark page theme reliably - Use keyword parameters for generate-wiki-page - Apply body classes (including page theme) from original source --- src/application-globals.rkt | 18 ++++++-- src/dispatcher-tree.rkt | 4 +- src/page-category.rkt | 82 ++++++++++++++++++++++++------------- src/page-search.rkt | 6 +-- src/page-wiki.rkt | 16 ++++++-- 5 files changed, 86 insertions(+), 40 deletions(-) diff --git a/src/application-globals.rkt b/src/application-globals.rkt index d5d592d..d21858b 100644 --- a/src/application-globals.rkt +++ b/src/application-globals.rkt @@ -55,7 +55,15 @@ " 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)))))))) -(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) (map (λ (dest-path) (define url (format dest-path origin)) @@ -76,7 +84,7 @@ `(link (@ (rel "stylesheet") (type "text/css") (href ,url)))) (required-styles (format "https://~a.fandom.com" wikiname))) (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 "fandom-community-header__background tileHorizontally header"))) (div (@ (class "page")) @@ -94,7 +102,11 @@ (module+ test (define page (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-not-false (xexp->html page)) ; check the stylesheet is proxied diff --git a/src/dispatcher-tree.rkt b/src/dispatcher-tree.rkt index 5800876..13321bd 100644 --- a/src/dispatcher-tree.rkt +++ b/src/dispatcher-tree.rkt @@ -12,9 +12,7 @@ (provide ; syntax to make the hashmap from names - dispatcher-tree - ; procedure to make the tree from the hashmap - make-dispatcher-tree) + dispatcher-tree) ; make a hashmap out of the provided names and call make-dispatcher-tree with it (define-syntax (dispatcher-tree stx) diff --git a/src/page-category.rkt b/src/page-category.rkt index bb388da..0bb9080 100644 --- a/src/page-category.rkt +++ b/src/page-category.rkt @@ -1,6 +1,7 @@ #lang racket/base (require racket/dict racket/list + racket/match racket/string (prefix-in easy: net/http-easy) ; html libs @@ -26,12 +27,19 @@ (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"))))))))) -(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)) (generate-wiki-page - dest-url - wikiname - prefixed-category + #:source-url source-url + #:wikiname wikiname + #:title prefixed-category + #:body-class body-class `(div ,(update-tree-wiki page wikiname) (hr) @@ -55,31 +63,45 @@ (define source-url (format "~a/wiki/~a" origin prefixed-category)) (thread-let - ([members-data (define dest-url (format "~a/api.php?~a" - origin - (params->query `(("action" . "query") - ("list" . "categorymembers") - ("cmtitle" . ,prefixed-category) - ("cmlimit" . "max") - ("formatversion" . "2") - ("format" . "json"))))) - (printf "out: ~a~n" dest-url) - (define dest-res (easy:get dest-url #:timeouts timeouts)) - (easy:response-json dest-res)] - [page-data (define dest-url (format "~a/api.php?~a" - origin - (params->query `(("action" . "parse") - ("page" . ,prefixed-category) - ("prop" . "text") - ("formatversion" . "2") - ("format" . "json"))))) - (printf "out: ~a~n" dest-url) - (define dest-res (easy:get dest-url #:timeouts timeouts)) - (easy:response-json dest-res)]) + ([members-data (define dest-url + (format "~a/api.php?~a" + origin + (params->query `(("action" . "query") + ("list" . "categorymembers") + ("cmtitle" . ,prefixed-category) + ("cmlimit" . "max") + ("formatversion" . "2") + ("format" . "json"))))) + (printf "out: ~a~n" dest-url) + (define dest-res (easy:get dest-url #:timeouts timeouts)) + (easy:response-json dest-res)] + [page-data (define dest-url + (format "~a/api.php?~a" + origin + (params->query `(("action" . "parse") + ("page" . ,prefixed-category) + ("prop" . "text|headhtml|langlinks") + ("formatversion" . "2") + ("format" . "json"))))) + (printf "out: ~a~n" dest-url) + (define dest-res (easy:get dest-url #:timeouts timeouts)) + (easy:response-json dest-res)]) (define page-html (preprocess-html-wiki (jp "/parse/text" page-data ""))) (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"]*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) ; used for its side effects @@ -91,5 +113,9 @@ (write-html body out)))))) (module+ test (check-not-false ((query-selector (attribute-selector 'href "/test/wiki/Ankle_Monitor") - (generate-results-page "" "test" "Category:Items" category-json-data - '(div "page text")))))) + (generate-results-page + #:source-url "" + #:wikiname "test" + #:prefixed-category "Category:Items" + #:category-data category-json-data + #:page '(div "page text")))))) diff --git a/src/page-search.rkt b/src/page-search.rkt index 7b0abe3..5d1bd7d 100644 --- a/src/page-search.rkt +++ b/src/page-search.rkt @@ -26,9 +26,9 @@ (define (generate-results-page dest-url wikiname query data) (define search-results (jp "/query/search" data)) (generate-wiki-page - dest-url - wikiname - "Search Results" + #:source-url dest-url + #:wikiname wikiname + #:title "Search Results" `(div (@ (class "mw-parser-output")) (p ,(format "~a results found for " (length search-results)) (strong ,query)) diff --git a/src/page-wiki.rkt b/src/page-wiki.rkt index bcf13aa..ecfdbb3 100644 --- a/src/page-wiki.rkt +++ b/src/page-wiki.rkt @@ -2,6 +2,7 @@ (require racket/dict racket/function racket/list + racket/match racket/string ; libs (prefix-in easy: net/http-easy) @@ -238,7 +239,7 @@ origin (params->query `(("action" . "parse") ("page" . ,path) - ("prop" . "text") + ("prop" . "text|headhtml|langlinks") ("formatversion" . "2") ("format" . "json"))))) (printf "out: ~a~n" dest-url) @@ -250,12 +251,21 @@ [title (jp "/parse/title" data "")] [page-html (jp "/parse/text" data "")] [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"]*class=\"([^\"]*)" head-html) + [(list _ classes) classes] + [_ ""])]) (if (equal? "missingtitle" (jp "/error/code" data #f)) (next-dispatcher) (response-handler (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 headers (if redirect-msg (let* ([dest (get-attribute 'href (bits->attributes ((query-selector (λ (t a c) (eq? t 'a)) redirect-msg))))]