forked from cadence/breezewiki
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,26 +24,28 @@
|
|||
(make-hasheq
|
||||
(append
|
||||
default-config
|
||||
(with-handlers ([exn:fail:filesystem:errno?
|
||||
(λ (exn)
|
||||
(begin0
|
||||
'()
|
||||
(displayln "note: config file not detected, using defaults")))]
|
||||
[exn:fail:contract?
|
||||
(λ (exn)
|
||||
(begin0
|
||||
'()
|
||||
(displayln "note: config file empty or missing [] section, using defaults")))])
|
||||
(let ([l (hash->list
|
||||
(hash-ref
|
||||
(ini->hash
|
||||
(call-with-input-file path-config
|
||||
(λ (in)
|
||||
(read-ini in))))
|
||||
'||))])
|
||||
(begin0
|
||||
l
|
||||
(printf "note: ~a items loaded from config file~n" (length l))))))))
|
||||
(with-handlers
|
||||
([exn:fail:filesystem:errno?
|
||||
(λ (exn)
|
||||
(begin0
|
||||
'()
|
||||
(displayln "note: config file not detected, using defaults")))]
|
||||
[exn:fail:contract?
|
||||
(λ (exn)
|
||||
(begin0
|
||||
'()
|
||||
(displayln "note: config file empty or missing [] section, using defaults")))])
|
||||
(define l
|
||||
(hash->list
|
||||
(hash-ref
|
||||
(ini->hash
|
||||
(call-with-input-file path-config
|
||||
(λ (in)
|
||||
(read-ini in))))
|
||||
'||)))
|
||||
(begin0
|
||||
l
|
||||
(printf "note: ~a items loaded from config file~n" (length l)))))))
|
||||
|
||||
(when (config-true? 'debug)
|
||||
(printf "config: ~v~n" config))
|
||||
|
|
|
@ -33,11 +33,11 @@
|
|||
(ul (@ (class "my-category-list"))
|
||||
,@(map
|
||||
(λ (result)
|
||||
(let* ([title (jp "/title" result)]
|
||||
[page-path (regexp-replace* #rx" " title "_")])
|
||||
`(li
|
||||
(a (@ (href ,(format "/~a/wiki/~a" wikiname page-path)))
|
||||
,title))))
|
||||
(define title (jp "/title" result))
|
||||
(define page-path (regexp-replace* #rx" " title "_"))
|
||||
`(li
|
||||
(a (@ (href ,(format "/~a/wiki/~a" wikiname page-path)))
|
||||
,title)))
|
||||
members)))))
|
||||
|
||||
(define (page-category req)
|
||||
|
|
|
@ -42,7 +42,8 @@
|
|||
(div (@ (class "collapsible-content"))
|
||||
(p "Another page link: "
|
||||
(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 (rr* find replace contents)
|
||||
|
@ -95,10 +96,10 @@
|
|||
return-no-element]
|
||||
; display a link instead of an iframe
|
||||
[(eq? element-type 'iframe)
|
||||
(let ([src (car (dict-ref attributes 'src null))])
|
||||
`(a
|
||||
((class "iframe-alternative") (href ,src))
|
||||
(,(format "Embedded media: ~a" src))))]
|
||||
(define src (car (dict-ref attributes 'src null)))
|
||||
`(a
|
||||
((class "iframe-alternative") (href ,src))
|
||||
(,(format "Embedded media: ~a" src)))]
|
||||
[#t
|
||||
(list element-type
|
||||
;; attributes
|
||||
|
@ -193,7 +194,13 @@
|
|||
((query-selector
|
||||
(λ (t a c) (dict-has-key? a 'data-test-collapsesection))
|
||||
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 wikiname (path/param-path (first (url-path (request-uri req)))))
|
||||
|
|
|
@ -70,16 +70,16 @@
|
|||
(define real-error-port (thread-receive))
|
||||
(say-loading-once! real-error-port)
|
||||
(let loop ()
|
||||
(let ([line (read-line i)])
|
||||
(cond
|
||||
[(eof-object? line)
|
||||
(void)]
|
||||
[(string-contains? line "[load")
|
||||
(display "." real-error-port)
|
||||
(loop)]
|
||||
[#t
|
||||
(displayln line real-error-port)
|
||||
(loop)]))))
|
||||
(define line (read-line i))
|
||||
(cond
|
||||
[(eof-object? line)
|
||||
(void)]
|
||||
[(string-contains? line "[load")
|
||||
(display "." real-error-port)
|
||||
(loop)]
|
||||
[#t
|
||||
(displayln line real-error-port)
|
||||
(loop)])))
|
||||
|
||||
;; Only to be called from reloader-main
|
||||
(define (do-reload!)
|
||||
|
|
|
@ -100,20 +100,22 @@
|
|||
(check-false (element-is-content? '(@ (alt "Cute cat."))))
|
||||
(check-true (element-is-content? "hi")))
|
||||
|
||||
; get the actual attributes, leaving out the @ signs
|
||||
(define (xattributes->attributes xattrs)
|
||||
(filter pair? xattrs))
|
||||
|
||||
(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))))
|
||||
(module+ test
|
||||
(check-equal? (bits->attributes demo-attributes)
|
||||
'((title "Inside joke.") (style "color: blue"))))
|
||||
|
||||
(define (get-attribute name attributes)
|
||||
(let ([a (assq name attributes)])
|
||||
(if (pair? a)
|
||||
(cadr a)
|
||||
#f)))
|
||||
(define a (assq name attributes))
|
||||
(if (pair? a)
|
||||
(cadr a)
|
||||
#f))
|
||||
(module+ test
|
||||
(check-equal? (get-attribute 'title (bits->attributes demo-attributes)) "Inside joke."))
|
||||
|
||||
|
@ -131,20 +133,17 @@
|
|||
(generator
|
||||
()
|
||||
(let loop ([element element])
|
||||
(let* ([element-type (car element)]
|
||||
; (append) is a clean and general approach to finding and combining any attributes
|
||||
; (filter pair?) is to get the actual attributes and leaves out the @ signs
|
||||
[attributes (bits->attributes (cdr element))]
|
||||
; only recurse through real children
|
||||
[children (filter element-is-element? (cdr element))])
|
||||
(cond
|
||||
[(equal? element-type '*DECL*) #f]
|
||||
[(equal? element-type '@) #f]
|
||||
[#t
|
||||
(when (selector element-type attributes children)
|
||||
(yield element))
|
||||
(for ([child children]) (loop child))])))
|
||||
#f))
|
||||
(define element-type (car element))
|
||||
(define attributes (bits->attributes (cdr element)))
|
||||
(define children (filter element-is-element? (cdr element))) ; only recurse through real children
|
||||
(cond
|
||||
[(equal? element-type '*DECL*) #f]
|
||||
[(equal? element-type '@) #f]
|
||||
[#t
|
||||
(when (selector element-type attributes children)
|
||||
(yield element))
|
||||
(for ([child children]) (loop child))]))
|
||||
#f))
|
||||
(module+ test
|
||||
(let ([result (query-selector (attribute-selector 'title "Really.")
|
||||
demo-document)])
|
||||
|
@ -155,24 +154,21 @@
|
|||
|
||||
(define (update-tree transformer element)
|
||||
(let loop ([element element])
|
||||
(let* ([element-type (car element)]
|
||||
; (append) is a clean and general approach to finding and combining any attributes
|
||||
; (filter pair?) is to get the actual attributes and leaves out the @ signs
|
||||
[attributes (bits->attributes (cdr element))]
|
||||
; provide elements and strings
|
||||
[contents (filter element-is-content? (cdr element))])
|
||||
(if (or (equal? element-type '*DECL)
|
||||
(equal? element-type '@))
|
||||
; special element, do nothing
|
||||
element
|
||||
; regular element, transform it
|
||||
(match (transformer element element-type attributes contents)
|
||||
[(list element-type attributes contents)
|
||||
(append (list element-type)
|
||||
(if (pair? attributes) (list (append '(@) attributes)) (list))
|
||||
(map (λ (content)
|
||||
(if (element-is-element? content) (loop content) content))
|
||||
contents))])))))
|
||||
(define element-type (car element))
|
||||
(define attributes (bits->attributes (cdr element)))
|
||||
(define contents (filter element-is-content? (cdr element))) ; provide elements and strings
|
||||
(if (or (equal? element-type '*DECL)
|
||||
(equal? element-type '@))
|
||||
; special element, do nothing
|
||||
element
|
||||
; regular element, transform it
|
||||
(match (transformer element element-type attributes contents)
|
||||
[(list element-type attributes contents)
|
||||
(append (list element-type)
|
||||
(if (pair? attributes) (list (append '(@) attributes)) (list))
|
||||
(map (λ (content)
|
||||
(if (element-is-element? content) (loop content) content))
|
||||
contents))]))))
|
||||
|
||||
(define (has-class? name attributes)
|
||||
(and (member name (string-split (or (get-attribute 'class attributes) "") " ")) #t))
|
||||
|
|
Loading…
Reference in a new issue