suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Simplify code around resources.

Browse Source 
Note the `case-lambda' hack to avoid repeating the default file resource
target.  (Do this since it might actually change in the future to not be
the "basefile" of the source file.)
This commit is contained in:
Eli Barzilay 2013-10-13 23:46:35 -04:00 committed by Matthew Flatt
parent d7547d9530
commit 3bdf68ebac
2 changed files with 25 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
new-racket-web/web/common/layout.rkt
View File

@ -172,7 +172,7 @@
(middle-text 60 ")")
(middle-text 80 ")")
(middle-text 100 ")")))
(define (header-cell logo)
(define (header-cell)
(td (a href: (url-of (force top-promise))
OPEN
(img src: logo alt: "[logo]"
@ -193,7 +193,7 @@
(div class: 'racketnav
(div class: 'navcontent
(table border: 0 cellspacing: 0 cellpadding: 0 width: "100%"
(tr (header-cell logo)
(tr (header-cell)
(td class: 'helpiconcell
(let ([help (force help-promise)])
(span class: 'helpicon (if (eq? this help) nbsp help)))))
@ -292,16 +292,19 @@
#:resources (lazy resources-id)
content))
dir robots htaccess)))])
#'(begin (define resources-id resources)
(define-syntax-rule (page-id . xs)
(page #:resources resources-id #:dir dir . xs))
(define-syntax-rule (plain-id . xs)
(plain #:dir dir . xs))
(define (copyfile-id source [target #f])
(copyfile-resource source target #:dir dir))
(define (symlink-id source [target #f])
(symlink-resource source target #:dir dir))
provides)))]))
#'(begin
(define resources-id resources)
(define-syntax-rule (page-id . xs)
(page #:resources resources-id #:dir dir . xs))
(define-syntax-rule (plain-id . xs)
(plain #:dir dir . xs))
(define copyfile-id
(case-lambda [(s) (copyfile-resource s #:dir dir)]
[(s t) (copyfile-resource s t #:dir dir)]))
(define symlink-id
(case-lambda [(s) (symlink-resource s #:dir dir)]
[(s t) (symlink-resource s t #:dir dir)]))
provides)))]))
(define-syntax (define+provide-context stx)
(make-define+provide-context stx #t))
(define-syntax (define-context stx)

16
new-racket-web/web/common/utils.rkt
View File

@ -39,13 +39,17 @@
[(resource? referable) (referable absolute?)]
[else (raise-type-error 'url-of "referable" referable)]))
(provide basename)
(define (basename path)
(define-values [base file dir?] (split-path path))
(path->string file))
;; simple file resources
(define ((make-path-resourcer file-op) source [target #f] #:dir [dir #f])
(let ([target (or target (let-values ([(base file dir?) (split-path source)])
(path->string file)))])
(resource (if (eq? void file-op)
(void) (if dir (web-path dir target) target))
(λ (file) (file-op source file)))))
(define ((make-path-resourcer file-op)
source [target (basename source)] #:dir [dir #f])
(resource (if (eq? void file-op) (void)
(if dir (web-path dir target) target))
(λ (file) (file-op source file))))
(provide copyfile-resource symlink-resource)
(define copyfile-resource (make-path-resourcer copy-file))