cadence/breezewiki
2
4
Fork 4
Code Issues Pull requests 1 Releases Wiki Activity

Compare commits

base: cadence:155a277f26ca68b00f1899e5f584d09b11373d35
Branches Tags
cadence:main
cadence:disable-requests
cadence:early-hints
..
compare: cadence:5fa6e2fb9e6a00c964a3c8bffe66351ed5b3e7b2
Branches Tags
cadence:main
cadence:disable-requests
cadence:early-hints

No commits in common. "155a277f26ca68b00f1899e5f584d09b11373d35" and "5fa6e2fb9e6a00c964a3c8bffe66351ed5b3e7b2" have entirely different histories.
155a277f26 ... 5fa6e2fb9e

9 changed files with 226 additions and 271 deletions
Download patch file Download diff file Expand all files Collapse all files

62
lib/syntax.rkt
View file

@ -4,6 +4,8 @@
(provide (provide
; help make a nested if. if/in will gain the same false form of its containing if/out. ; help make a nested if. if/in will gain the same false form of its containing if/out.
if/out if/out
; let, but the value for each variable is evaluated within a thread
thread-let
; cond, but values can be defined between conditions ; cond, but values can be defined between conditions
cond/var cond/var
; wrap sql statements into lambdas so they can be executed during migration ; wrap sql statements into lambdas so they can be executed during migration
@ -23,6 +25,7 @@
(provide (provide
transform-if/out transform-if/out
transform-thread-let
transform/out-cond/var) transform/out-cond/var)
(define (transform-if/out stx) (define (transform-if/out stx)
@ -48,6 +51,26 @@
[#t node]))) [#t node])))
(datum->syntax stx (cons 'if result))) (datum->syntax stx (cons 'if result)))
(define (transform-thread-let stx)
(define tree (cdr (syntax->datum stx)))
(define defs (car tree))
(define forms (cdr tree))
(when (eq? (length forms) 0)
(error (format "thread-let: bad syntax (need some forms to execute after the threads)~n forms: ~a" forms)))
(define counter (build-list (length defs) values))
(datum->syntax
stx
`(let ([chv (build-vector ,(length defs) (λ (_) (make-channel)))])
,@(map (λ (n)
(define def (list-ref defs n))
`(thread (λ () (channel-put (vector-ref chv ,n) (let _ () ,@(cdr def))))))
counter)
(let ,(map (λ (n)
(define def (list-ref defs n))
`(,(car def) (channel-get (vector-ref chv ,n))))
counter)
,@forms))))
(define (transform/out-cond/var stx) (define (transform/out-cond/var stx)
(define tree (transform-cond/var (cdr (syntax->datum stx)))) (define tree (transform-cond/var (cdr (syntax->datum stx))))
(datum->syntax (datum->syntax
@ -60,11 +83,11 @@
(if (null? rest) (if (null? rest)
`(cond ,@els) `(cond ,@els)
`(cond `(cond
,@els ,@els
[#t [#t
(let* ,(for/list ([var vars]) (let ,(for/list ([var vars])
(cdr var)) (cdr var))
,(transform-cond/var rest))])))) ,(transform-cond/var rest))]))))
;; the syntax definitions and their tests go below here ;; the syntax definitions and their tests go below here
@ -96,6 +119,35 @@
(check-equal? (if/out #t (if/in #f 'yes) 'no) 'no) (check-equal? (if/out #t (if/in #f 'yes) 'no) 'no)
(check-equal? (if/out #f (if/in #f 'yes) 'no) 'no)) (check-equal? (if/out #f (if/in #f 'yes) 'no) 'no))
(define-syntax (thread-let stx)
(transform-thread-let stx))
(module+ test
; check that it is transformed as expected
(check-syntax-equal?
(transform-thread-let
#'(thread-let ([a (hey "this is a")]
[b (hey "this is b")])
(list a b)))
#'(let ([chv (build-vector 2 (λ (_) (make-channel)))])
(thread (λ () (channel-put (vector-ref chv 0) (let _ () (hey "this is a")))))
(thread (λ () (channel-put (vector-ref chv 1) (let _ () (hey "this is b")))))
(let ([a (channel-get (vector-ref chv 0))]
[b (channel-get (vector-ref chv 1))])
(list a b))))
; check that they actually execute concurrently
(define ch (make-channel))
(check-equal? (thread-let ([a (begin
(channel-put ch 'a)
(channel-get ch))]
[b (begin0
(channel-get ch)
(channel-put ch 'b))])
(list a b))
'(b a))
; check that it assigns the correct value to the correct variable
(check-equal? (thread-let ([a (sleep 0) 'a] [b 'b]) (list a b))
'(a b)))
(define-syntax (cond/var stx) (define-syntax (cond/var stx)
(transform/out-cond/var stx)) (transform/out-cond/var stx))
(module+ test (module+ test

72
lib/thread-utils.rkt
View file

@ -1,72 +0,0 @@
#lang racket/base
(require (prefix-in easy: net/http-easy)
"../src/data.rkt"
"xexpr-utils.rkt")
(provide
thread-values)
(module+ test
(require rackunit))
(define (thread-values . thunks)
(parameterize-break #t
(define the-exn (box #f))
(define original-thread (current-thread))
(define (break e)
(when (box-cas! the-exn #f e)
(break-thread original-thread))
(sleep 0))
(define-values (threads channels)
(for/fold ([ts null]
[chs null]
#:result (values (reverse ts) (reverse chs)))
([th thunks])
(define ch (make-channel))
(define t
(thread (λ ()
(with-handlers ([exn? break])
(channel-put ch (th))))))
(values (cons t ts) (cons ch chs))))
(apply
values
(with-handlers ([exn:break? (λ (_)
(for ([t threads]) (kill-thread t))
(if (unbox the-exn)
(raise (unbox the-exn))
(error 'thread-values "a thread broke, but without reporting its exception")))])
(for/list ([ch channels])
(channel-get ch))))))
(module+ test
; check that they actually execute concurrently
(define ch (make-channel))
(check-equal? (let-values ([(a b)
(thread-values
(λ ()
(begin
(channel-put ch 'a)
(channel-get ch)))
(λ ()
(begin0
(channel-get ch)
(channel-put ch 'b))))])
(list a b))
'(b a))
; check that it assigns the correct value to the correct variable
(check-equal? (let-values ([(a b)
(thread-values
(λ () (sleep 0) 'a)
(λ () 'b))])
(list a b))
'(a b))
; check that exceptions are passed to the original thread, and other threads are killed
;; TODO: if the other thread was making an HTTP request, could it be left stuck open by the kill?
(check-equal? (let* ([x "!"]
[res
(with-handlers ([exn:fail:user? (λ (e) (exn-message e))])
(thread-values
(λ () (sleep 0) (set! x "?") (println "this side effect should not happen"))
(λ () (raise-user-error "catch me"))))])
(string-append res x))
"catch me!"))

4
lib/tree-updater.rkt
View file

@ -277,8 +277,8 @@
; check that noscript images are removed ; check that noscript images are removed
(check-equal? ((query-selector (λ (t a c) (eq? t 'noscript)) transformed)) #f) (check-equal? ((query-selector (λ (t a c) (eq? t 'noscript)) transformed)) #f)
; benchmark ; benchmark
(when (file-exists? "../storage/Frog.html") (when (file-exists? "../misc/Frog.html")
(with-input-from-file "../storage/Frog.html" (with-input-from-file "../misc/Frog.html"
(λ () (λ ()
(define tree (html->xexp (current-input-port))) (define tree (html->xexp (current-input-port)))
(time (length (update-tree-wiki tree "minecraft"))))))) (time (length (update-tree-wiki tree "minecraft")))))))

17
src/application-globals.rkt
View file

@ -201,16 +201,13 @@
,(if (config-true? 'instance_is_official) ,(if (config-true? 'instance_is_official)
(let ([balloon '(img (@ (src "/static/three-balloons.png") (class "bw-balloon") (title "Image Source: pngimg.com/image/4955 | License: CC BY-NC 4.0 | Modifications: Resized") (width "52") (height "56")))] (let ([balloon '(img (@ (src "/static/three-balloons.png") (class "bw-balloon") (title "Image Source: pngimg.com/image/4955 | License: CC BY-NC 4.0 | Modifications: Resized") (width "52") (height "56")))]
[extension-eligible? [extension-eligible?
(cond/var (and req (let* ([ua-pair (assq 'user-agent (request-headers req))]
[(not req) #f] [ua (string-downcase (cdr ua-pair))])
(var ua-pair (assq 'user-agent (request-headers req))) ;; everyone pretends to be chrome, so we do it in reverse
[(not ua-pair) #f] ;; this excludes common browsers that don't support the extension
(var ua (string-downcase (cdr ua-pair))) (and (not (string-contains? ua "edge/"))
;; everyone pretends to be chrome, so we do it in reverse (not (string-contains? ua "edg/"))
;; this excludes common browsers that don't support the extension (not (string-contains? ua "mobile")))))])
[#t (and (not (string-contains? ua "edge/"))
(not (string-contains? ua "edg/"))
(not (string-contains? ua "mobile")))])])
`(div (@ (class "bw-top-banner")) `(div (@ (class "bw-top-banner"))
,balloon ,balloon
(div (div

19
src/extwiki-generic.rkt
View file

@ -20,7 +20,6 @@
(define wikis (define wikis
'(((gallowmere) "MediEvil Wiki" "https://medievil.wiki/w/Main_Page" #f #f) '(((gallowmere) "MediEvil Wiki" "https://medievil.wiki/w/Main_Page" #f #f)
((fallout) "Fallout Wiki" "https://fallout.wiki/wiki/Fallout_Wiki" #f "https://fallout.wiki/api.php") ((fallout) "Fallout Wiki" "https://fallout.wiki/wiki/Fallout_Wiki" #f "https://fallout.wiki/api.php")
((drawntolife) "Wapopedia" "https://drawntolife.wiki/en/Main_Page" #f "https://drawntolife.wiki/w/api.php")
)) ))
(define wikis-hash (make-hash)) (define wikis-hash (make-hash))
@ -29,7 +28,7 @@
(hash-set! wikis-hash (symbol->string wikiname) w))) (hash-set! wikis-hash (symbol->string wikiname) w)))
(module+ test (module+ test
(check-equal? (cadr (hash-ref wikis-hash "gallowmere")) (check-equal? (cadr (hash-ref wikis-hash "gallowmere"))
"MediEvil Wiki")) "Gallowmere Historia"))
(define (parse-table table) (define (parse-table table)
(define rows (query-selector (λ (t a c) (eq? t 'tr)) table)) (define rows (query-selector (λ (t a c) (eq? t 'tr)) table))
@ -59,10 +58,8 @@
[(not logo) (values #f '("Data table must have a \"Logo\" column"))] [(not logo) (values #f '("Data table must have a \"Logo\" column"))]
[(null? logo) (values #f '("Logo table column must have a link"))] [(null? logo) (values #f '("Logo table column must have a link"))]
(var href (get-attribute 'href (bits->attributes (car (hash-ref table 'logo))))) (var href (get-attribute 'href (bits->attributes (car (hash-ref table 'logo)))))
(var src (get-attribute 'src (bits->attributes (car (hash-ref table 'logo))))) [(not href) (values #f '("Logo table column must have a link"))]
(var true-src (or href src)) [#t (values href null)]))
[(not true-src) (values #f '("Logo table column must have a link"))]
[#t (values true-src null)]))
(define (get-api-endpoint wiki) (define (get-api-endpoint wiki)
(define main-page (third wiki)) (define main-page (third wiki))
@ -80,7 +77,7 @@
(or override (or override
(match main-page (match main-page
[(regexp #rx"/$") (string-append main-page "Special:Search")] [(regexp #rx"/$") (string-append main-page "Special:Search")]
[(regexp #rx"^(.*/(?:en|w[^./]*)/)" (list _ wiki-prefix)) (string-append wiki-prefix "Special:Search")] [(regexp #rx"^(.*/w[^./]*/)" (list _ wiki-prefix)) (string-append wiki-prefix "Special:Search")]
[_ (error 'get-search-page "unknown url format: ~a" main-page)]))) [_ (error 'get-search-page "unknown url format: ~a" main-page)])))
(define/memoize (get-redirect-content wikiname) #:hash hash (define/memoize (get-redirect-content wikiname) #:hash hash
@ -112,10 +109,8 @@
,@body ,@body
(p "This wiki's core community has wholly migrated away from Fandom. You should " (p "This wiki's core community has wholly migrated away from Fandom. You should "
(a (@ (href ,go)) "go to " ,display-name " now!"))) (a (@ (href ,go)) "go to " ,display-name " now!")))
,(if logo (div (@ (class "niwa__right"))
`(div (@ (class "niwa__right")) (img (@ (class "niwa__logo") (src ,logo)))))
(img (@ (class "niwa__logo") (src ,logo))))
""))
,(if (pair? links) ,(if (pair? links)
`(p (@ (class "niwa__feedback")) `(p (@ (class "niwa__feedback"))
,@(add-between links " / ")) ,@(add-between links " / "))
@ -127,4 +122,4 @@
"")))] "")))]
[#t #f])) [#t #f]))
(module+ test (module+ test
(check-not-false ((get-redirect-content "gallowmere") "MediEvil Wiki"))) ((get-redirect-content "gallowmere") "Gallowmere Historia"))

99
src/page-category.rkt
View file

@ -17,7 +17,6 @@
"data.rkt" "data.rkt"
"page-wiki.rkt" "page-wiki.rkt"
"../lib/syntax.rkt" "../lib/syntax.rkt"
"../lib/thread-utils.rkt"
"../lib/url-utils.rkt" "../lib/url-utils.rkt"
"whole-utils.rkt" "whole-utils.rkt"
"../lib/xexpr-utils.rkt") "../lib/xexpr-utils.rkt")
@ -70,59 +69,55 @@
(define origin (format "https://~a.fandom.com" wikiname)) (define origin (format "https://~a.fandom.com" wikiname))
(define source-url (format "~a/wiki/~a" origin prefixed-category)) (define source-url (format "~a/wiki/~a" origin prefixed-category))
(define-values (members-data page-data siteinfo) (thread-let
(thread-values ([members-data (define dest-url
(λ () (format "~a/api.php?~a"
(define dest-url origin
(format "~a/api.php?~a" (params->query `(("action" . "query")
origin ("list" . "categorymembers")
(params->query `(("action" . "query") ("cmtitle" . ,prefixed-category)
("list" . "categorymembers") ("cmlimit" . "max")
("cmtitle" . ,prefixed-category) ("formatversion" . "2")
("cmlimit" . "max") ("format" . "json")))))
("formatversion" . "2") (log-outgoing dest-url)
("format" . "json"))))) (define dest-res (easy:get dest-url #:timeouts timeouts))
(log-outgoing dest-url) (easy:response-json dest-res)]
(define dest-res (easy:get dest-url #:timeouts timeouts)) [page-data (define dest-url
(easy:response-json dest-res)) (format "~a/api.php?~a"
(λ () origin
(define dest-url (params->query `(("action" . "parse")
(format "~a/api.php?~a" ("page" . ,prefixed-category)
origin ("prop" . "text|headhtml|langlinks")
(params->query `(("action" . "parse") ("formatversion" . "2")
("page" . ,prefixed-category) ("format" . "json")))))
("prop" . "text|headhtml|langlinks") (log-outgoing dest-url)
("formatversion" . "2") (define dest-res (easy:get dest-url #:timeouts timeouts))
("format" . "json"))))) (easy:response-json dest-res)]
(log-outgoing dest-url) [siteinfo (siteinfo-fetch wikiname)])
(define dest-res (easy:get dest-url #:timeouts timeouts))
(easy:response-json dest-res))
(λ ()
(siteinfo-fetch wikiname))))
(define title (preprocess-html-wiki (jp "/parse/title" page-data prefixed-category))) (define title (preprocess-html-wiki (jp "/parse/title" page-data prefixed-category)))
(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 head-data ((head-data-getter wikiname) page-data)) (define head-data ((head-data-getter wikiname) page-data))
(define body (generate-results-page (define body (generate-results-page
#:req req #:req req
#:source-url source-url #:source-url source-url
#:wikiname wikiname #:wikiname wikiname
#:title title #:title title
#:members-data members-data #:members-data members-data
#:page page #:page page
#:head-data head-data #:head-data head-data
#:siteinfo siteinfo)) #:siteinfo siteinfo))
(when (config-true? 'debug) (when (config-true? 'debug)
; used for its side effects ; used for its side effects
; convert to string with error checking, error will be raised if xexp is invalid ; convert to string with error checking, error will be raised if xexp is invalid
(xexp->html body)) (xexp->html body))
(response/output (response/output
#:code 200 #:code 200
#:headers (build-headers always-headers) #:headers (build-headers always-headers)
(λ (out) (λ (out)
(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 (generate-results-page

76
src/page-file.rkt
View file

@ -17,7 +17,6 @@
"data.rkt" "data.rkt"
"page-wiki.rkt" "page-wiki.rkt"
"../lib/syntax.rkt" "../lib/syntax.rkt"
"../lib/thread-utils.rkt"
"../lib/url-utils.rkt" "../lib/url-utils.rkt"
"whole-utils.rkt" "whole-utils.rkt"
"../lib/xexpr-utils.rkt") "../lib/xexpr-utils.rkt")
@ -109,45 +108,42 @@
(define origin (format "https://~a.fandom.com" wikiname)) (define origin (format "https://~a.fandom.com" wikiname))
(define source-url (format "~a/wiki/~a" origin prefixed-title)) (define source-url (format "~a/wiki/~a" origin prefixed-title))
(define-values (media-detail siteinfo) (thread-let
(thread-values ([media-detail (define dest-url
(λ () (format "~a/wikia.php?~a"
(define dest-url origin
(format "~a/wikia.php?~a" (params->query `(("format" . "json") ("controller" . "Lightbox")
origin ("method" . "getMediaDetail")
(params->query `(("format" . "json") ("controller" . "Lightbox") ("fileTitle" . ,prefixed-title)))))
("method" . "getMediaDetail") (log-outgoing dest-url)
("fileTitle" . ,prefixed-title))))) (define dest-res (easy:get dest-url #:timeouts timeouts))
(log-outgoing dest-url) (easy:response-json dest-res)]
(define dest-res (easy:get dest-url #:timeouts timeouts)) [siteinfo (siteinfo-fetch wikiname)])
(easy:response-json dest-res)) (if (not (jp "/exists" media-detail #f))
(λ () (next-dispatcher)
(siteinfo-fetch wikiname)))) (response-handler
(if (not (jp "/exists" media-detail #f)) (define file-title (jp "/fileTitle" media-detail ""))
(next-dispatcher) (define title
(response-handler (if (non-empty-string? file-title) (format "File:~a" file-title) prefixed-title))
(define file-title (jp "/fileTitle" media-detail "")) (define image-content-type
(define title (if (non-empty-string? (jp "/videoEmbedCode" media-detail ""))
(if (non-empty-string? file-title) (format "File:~a" file-title) prefixed-title)) #f
(define image-content-type (url-content-type (jp "/imageUrl" media-detail))))
(if (non-empty-string? (jp "/videoEmbedCode" media-detail "")) (define body
#f (generate-results-page #:req req
(url-content-type (jp "/imageUrl" media-detail)))) #:source-url source-url
(define body #:wikiname wikiname
(generate-results-page #:req req #:title title
#:source-url source-url #:media-detail media-detail
#:wikiname wikiname #:image-content-type image-content-type
#:title title #:siteinfo siteinfo))
#:media-detail media-detail (when (config-true? 'debug)
#:image-content-type image-content-type ; used for its side effects
#:siteinfo siteinfo)) ; convert to string with error checking, error will be raised if xexp is invalid
(when (config-true? 'debug) (xexp->html body))
; used for its side effects (response/output #:code 200
; convert to string with error checking, error will be raised if xexp is invalid #:headers (build-headers always-headers)
(xexp->html body)) (λ (out) (write-html body out))))))))
(response/output #:code 200
#:headers (build-headers always-headers)
(λ (out) (write-html body out)))))))
(module+ test (module+ test
(parameterize ([(config-parameter 'strict_proxy) "true"]) (parameterize ([(config-parameter 'strict_proxy) "true"])
(check-equal? (get-media-html "https://static.wikia.nocookie.net/a" "image/jpeg") (check-equal? (get-media-html "https://static.wikia.nocookie.net/a" "image/jpeg")

34
src/page-search.rkt
View file

@ -14,7 +14,6 @@
"config.rkt" "config.rkt"
"data.rkt" "data.rkt"
"../lib/syntax.rkt" "../lib/syntax.rkt"
"../lib/thread-utils.rkt"
"../lib/url-utils.rkt" "../lib/url-utils.rkt"
"whole-utils.rkt" "whole-utils.rkt"
"../lib/xexpr-utils.rkt") "../lib/xexpr-utils.rkt")
@ -73,26 +72,23 @@
("formatversion" . "2") ("formatversion" . "2")
("format" . "json"))))) ("format" . "json")))))
(define-values (dest-res siteinfo) (thread-let
(thread-values ([dest-res (log-outgoing dest-url)
(λ () (easy:get dest-url #:timeouts timeouts)]
(log-outgoing dest-url) [siteinfo (siteinfo-fetch wikiname)])
(easy:get dest-url #:timeouts timeouts))
(λ ()
(siteinfo-fetch wikiname))))
(define data (easy:response-json dest-res)) (define data (easy:response-json dest-res))
(define body (generate-results-page req dest-url wikiname query data #:siteinfo siteinfo)) (define body (generate-results-page req dest-url wikiname query data #:siteinfo siteinfo))
(when (config-true? 'debug) (when (config-true? 'debug)
; used for its side effects ; used for its side effects
; convert to string with error checking, error will be raised if xexp is invalid ; convert to string with error checking, error will be raised if xexp is invalid
(xexp->html body)) (xexp->html body))
(response/output (response/output
#:code 200 #:code 200
#:headers (build-headers always-headers) #:headers (build-headers always-headers)
(λ (out) (λ (out)
(write-html body out))))) (write-html body out))))))
(module+ test (module+ test
(parameterize ([(config-parameter 'feature_offline::only) "false"]) (parameterize ([(config-parameter 'feature_offline::only) "false"])
(check-not-false ((query-selector (attribute-selector 'href "/test/wiki/Gacha_Capsule") (check-not-false ((query-selector (attribute-selector 'href "/test/wiki/Gacha_Capsule")

114
src/page-wiki.rkt
View file

@ -19,7 +19,6 @@
"data.rkt" "data.rkt"
"../lib/pure-utils.rkt" "../lib/pure-utils.rkt"
"../lib/syntax.rkt" "../lib/syntax.rkt"
"../lib/thread-utils.rkt"
"../lib/tree-updater.rkt" "../lib/tree-updater.rkt"
"../lib/url-utils.rkt" "../lib/url-utils.rkt"
"whole-utils.rkt" "whole-utils.rkt"
@ -42,62 +41,59 @@
(define path (string-join (map path/param-path (cddr (url-path (request-uri req)))) "/")) (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)) (define source-url (format "https://~a.fandom.com/wiki/~a" wikiname path))
(define-values (dest-res siteinfo) (thread-let
(thread-values ([dest-res (define dest-url
(λ () (format "~a/api.php?~a"
(define dest-url origin
(format "~a/api.php?~a" (params->query `(("action" . "parse")
origin ("page" . ,path)
(params->query `(("action" . "parse") ("prop" . "text|headhtml|langlinks")
("page" . ,path) ("formatversion" . "2")
("prop" . "text|headhtml|langlinks") ("format" . "json")))))
("formatversion" . "2") (log-outgoing dest-url)
("format" . "json"))))) (easy:get dest-url
(log-outgoing dest-url) #:timeouts timeouts
(easy:get dest-url #:headers `#hasheq((cookie . ,(format "theme=~a" (user-cookies^-theme user-cookies)))))]
#:timeouts timeouts [siteinfo (siteinfo-fetch wikiname)])
#:headers `#hasheq((cookie . ,(format "theme=~a" (user-cookies^-theme user-cookies))))))
(λ ()
(siteinfo-fetch wikiname))))
(cond (cond
[(eq? 200 (easy:response-status-code dest-res)) [(eq? 200 (easy:response-status-code dest-res))
(let* ([data (easy:response-json dest-res)] (let* ([data (easy:response-json dest-res)]
[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-data ((head-data-getter wikiname) data)]) [head-data ((head-data-getter wikiname) data)])
(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 (generate-wiki-page
(update-tree-wiki page wikiname) (update-tree-wiki page wikiname)
#:req req #:req req
#:source-url source-url #:source-url source-url
#:wikiname wikiname #:wikiname wikiname
#:title title #:title title
#:head-data head-data #:head-data head-data
#:siteinfo siteinfo)) #:siteinfo siteinfo))
(define redirect-msg ((query-selector (attribute-selector 'class "redirectMsg") body))) (define redirect-msg ((query-selector (attribute-selector 'class "redirectMsg") body)))
(define redirect-query-parameter (dict-ref (url-query (request-uri req)) 'redirect "yes")) (define redirect-query-parameter (dict-ref (url-query (request-uri req)) 'redirect "yes"))
(define headers (define headers
(build-headers (build-headers
always-headers always-headers
; redirect-query-parameter: only the string "no" is significant: ; redirect-query-parameter: only the string "no" is significant:
; https://github.com/Wikia/app/blob/fe60579a53f16816d65dad1644363160a63206a6/includes/Wiki.php#L367 ; https://github.com/Wikia/app/blob/fe60579a53f16816d65dad1644363160a63206a6/includes/Wiki.php#L367
(when (and redirect-msg (when (and redirect-msg
(not (equal? redirect-query-parameter "no"))) (not (equal? redirect-query-parameter "no")))
(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))))]
[value (bytes-append #"0;url=" (string->bytes/utf-8 dest))]) [value (bytes-append #"0;url=" (string->bytes/utf-8 dest))])
(header #"Refresh" value))))) (header #"Refresh" value)))))
(when (config-true? 'debug) (when (config-true? 'debug)
; used for its side effects ; used for its side effects
; convert to string with error checking, error will be raised if xexp is invalid ; convert to string with error checking, error will be raised if xexp is invalid
(xexp->html body)) (xexp->html body))
(response/output (response/output
#:code 200 #:code 200
#:headers headers #:headers headers
(λ (out) (λ (out)
(write-html body out))))))])) (write-html body out))))))])))