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,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…
	
	Add table
		Add a link
		
	
		Reference in a new issue