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

Major simplification of site resources.

Browse Source 
Only one resource (`make-navbar') returns a function now, the others
return just misc contents.  Dump the idea of a `head' resource which
complicated things whenever something new needed to be injected into the
head section -- and instead do the head assembly in the page layout
function.

Turn the preamble and postamble into resources too in preparation for
more contents taht is used in the postamble, mostly dealing with
resource files.  (The former doesn't need to be one since it's just
static text, but make it symmetric.)

Finally, the resources (implemented in `make-resources') have some
symbols that return things that are constructed by the code, and the
rest are files that are copied.  There are also some symbolic names that
stand for "special" resources -- these should get attention on changes,
since they are mostly there to expose some things for various pages.
For example, if more CSS is added, `style-path' should change to be a
list of CSS files and the code that uses it (in the git content that is
derived by gitweb) should also be adjusted to deal with more than one
file.
This commit is contained in:
Eli Barzilay 2013-10-14 02:20:10 -04:00 committed by Matthew Flatt
parent 3bdf68ebac
commit dd1996eefd
3 changed files with 145 additions and 137 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -51,32 +51,6 @@
;; page layout function
(define-syntax (page stx)
(syntax-case stx () [(_ . xs) (process-contents 'page #'page* stx #'xs)]))
(define preamble
@list{
@doctype['html]
@; paulirish.com/2008/conditional-stylesheets-vs-css-hacks-answer-neither/
@comment{[if lt IE 7]> <html class="no-js ie6 oldie" lang="en"> <![endif]}
@comment{[if IE 7]> <html class="no-js ie7 oldie" lang="en"> <![endif]}
@comment{[if IE 8]> <html class="no-js ie8 oldie" lang="en"> <![endif]}
@comment{[if IE 9]> <html class="no-js ie9" lang="en"> <![endif]}
@comment{[if gt IE 9]><!--> <html class="no-js" lang="en" @;
itemscope itemtype="http://schema.org/Product"> <!--<![endif]}
})
(define postamble
@list{
@; Grab Google CDN's jQuery, with a protocol relative URL;
@; fall back to local if offline
@; ... TODO: distribute the JS stuffs ...
@; @script[src: '("http://ajax.googleapis.com/"
@; "ajax/libs/jquery/1.9.1/jquery.min.js")]
@; @script/inline{
@; window.jQuery || document.write(@;
@; '<script src="/js/libs/jquery-1.9.1.min.js"><\/script>')}
@; @script[src: "js/libs/gumby.min.js"]
@; @script[src: "js/plugins.js"]
@; @script[src: "js/main.js"]
})
(define (page* #:id [id #f] #:dir [dir #f] #:file [file #f]
;; if this is true, return only the html -- don't create
;; a resource -- therefore no file is made, and no links
@ -106,27 +80,31 @@
(define (page)
(define desc
(and description (meta name: 'description content: description)))
(define headers
(if (and extra-headers desc)
(list desc "\n" extra-headers)
(or desc extra-headers)))
(define resources (force resources0))
(define head (resources 'head wintitle headers))
(define navbar (resources 'navbar (or part-of this)))
(define header
(let ([headers (resources 'headers)]
[extras (if (and extra-headers desc)
(list desc "\n" extra-headers)
(or desc extra-headers))])
(if extras (list headers "\n" extras) headers)))
(define navbar ((resources 'make-navbar) (or part-of this)))
(define content
(list navbar "\n"
(case width
[(full) content0]
[(#f) (div class: 'bodycontent content0)]
[else (div class: 'bodycontent style: @list{width: @|width|@";"}
content0)])))
@list{@preamble
content0)])
(resources 'postamble)))
@list{@resources['preamble]
@html{@||
@head
@head{@||
@title{@wintitle}
@header
@||}
@(if body-attrs
(apply body `(,@body-attrs ,content))
(body content))
@postamble}
(body content))}
@||})
(define this (and (not html-only?)
(resource/referrer (get-path 'page id file "html" dir)
@ -189,7 +167,7 @@
nav))))
(force pages-promise)
(force pages-parts-of-promise)))))
(λ (this)
(λ(this)
(div class: 'racketnav
(div class: 'navcontent
(table border: 0 cellspacing: 0 cellpadding: 0 width: "100%"
@ -199,68 +177,95 @@
(span class: 'helpicon (if (eq? this help) nbsp help)))))
(tr (td colspan: 2 (links-table this))))))))
(define (html-favicon-maker icon)
(define headers
@; Place favicon.ico and apple-touch-icon.png in the root
@; directory: mathiasbynens.be/notes/touch-icons
@list{@link[rel: "icon" href: icon type: "image/ico"]
@link[rel: "shortcut icon" href: icon type: "image/x-icon"]})
(λ () headers))
(define html-preamble
@list{
@doctype['html]
@; paulirish.com/2008/conditional-stylesheets-vs-css-hacks-answer-neither/
@comment{[if lt IE 7]> <html class="no-js ie6 oldie" lang="en"> <![endif]}
@comment{[if IE 7]> <html class="no-js ie7 oldie" lang="en"> <![endif]}
@comment{[if IE 8]> <html class="no-js ie8 oldie" lang="en"> <![endif]}
@comment{[if IE 9]> <html class="no-js ie9" lang="en"> <![endif]}
@comment{[if gt IE 9]><!--> <html class="no-js" lang="en" @;
itemscope itemtype="http://schema.org/Product"> <!--<![endif]}
})
(define (html-head-maker style favicon)
(define headers
@list{
@meta[name: "generator" content: "Racket"]
@meta[http-equiv: "Content-Type" content: "text/html; charset=utf-8"]
@meta[charset: "utf-8"]
@; Use the .htaccess and remove this line to avoid edge case issues.
@; More info: h5bp.com/b/378
@meta[http-equiv: "X-UA-Compatible" content: "IE=edge,chrome=1"]
@favicon
@; Mobile viewport optimized: j.mp/bplateviewport
@meta[name: "viewport"
content: "width=device-width, initial-scale=1.0, maximum-scale=1"]
@; CSS: implied media=all
@; CSS concatenated and minified via ant build script
@; @link[rel: "stylesheet" href="css/minified.css"]
@; CSS imports non-minified for staging, minify before moving to
@; production
@; ... TODO: distribute the CSS stuffs ...
@; @link[rel: "stylesheet" href: "css/gumby.css"]
@; TODO: Modify `racket-style' definition (and what it depends on)
@; in "resources.rkt"
@link[rel: "stylesheet" type: "text/css" href: style title: "default"]
@; TODO: Edit the `more.css' definition in www/index.rkt
@; More ideas for your <head> here: h5bp.com/d/head-Tips
@; All JavaScript at the bottom, except for Modernizr / Respond.
@; Modernizr enables HTML5 elements & feature detects; Respond is
@; a polyfill for min/max-width CSS3 Media Queries
@; For optimal performance, use a custom Modernizr build:
@; www.modernizr.com/download/
@script[src: "js/libs/modernizr-2.6.2.min.js"]
})
(λ (title* more-headers)
(head "\n" (title title*)
"\n" headers
(and more-headers (list "\n" more-headers))
"\n")))
(define html-postamble
@list{
@||
@; Grab Google CDN's jQuery, with a protocol relative URL;
@; fall back to local if offline
@; ... TODO: distribute the JS stuffs ...
@; @script[src: '("http://ajax.googleapis.com/"
@; "ajax/libs/jquery/1.9.1/jquery.min.js")]
@; @script/inline{
@; window.jQuery || document.write(@;
@; '<script src="/js/libs/jquery-1.9.1.min.js"><\/script>')}
@; @script[src: "js/libs/gumby.min.js"]
@; @script[src: "js/plugins.js"]
@; @script[src: "js/main.js"]
@||
})
(define (html-icon-headers icon)
@; Place favicon.ico and apple-touch-icon.png in the root
@; directory: mathiasbynens.be/notes/touch-icons
@list{@link[rel: "icon" href: icon type: "image/ico"]
@link[rel: "shortcut icon" href: icon type: "image/x-icon"]})
(define (html-headers style favicon)
@list{
@meta[name: "generator" content: "Racket"]
@meta[http-equiv: "Content-Type" content: "text/html; charset=utf-8"]
@meta[charset: "utf-8"]
@; Use the .htaccess and remove this line to avoid edge case issues.
@; More info: h5bp.com/b/378
@meta[http-equiv: "X-UA-Compatible" content: "IE=edge,chrome=1"]
@favicon
@; Mobile viewport optimized: j.mp/bplateviewport
@meta[name: "viewport"
content: "width=device-width, initial-scale=1.0, maximum-scale=1"]
@; CSS: implied media=all
@; CSS concatenated and minified via ant build script
@; @link[rel: "stylesheet" href="css/minified.css"]
@; CSS imports non-minified for staging, minify before moving to
@; production
@; ... TODO: distribute the CSS stuffs ...
@; @link[rel: "stylesheet" href: "css/gumby.css"]
@; TODO: Modify `racket-style' definition (and what it depends on)
@; in "resources.rkt"
@link[rel: "stylesheet" type: "text/css" href: style title: "default"]
@; TODO: Edit the `more.css' definition in www/index.rkt
@; More ideas for your <head> here: h5bp.com/d/head-Tips
@; All JavaScript at the bottom, except for Modernizr / Respond.
@; Modernizr enables HTML5 elements & feature detects; Respond is
@; a polyfill for min/max-width CSS3 Media Queries
@; For optimal performance, use a custom Modernizr build:
@; www.modernizr.com/download/
@script[src: "js/libs/modernizr-2.6.2.min.js"]
})
(define (make-resources files)
(define (getfile what) (cadr (assq what files)))
(define favicon (html-favicon-maker (getfile 'icon)))
(define make-head (html-head-maker (getfile 'style) favicon))
(define make-navbar (navbar-maker (getfile 'logo)))
(λ (what . more)
(apply (case what
[(head) make-head]
[(navbar) make-navbar]
[(favicon-headers) favicon]
[(icon-path logo-path style-path)
(λ () (let* ([x (symbol->string what)]
[x (regexp-replace #rx"-path$" x "")])
(url-of (getfile (string->symbol x)))))]
[else (error 'resources "internal error")])
more)))
(define (resources what)
(case what
;; composite resources
[(preamble) html-preamble] ; not really a resource, since it's static
[(postamble) html-postamble]
[(headers) headers]
[(make-navbar) make-navbar] ; page -> navbar
[(icon-headers) icon-headers]
;; aliases for specific resource files
[(style-path) (resources "plt.css")]
[(logo-path) (resources "logo.png")]
[(icon-path) (resources "plticon.ico")]
;; get a resource file path
[else (cond [(assoc what files)
;; delay the `url-of' until we're in the rendering context
=> (λ(f) (λ() (url-of (cadr f))))]
[else (error 'resource "unknown resource: ~e" what)])]))
(define icon-headers (html-icon-headers (resources 'icon-path)))
(define headers (html-headers (resources 'style-path) icon-headers))
(define make-navbar (navbar-maker (resources 'logo-path)))
resources)
;; `define+provide-context' should be used in each toplevel directory (= each
;; site) to have its own resources (and possibly other customizations).

67
new-racket-web/web/common/resources.rkt
View File

@ -18,44 +18,45 @@
;; added to the standard contents -- which is the user-agent line and the
;; ErrorDocument respectively.
(define (make-resource-files page dir robots htaccess)
(define (copyfile file [target file])
(copyfile-resource (in-here file) (web-path dir target)))
;; the default target argument duplicate the behavior in "utils.rkt"
(define (copyfile file [target (basename file)])
(list target (copyfile-resource (in-here file) (web-path dir target))))
(define (writefile file . contents)
(resource (web-path dir file) (file-writer output (list contents "\n"))))
`([logo ,(copyfile "logo.png")]
[icon ,(copyfile "plticon.ico")]
[style ,(writefile "plt.css" racket-style)]
(list file (resource (web-path dir file)
(file-writer output (list contents "\n")))))
(define (pagefile file . contents)
(list file
(apply page (string->symbol (regexp-replace #rx"[.]html$" file ""))
contents)))
`(,(copyfile "logo.png")
,(copyfile "plticon.ico")
,(writefile "plt.css" racket-style)
;; the following resources are not used directly, so their names are
;; irrelevant
[verification:google
@,writefile["google5b2dc47c0b1b15cb.html"]{
google-site-verification: google5b2dc47c0b1b15cb.html}]
[verification:bing
@,writefile["BingSiteAuth.xml"]{
<?xml version="1.0"?>
<users><user>140BE58EEC31CB97382E1016E21C405A</user></users>}]
[robots
;; #t (the default) => no-op file, good to avoid error-log lines
,(let* ([t (if (eq? #t robots) "Disallow:" robots)]
[t (and t (list "User-agent: *\n" t))])
(and t (writefile "robots.txt" t)))]
;; Seems like there are still some clients that look for a favicon.ico file
[favicon ,(copyfile "plticon.ico" "favicon.ico")]
[404
@,page['page-not-found]{
@h1[style: '("text-align: center; margin: 3em 0 1em 0;")]{
Page not found}
@(λ xs (table align: 'center (tr (td (pre xs))))){
> (@a[href: "/"]{(uncaught-exception-handler)}
(*(+(*)(*(+(*)(*)(*)(*)(*))(+(*)(*)(*)(*)(*))(+(*)(*)(*)(*))))@;
(+(*)(*)(*)(*))))
uncaught exception: 404}}]
@,writefile["google5b2dc47c0b1b15cb.html"]{
google-site-verification: google5b2dc47c0b1b15cb.html}
@,writefile["BingSiteAuth.xml"]{
<?xml version="1.0"?>
<users><user>140BE58EEC31CB97382E1016E21C405A</user></users>}
;; #t (the default) => no-op file, good to avoid error-log lines
,(let* ([t (if (eq? #t robots) "Disallow:" robots)]
[t (and t (list "User-agent: *\n" t))])
(if t (writefile "robots.txt" t) '(#f #f)))
;; There are still some clients that look for a favicon.ico file
,(copyfile "plticon.ico" "favicon.ico")
@,pagefile["page-not-found.html"]{
@h1[style: "text-align: center; margin: 3em 0 1em 0;"]{
Page not found}
@(λ xs (table align: 'center (tr (td (pre xs))))){
> (@a[href: "/"]{(uncaught-exception-handler)}
(*(+(*)(*(+(*)(*)(*)(*)(*))(+(*)(*)(*)(*)(*))(+(*)(*)(*)(*))))@;
(+(*)(*)(*)(*))))
uncaught exception: 404}}
;; set the 404 page in htaccess instead of in the conf file, so we get it
;; only in sites that we generate here
[.htaccess
,(let* ([t (and htaccess "ErrorDocument 404 /page-not-found.html")]
[t (if (boolean? htaccess) t (list htaccess "\n" t))])
(and t (writefile ".htaccess" t)))]))
,(let* ([t (and htaccess "ErrorDocument 404 /page-not-found.html")]
[t (if (boolean? htaccess) t (list htaccess "\n" t))])
(if t (writefile ".htaccess" t) '(#f #f)))))
(define page-sizes
@list{

16
new-racket-web/web/stubs/blog.rkt
View File

@ -25,14 +25,16 @@
@navbar-style
})
(define (get-resource-text . args)
(let ([str (xml->string (apply www:the-resources args))])
;; due to some obscure xml issue the `nbsp' entity is not recognized
;; in blogger pages
(regexp-replace* #rx"&nbsp;" str "\\&#160;")))
(define (get-resource-text what #:args [args #f])
(define r (www:the-resources what))
(define xml (if args (apply r args) r))
(define str (xml->string xml))
;; due to some obscure xml issue the `nbsp' entity is not recognized
;; in blogger pages
(regexp-replace* #rx"&nbsp;" str "\\&#160;"))
(define (racket-navbar) (get-resource-text 'navbar 'community))
(define (racket-favicon) (get-resource-text 'favicon-headers))
(define (racket-navbar) (get-resource-text 'make-navbar #:args '(community)))
(define (racket-favicon) (get-resource-text 'icon-headers))
(provide blog)
(define blog