artemis/breezewiki
1
0
Fork 0
forked from cadence/breezewiki
Code Issues Pull requests 2 Projects Releases Packages Wiki Activity

Refactor let to define where applicable

Browse source 
Racke style guide:
https://docs.racket-lang.org/style/Choosing_the_Right_Construct.html#%28part._.Definitions%29
This commit is contained in:
Cadence Ember 2022-08-30 21:58:59 +12:00
parent 301636d597
commit a5079b5a57
Signed by untrusted user: cadence
GPG key ID: BC1C2C61CF521B17
5 changed files with 82 additions and 77 deletions
Download patch file Download diff file Expand all files Collapse all files

42
src/config.rkt
View file

@ -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))

10
src/page-category.rkt
View file

@ -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)

19
src/page-wiki.rkt
View file

@ -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)))))

20
src/reloadable.rkt
View file

@ -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!)

68
src/xexpr-utils.rkt
View file

@ -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))