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:
		
							parent
							
								
									33ee6a0624
								
							
						
					
					
						commit
						0172034319
					
				
					 5 changed files with 86 additions and 40 deletions
				
			
		| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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)
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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"<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)
 | 
			
		||||
      ; 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"))))))
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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))
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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"<body [^>]*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))))]
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue