Refactor let
to define
where applicable
Racke style guide: https://docs.racket-lang.org/style/Choosing_the_Right_Construct.html#%28part._.Definitions%29
This commit is contained in:
parent
301636d597
commit
a5079b5a57
5 changed files with 82 additions and 77 deletions
|
@ -24,7 +24,8 @@
|
||||||
(make-hasheq
|
(make-hasheq
|
||||||
(append
|
(append
|
||||||
default-config
|
default-config
|
||||||
(with-handlers ([exn:fail:filesystem:errno?
|
(with-handlers
|
||||||
|
([exn:fail:filesystem:errno?
|
||||||
(λ (exn)
|
(λ (exn)
|
||||||
(begin0
|
(begin0
|
||||||
'()
|
'()
|
||||||
|
@ -34,16 +35,17 @@
|
||||||
(begin0
|
(begin0
|
||||||
'()
|
'()
|
||||||
(displayln "note: config file empty or missing [] section, using defaults")))])
|
(displayln "note: config file empty or missing [] section, using defaults")))])
|
||||||
(let ([l (hash->list
|
(define l
|
||||||
|
(hash->list
|
||||||
(hash-ref
|
(hash-ref
|
||||||
(ini->hash
|
(ini->hash
|
||||||
(call-with-input-file path-config
|
(call-with-input-file path-config
|
||||||
(λ (in)
|
(λ (in)
|
||||||
(read-ini in))))
|
(read-ini in))))
|
||||||
'||))])
|
'||)))
|
||||||
(begin0
|
(begin0
|
||||||
l
|
l
|
||||||
(printf "note: ~a items loaded from config file~n" (length l))))))))
|
(printf "note: ~a items loaded from config file~n" (length l)))))))
|
||||||
|
|
||||||
(when (config-true? 'debug)
|
(when (config-true? 'debug)
|
||||||
(printf "config: ~v~n" config))
|
(printf "config: ~v~n" config))
|
||||||
|
|
|
@ -33,11 +33,11 @@
|
||||||
(ul (@ (class "my-category-list"))
|
(ul (@ (class "my-category-list"))
|
||||||
,@(map
|
,@(map
|
||||||
(λ (result)
|
(λ (result)
|
||||||
(let* ([title (jp "/title" result)]
|
(define title (jp "/title" result))
|
||||||
[page-path (regexp-replace* #rx" " title "_")])
|
(define page-path (regexp-replace* #rx" " title "_"))
|
||||||
`(li
|
`(li
|
||||||
(a (@ (href ,(format "/~a/wiki/~a" wikiname page-path)))
|
(a (@ (href ,(format "/~a/wiki/~a" wikiname page-path)))
|
||||||
,title))))
|
,title)))
|
||||||
members)))))
|
members)))))
|
||||||
|
|
||||||
(define (page-category req)
|
(define (page-category req)
|
||||||
|
|
|
@ -42,7 +42,8 @@
|
||||||
(div (@ (class "collapsible-content"))
|
(div (@ (class "collapsible-content"))
|
||||||
(p "Another page link: "
|
(p "Another page link: "
|
||||||
(a (@ (data-test-wikilink) (href "https://test.fandom.com/wiki/Another_Page") (title "Another Page"))
|
(a (@ (data-test-wikilink) (href "https://test.fandom.com/wiki/Another_Page") (title "Another Page"))
|
||||||
"Another Page"))))))))
|
"Another Page"))))
|
||||||
|
(iframe (@ (src "https://example.com/iframe-src")))))))
|
||||||
|
|
||||||
(define (preprocess-html-wiki html)
|
(define (preprocess-html-wiki html)
|
||||||
(define (rr* find replace contents)
|
(define (rr* find replace contents)
|
||||||
|
@ -95,10 +96,10 @@
|
||||||
return-no-element]
|
return-no-element]
|
||||||
; display a link instead of an iframe
|
; display a link instead of an iframe
|
||||||
[(eq? element-type 'iframe)
|
[(eq? element-type 'iframe)
|
||||||
(let ([src (car (dict-ref attributes 'src null))])
|
(define src (car (dict-ref attributes 'src null)))
|
||||||
`(a
|
`(a
|
||||||
((class "iframe-alternative") (href ,src))
|
((class "iframe-alternative") (href ,src))
|
||||||
(,(format "Embedded media: ~a" src))))]
|
(,(format "Embedded media: ~a" src)))]
|
||||||
[#t
|
[#t
|
||||||
(list element-type
|
(list element-type
|
||||||
;; attributes
|
;; attributes
|
||||||
|
@ -193,7 +194,13 @@
|
||||||
((query-selector
|
((query-selector
|
||||||
(λ (t a c) (dict-has-key? a 'data-test-collapsesection))
|
(λ (t a c) (dict-has-key? a 'data-test-collapsesection))
|
||||||
transformed))))
|
transformed))))
|
||||||
"collapsible collapsetoggle-inline"))
|
"collapsible collapsetoggle-inline")
|
||||||
|
; check that iframes are gone
|
||||||
|
(check-false ((query-selector (λ (t a c) (eq? t 'iframe)) transformed)))
|
||||||
|
(check-equal? (let* ([alternative ((query-selector (λ (t a c) (has-class? "iframe-alternative" a)) transformed))]
|
||||||
|
[link ((query-selector (λ (t a c) (eq? t 'a)) alternative))])
|
||||||
|
(get-attribute 'href (bits->attributes link)))
|
||||||
|
"https://example.com/iframe-src"))
|
||||||
|
|
||||||
(define (page-wiki req)
|
(define (page-wiki req)
|
||||||
(define wikiname (path/param-path (first (url-path (request-uri req)))))
|
(define wikiname (path/param-path (first (url-path (request-uri req)))))
|
||||||
|
|
|
@ -70,7 +70,7 @@
|
||||||
(define real-error-port (thread-receive))
|
(define real-error-port (thread-receive))
|
||||||
(say-loading-once! real-error-port)
|
(say-loading-once! real-error-port)
|
||||||
(let loop ()
|
(let loop ()
|
||||||
(let ([line (read-line i)])
|
(define line (read-line i))
|
||||||
(cond
|
(cond
|
||||||
[(eof-object? line)
|
[(eof-object? line)
|
||||||
(void)]
|
(void)]
|
||||||
|
@ -79,7 +79,7 @@
|
||||||
(loop)]
|
(loop)]
|
||||||
[#t
|
[#t
|
||||||
(displayln line real-error-port)
|
(displayln line real-error-port)
|
||||||
(loop)]))))
|
(loop)])))
|
||||||
|
|
||||||
;; Only to be called from reloader-main
|
;; Only to be called from reloader-main
|
||||||
(define (do-reload!)
|
(define (do-reload!)
|
||||||
|
|
|
@ -100,20 +100,22 @@
|
||||||
(check-false (element-is-content? '(@ (alt "Cute cat."))))
|
(check-false (element-is-content? '(@ (alt "Cute cat."))))
|
||||||
(check-true (element-is-content? "hi")))
|
(check-true (element-is-content? "hi")))
|
||||||
|
|
||||||
|
; get the actual attributes, leaving out the @ signs
|
||||||
(define (xattributes->attributes xattrs)
|
(define (xattributes->attributes xattrs)
|
||||||
(filter pair? xattrs))
|
(filter pair? xattrs))
|
||||||
|
|
||||||
(define (bits->attributes bits)
|
(define (bits->attributes bits)
|
||||||
|
; (append) is a clean and general approach to finding and combining any attributes
|
||||||
(xattributes->attributes (apply append (filter element-is-xattributes? bits))))
|
(xattributes->attributes (apply append (filter element-is-xattributes? bits))))
|
||||||
(module+ test
|
(module+ test
|
||||||
(check-equal? (bits->attributes demo-attributes)
|
(check-equal? (bits->attributes demo-attributes)
|
||||||
'((title "Inside joke.") (style "color: blue"))))
|
'((title "Inside joke.") (style "color: blue"))))
|
||||||
|
|
||||||
(define (get-attribute name attributes)
|
(define (get-attribute name attributes)
|
||||||
(let ([a (assq name attributes)])
|
(define a (assq name attributes))
|
||||||
(if (pair? a)
|
(if (pair? a)
|
||||||
(cadr a)
|
(cadr a)
|
||||||
#f)))
|
#f))
|
||||||
(module+ test
|
(module+ test
|
||||||
(check-equal? (get-attribute 'title (bits->attributes demo-attributes)) "Inside joke."))
|
(check-equal? (get-attribute 'title (bits->attributes demo-attributes)) "Inside joke."))
|
||||||
|
|
||||||
|
@ -131,19 +133,16 @@
|
||||||
(generator
|
(generator
|
||||||
()
|
()
|
||||||
(let loop ([element element])
|
(let loop ([element element])
|
||||||
(let* ([element-type (car element)]
|
(define element-type (car element))
|
||||||
; (append) is a clean and general approach to finding and combining any attributes
|
(define attributes (bits->attributes (cdr element)))
|
||||||
; (filter pair?) is to get the actual attributes and leaves out the @ signs
|
(define children (filter element-is-element? (cdr element))) ; only recurse through real children
|
||||||
[attributes (bits->attributes (cdr element))]
|
|
||||||
; only recurse through real children
|
|
||||||
[children (filter element-is-element? (cdr element))])
|
|
||||||
(cond
|
(cond
|
||||||
[(equal? element-type '*DECL*) #f]
|
[(equal? element-type '*DECL*) #f]
|
||||||
[(equal? element-type '@) #f]
|
[(equal? element-type '@) #f]
|
||||||
[#t
|
[#t
|
||||||
(when (selector element-type attributes children)
|
(when (selector element-type attributes children)
|
||||||
(yield element))
|
(yield element))
|
||||||
(for ([child children]) (loop child))])))
|
(for ([child children]) (loop child))]))
|
||||||
#f))
|
#f))
|
||||||
(module+ test
|
(module+ test
|
||||||
(let ([result (query-selector (attribute-selector 'title "Really.")
|
(let ([result (query-selector (attribute-selector 'title "Really.")
|
||||||
|
@ -155,12 +154,9 @@
|
||||||
|
|
||||||
(define (update-tree transformer element)
|
(define (update-tree transformer element)
|
||||||
(let loop ([element element])
|
(let loop ([element element])
|
||||||
(let* ([element-type (car element)]
|
(define element-type (car element))
|
||||||
; (append) is a clean and general approach to finding and combining any attributes
|
(define attributes (bits->attributes (cdr element)))
|
||||||
; (filter pair?) is to get the actual attributes and leaves out the @ signs
|
(define contents (filter element-is-content? (cdr element))) ; provide elements and strings
|
||||||
[attributes (bits->attributes (cdr element))]
|
|
||||||
; provide elements and strings
|
|
||||||
[contents (filter element-is-content? (cdr element))])
|
|
||||||
(if (or (equal? element-type '*DECL)
|
(if (or (equal? element-type '*DECL)
|
||||||
(equal? element-type '@))
|
(equal? element-type '@))
|
||||||
; special element, do nothing
|
; special element, do nothing
|
||||||
|
@ -172,7 +168,7 @@
|
||||||
(if (pair? attributes) (list (append '(@) attributes)) (list))
|
(if (pair? attributes) (list (append '(@) attributes)) (list))
|
||||||
(map (λ (content)
|
(map (λ (content)
|
||||||
(if (element-is-element? content) (loop content) content))
|
(if (element-is-element? content) (loop content) content))
|
||||||
contents))])))))
|
contents))]))))
|
||||||
|
|
||||||
(define (has-class? name attributes)
|
(define (has-class? name attributes)
|
||||||
(and (member name (string-split (or (get-attribute 'class attributes) "") " ")) #t))
|
(and (member name (string-split (or (get-attribute 'class attributes) "") " ")) #t))
|
||||||
|
|
Loading…
Reference in a new issue