Support light/dark themes as per Fandom's styles

This commit is contained in:
Cadence Ember 2022-11-30 00:03:54 +13:00
parent 92591a5eab
commit 9afccbb9cd
Signed by untrusted user: cadence
GPG key ID: BC1C2C61CF521B17
15 changed files with 157 additions and 18 deletions

View file

@ -1,8 +1,10 @@
#lang racket/base
(require racket/list
(require racket/file
racket/list
racket/string
json
(prefix-in easy: net/http-easy)
html-parsing
html-writing
web-server/http
"config.rkt"
@ -34,6 +36,11 @@
(header #"Link" (string->bytes/latin-1 link-header))))
(define timeouts (easy:make-timeout-config #:lease 5 #:connect 5))
(define theme-icons
(for/hasheq ([theme '(default light dark)])
(values theme
(html->xexp (file->string (format "static/icon-theme-~a.svg" theme) #:mode 'binary)))))
(define (application-footer source-url #:license [license-in #f])
(define license (or license-in license-default))
`(footer (@ (class "custom-footer"))
@ -98,24 +105,27 @@
(define (generate-wiki-page
content
#:req req
#:source-url source-url
#:wikiname wikiname
#:title title
#:head-data [head-data-in #f]
#:siteinfo [siteinfo-in #f])
#:siteinfo [siteinfo-in #f]
#:user-cookies [user-cookies-in #f])
(define siteinfo (or siteinfo-in siteinfo-default))
(define head-data (or head-data-in ((head-data-getter wikiname))))
(define user-cookies (or user-cookies-in (user-cookies-getter req)))
(define (required-styles origin)
(map (λ (dest-path)
(define url (format dest-path origin))
(if (config-true? 'strict_proxy)
(u-proxy-url url)
url))
'(#;"~a/load.php?lang=en&modules=skin.fandomdesktop.styles&only=styles&skin=fandomdesktop"
`(#;"~a/load.php?lang=en&modules=skin.fandomdesktop.styles&only=styles&skin=fandomdesktop"
#;"~a/load.php?lang=en&modules=ext.gadget.dungeonsWiki%2CearthWiki%2Csite-styles%2Csound-styles&only=styles&skin=fandomdesktop"
#;"~a/load.php?lang=en&modules=site.styles&only=styles&skin=fandomdesktop"
; combine the above entries into a single request for potentially extra speed - fandom.com doesn't even do this!
"~a/wikia.php?controller=ThemeApi&method=themeVariables"
,(format "~~a/wikia.php?controller=ThemeApi&method=themeVariables&variant=~a" (user-cookies^-theme user-cookies))
"~a/load.php?lang=en&modules=skin.fandomdesktop.styles%7Cext.fandom.PortableInfoboxFandomDesktop.css%7Cext.fandom.GlobalComponents.CommunityHeaderBackground.css%7Cext.gadget.site-styles%2Csound-styles%7Csite.styles&only=styles&skin=fandomdesktop")))
`(*TOP*
(*DECL* DOCTYPE html)
@ -155,7 +165,22 @@
(label (@ (for "bw-search-input")) "Search ")
(div (@ (id "bw-pr-search-input"))
(input (@ (type "text") (name "q") (id "bw-search-input") (autocomplete "off"))))
(div (@ (class "bw-ss__container") (id "bw-pr-search-suggestions"))))))
(div (@ (class "bw-ss__container") (id "bw-pr-search-suggestions"))))
(div (@ (class "bw-theme__select"))
(span (@ (class "bw-theme__main-label")) "Page theme")
(div (@ (class "bw-theme__items"))
,@(for/list ([theme '(default light dark)])
(define class
(if (equal? theme (user-cookies^-theme user-cookies))
"bw-theme__item bw-theme__item--selected"
"bw-theme__item"))
`(a (@ (href ,(user-cookies-setter-url
req
(struct-copy user-cookies^ user-cookies
[theme theme]))) (class ,class))
(div (@ (class "bw-theme__icon-container"))
,(hash-ref theme-icons theme))
,(format "~a" theme)))))))
(div (@ (id "content") #;(class "page-content"))
(div (@ (id "mw-content-text"))
,content))
@ -179,11 +204,11 @@
page))))
"/proxy?dest=https%3A%2F%2Ftest.fandom.com")))
(define (generate-redirect dest)
(define (generate-redirect dest #:headers [headers-in '()])
(define dest-bytes (string->bytes/utf-8 dest))
(response/output
#:code 302
#:headers (list (header #"Location" dest-bytes))
#:headers (append (list (header #"Location" dest-bytes)) headers-in)
(λ (out)
(write-html
`(html

View file

@ -1,6 +1,9 @@
#lang racket/base
(require racket/list
racket/match
web-server/http/request-structs
net/url-string
(only-in net/cookies/server cookie-header->alist cookie->set-cookie-header make-cookie)
(prefix-in easy: net/http-easy)
memo
"static-data.rkt"
@ -11,11 +14,16 @@
(struct-out siteinfo^)
(struct-out license^)
(struct-out head-data^)
(struct-out user-cookies^)
siteinfo-fetch
siteinfo-default
license-default
head-data-getter
head-data-default)
head-data-default
user-cookies-getter
user-cookies-default
user-cookies-setter
user-cookies-setter-url)
(struct siteinfo^ (sitename basepage license) #:transparent)
(struct license^ (text url) #:transparent)
@ -61,3 +69,27 @@
(set! this-data data))
;; then no matter what, return the best information we have so far
this-data))
(struct user-cookies^ (theme) #:prefab)
(define user-cookies-default (user-cookies^ 'default))
(define (user-cookies-getter req)
(define cookie-header (headers-assq* #"cookie" (request-headers/raw req)))
(define cookies-alist (if cookie-header (cookie-header->alist (header-value cookie-header) bytes->string/utf-8) null))
(define cookies-hash
(for/hasheq ([pair cookies-alist])
(match pair
[(cons "theme" (and theme (or "light" "dark" "default")))
(values 'theme (string->symbol theme))]
[_ (values #f #f)])))
(user-cookies^
(hash-ref cookies-hash 'theme (user-cookies^-theme user-cookies-default))))
(define (user-cookies-setter user-cookies)
(map (λ (c) (header #"Set-Cookie" (cookie->set-cookie-header c)))
(list (make-cookie "theme" (symbol->string (user-cookies^-theme user-cookies))
#:path "/"
#:max-age (* 60 60 24 365 10)))))
(define (user-cookies-setter-url req new-settings)
(format "/set-user-settings?~a" (params->query `(("ref" . ,(url->string (request-uri req)))
("new_settings" . ,(format "~a" new-settings))))))

View file

@ -39,6 +39,7 @@
(pathprocedure:make "/" (hash-ref ds 'page-home))
(pathprocedure:make "/proxy" (hash-ref ds 'page-proxy))
(pathprocedure:make "/search" (hash-ref ds 'page-global-search))
(pathprocedure:make "/set-user-settings" (hash-ref ds 'page-set-user-settings))
(pathprocedure:make "/buddyfight/wiki/It_Doesn't_Work!!" (hash-ref ds 'page-it-works))
(filter:make (pregexp (format "^/~a/wiki/Category:.+$" px-wikiname)) (lift:make (hash-ref ds 'page-category)))
(filter:make (pregexp (format "^/~a/wiki/File:.+$" px-wikiname)) (lift:make (hash-ref ds 'page-file)))

View file

@ -29,6 +29,7 @@
'#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
#:req req
#:source-url source-url
#:wikiname wikiname
#:title title
@ -38,6 +39,7 @@
#:siteinfo [siteinfo #f])
(define members (jp "/query/categorymembers" members-data))
(generate-wiki-page
#:req req
#:source-url source-url
#:wikiname wikiname
#:title title
@ -96,6 +98,7 @@
(define page (html->xexp page-html))
(define head-data ((head-data-getter wikiname) page-data))
(define body (generate-results-page
#:req req
#:source-url source-url
#:wikiname wikiname
#:title title

View file

@ -51,7 +51,8 @@
[(regexp-match? #rx"(?i:^video/)" content-type) `(video (@ (src ,maybe-proxied-url) (controls)))]
[else `""]))
(define (generate-results-page #:source-url source-url
(define (generate-results-page #:req req
#:source-url source-url
#:wikiname wikiname
#:title title
#:media-detail media-detail
@ -68,6 +69,7 @@
(define maybe-proxied-raw-image-url
(if (config-true? 'strict_proxy) (u-proxy-url raw-image-url) raw-image-url))
(generate-wiki-page
#:req req
#:source-url source-url
#:wikiname wikiname
#:title title
@ -125,7 +127,8 @@
#f
(url-content-type (jp "/imageUrl" media-detail))))
(define body
(generate-results-page #:source-url source-url
(generate-results-page #:req req
#:source-url source-url
#:wikiname wikiname
#:title title
#:media-detail media-detail

View file

@ -25,9 +25,10 @@
(define search-json-data
'#hasheq((batchcomplete . #t) (query . #hasheq((search . (#hasheq((ns . 0) (pageid . 219) (size . 1482) (snippet . "") (timestamp . "2022-08-21T08:54:23Z") (title . "Gacha Capsule") (wordcount . 214)) #hasheq((ns . 0) (pageid . 201) (size . 1198) (snippet . "") (timestamp . "2022-07-11T17:52:47Z") (title . "Badges") (wordcount . 181)))))))))
(define (generate-results-page dest-url wikiname query data #:siteinfo [siteinfo #f])
(define (generate-results-page req dest-url wikiname query data #:siteinfo [siteinfo #f])
(define search-results (jp "/query/search" data))
(generate-wiki-page
#:req req
#:source-url dest-url
#:wikiname wikiname
#:title query
@ -74,7 +75,7 @@
(define data (easy:response-json dest-res))
(define body (generate-results-page dest-url wikiname query data #:siteinfo siteinfo))
(define body (generate-results-page req dest-url wikiname query data #:siteinfo siteinfo))
(when (config-true? 'debug)
; used for its side effects
; convert to string with error checking, error will be raised if xexp is invalid

View file

@ -0,0 +1,18 @@
#lang racket/base
(require racket/dict
net/url
web-server/http
"application-globals.rkt"
"data.rkt"
"url-utils.rkt"
"xexpr-utils.rkt")
(provide
page-set-user-settings)
(define (page-set-user-settings req)
(response-handler
(define ref (dict-ref (url-query (request-uri req)) 'ref))
(define new-settings (read (open-input-string (dict-ref (url-query (request-uri req)) 'new_settings))))
(define headers (user-cookies-setter new-settings))
(generate-redirect ref #:headers headers)))

View file

@ -276,6 +276,7 @@
(define (page-wiki req)
(define wikiname (path/param-path (first (url-path (request-uri req)))))
(define user-cookies (user-cookies-getter req))
(define origin (format "https://~a.fandom.com" wikiname))
(define path (string-join (map path/param-path (cddr (url-path (request-uri req)))) "/"))
(define source-url (format "https://~a.fandom.com/wiki/~a" wikiname path))
@ -290,7 +291,9 @@
("formatversion" . "2")
("format" . "json")))))
(log-outgoing dest-url)
(easy:get dest-url #:timeouts timeouts)]
(easy:get dest-url
#:timeouts timeouts
#:headers `#hasheq((cookie . ,(format "theme=~a" (user-cookies^-theme user-cookies)))))]
[siteinfo (siteinfo-fetch wikiname)])
(cond
@ -307,6 +310,7 @@
(define body
(generate-wiki-page
(update-tree-wiki page wikiname)
#:req req
#:source-url source-url
#:wikiname wikiname
#:title title
@ -317,9 +321,9 @@
(build-headers
always-headers
(when redirect-msg
(let* ([dest (get-attribute 'href (bits->attributes ((query-selector (λ (t a c) (eq? t 'a)) redirect-msg))))]
[value (bytes-append #"0;url=" (string->bytes/utf-8 dest))])
(header #"Refresh" value)))))
(let* ([dest (get-attribute 'href (bits->attributes ((query-selector (λ (t a c) (eq? t 'a)) redirect-msg))))]
[value (bytes-append #"0;url=" (string->bytes/utf-8 dest))])
(header #"Refresh" value)))))
(when (config-true? 'debug)
; used for its side effects
; convert to string with error checking, error will be raised if xexp is invalid