From 30fc39db0ebcb82ef65399f8941fa5abd1cd7f65 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Wed, 5 Mar 2014 08:34:47 -0800 Subject: [PATCH] add support for scrbl files --- file-tools.rkt | 100 +++++++++++++++++++++++++--------------------- render.rkt | 29 +++++++++++--- server-routes.rkt | 4 +- world.rkt | 2 + 4 files changed, 82 insertions(+), 53 deletions(-) diff --git a/file-tools.rkt b/file-tools.rkt index b8dea56..41760ae 100644 --- a/file-tools.rkt +++ b/file-tools.rkt @@ -78,7 +78,7 @@ ;; get file extension as a string, or return #f ;; (consistent with filename-extension behavior) (define+provide/contract (get-ext x) - (coerce/path? . -> . (or/c string? #f)) + (coerce/path? . -> . (or/c #f string?)) (let ([fe-result (filename-extension x)]) (and fe-result (bytes->string/utf-8 fe-result)))) @@ -113,53 +113,61 @@ (define-syntax (make-source-utility-functions stx) (syntax-case stx () - [(_ stem file-ext) - (with-syntax ([stem-source? (format-id stx "~a-source?" #'stem)] - [has-stem-source? (format-id stx "has-~a-source?" #'stem)] - [has/is-stem-source? (format-id stx "has/is-~a-source?" #'stem)] - [->stem-source-path (format-id stx "->~a-source-path" #'stem)] - [->stem-source+output-paths (format-id stx "->~a-source+output-paths" #'stem)]) - #'(begin - ;; does file have particular extension - (define+provide/contract (stem-source? x) - (any/c . -> . boolean?) - (->boolean (and (pathish? x) (has-ext? (->path x) file-ext)))) - - ;; does the source-ified version of the file exist - (define+provide/contract (has-stem-source? x) - (any/c . -> . boolean?) - (->boolean (and (pathish? x) (file-exists? (->stem-source-path (->path x)))))) - - ;; it's a file-ext source file, or a file that's the result of a file-ext source - (define+provide/contract (has/is-stem-source? x) - (any/c . -> . boolean?) - (->boolean (and (pathish? x) (ormap (λ(proc) (proc (->path x))) (list stem-source? has-stem-source?))))) - - ;; add the file extension if it's not there - (define+provide/contract (->stem-source-path x) - (pathish? . -> . path?) - (->path (if (stem-source? x) x (add-ext x file-ext)))) - - ;; coerce either a source or output file to both - (define+provide/contract (->stem-source+output-paths path) - (pathish? . -> . (values path? path?)) - (values (->complete-path (->stem-source-path path)) - (->complete-path (->output-path path))))))])) - - -(make-source-utility-functions preproc world:preproc-source-ext) -(make-source-utility-functions null world:null-source-ext) -(make-source-utility-functions ptree world:ptree-source-ext) -(make-source-utility-functions markup world:markup-source-ext) -(make-source-utility-functions template world:template-source-ext) - - - + [(_ stem) + (let ([stem-datum (syntax->datum #'stem)]) + (with-syntax ([file-ext (format-id stx "world:~a-source-ext" #'stem)] + [stem-source? (format-id stx "~a-source?" #'stem)] + [has-stem-source? (format-id stx "has-~a-source?" #'stem)] + [has/is-stem-source? (format-id stx "has/is-~a-source?" #'stem)] + [->stem-source-path (format-id stx "->~a-source-path" #'stem)] + [->stem-source+output-paths (format-id stx "->~a-source+output-paths" #'stem)]) + #`(begin + ;; does file have particular extension + (define+provide/contract (stem-source? x) + (any/c . -> . boolean?) + (->boolean (and (pathish? x) (has-ext? (->path x) file-ext)))) + + ;; does the source-ified version of the file exist + (define+provide/contract (has-stem-source? x) + (any/c . -> . boolean?) + (->boolean (and (pathish? x) (file-exists? (->stem-source-path (->path x)))))) + + ;; it's a file-ext source file, or a file that's the result of a file-ext source + (define+provide/contract (has/is-stem-source? x) + (any/c . -> . boolean?) + (->boolean (and (pathish? x) (ormap (λ(proc) (proc (->path x))) (list stem-source? has-stem-source?))))) + + ;; add the file extension if it's not there + (define+provide/contract (->stem-source-path x) + (pathish? . -> . path?) + (->path (if (stem-source? x) + x + #,(if (equal? stem-datum 'scribble) + #'(add-ext (remove-all-ext x) file-ext) ; different logic for scribble sources + #'(add-ext x file-ext))))) + + ;; coerce either a source or output file to both + (define+provide/contract (->stem-source+output-paths path) + (pathish? . -> . (values path? path?)) + (values (->complete-path (->stem-source-path path)) + (->complete-path (->output-path path)))))))])) + + +(make-source-utility-functions preproc) +(make-source-utility-functions null) +(make-source-utility-functions ptree) +(make-source-utility-functions markup) +(make-source-utility-functions template) +(make-source-utility-functions scribble) + + +;; todo: move this into source-specific definitions (define+provide/contract (->output-path x) (coerce/path? . -> . coerce/path?) - (if (or (markup-source? x) (preproc-source? x) (null-source? x)) - (remove-ext x) - x)) + (cond + [(or (markup-source? x) (preproc-source? x) (null-source? x)) (remove-ext x)] + [(scribble-source? x) (add-ext (remove-ext x) 'html)] + [else x])) (define+provide/contract (project-files-with-ext ext) diff --git a/render.rkt b/render.rkt index fc5ce4c..75199ca 100644 --- a/render.rkt +++ b/render.rkt @@ -54,7 +54,7 @@ (let ([so-path (->complete-path pathish)]) ; so-path = source or output path (could be either) (cond [(ormap (λ(test) (and (test so-path) (render-to-file-if-needed so-path #:force force))) - (list has/is-null-source? has/is-preproc-source? has/is-markup-source?))] + (list has/is-null-source? has/is-preproc-source? has/is-markup-source? has/is-scribble-source?))] [(ptree-source? so-path) (let ([ptree (cached-require so-path world:main-pollen-export)]) (for-each (λ(pnode) (render-for-dev-server pnode #:force force)) (ptree->list ptree)))])) (void)) @@ -64,8 +64,8 @@ (complete-path? . -> . (values complete-path? complete-path?)) ;; file-proc returns two values, but ormap only wants one (define file-proc (ormap (λ(test file-proc) (and (test source-or-output-path) file-proc)) - (list has/is-null-source? has/is-preproc-source? has/is-markup-source?) - (list ->null-source+output-paths ->preproc-source+output-paths ->markup-source+output-paths))) + (list has/is-null-source? has/is-preproc-source? has/is-markup-source? has/is-scribble-source?) + (list ->null-source+output-paths ->preproc-source+output-paths ->markup-source+output-paths ->scribble-source+output-paths))) (file-proc source-or-output-path)) @@ -107,8 +107,8 @@ (define render-proc (cond [(ormap (λ(test render-proc) (and (test source-path) render-proc)) - (list has/is-null-source? has/is-preproc-source? has/is-markup-source?) - (list render-null-source render-preproc-source render-markup-source))] + (list has/is-null-source? has/is-preproc-source? has/is-markup-source? has/is-scribble-source?) + (list render-null-source render-preproc-source render-markup-source render-scribble-source))] [else (error (format "render: no rendering function found for ~a" source-path))])) (message (format "render: ~a" (file-name-from-path source-path))) @@ -123,6 +123,23 @@ (file->bytes source-path)) +(define (render-through-scribble-eval expr-to-eval) + (parameterize ([current-namespace (make-base-namespace)] + [current-output-port (current-error-port)]) + (eval expr-to-eval (current-namespace)))) + + +(define/contract (render-scribble-source source-path) + (complete-path? . -> . bytes?) + (match-define-values (source-dir _ _) (split-path source-path)) + (time (parameterize ([current-directory (->complete-path source-dir)]) + (render-through-scribble-eval `(begin + (require scribble/render) + (require (file ,(->string source-path))) + (render (list doc) '(,source-path)))))) + (file->bytes (->output-path source-path))) + + (define/contract (render-preproc-source source-path) (complete-path? . -> . bytes?) (match-define-values (source-dir _ _) (split-path source-path)) @@ -154,7 +171,7 @@ (define/contract (templated-source? path) (complete-path? . -> . boolean?) - (not (or (null-source? path) (preproc-source? path)))) + (and (markup-source? path))) (define/contract (get-template-for source-path) diff --git a/server-routes.rkt b/server-routes.rkt index 9fa86ba..8fe1fb1 100644 --- a/server-routes.rkt +++ b/server-routes.rkt @@ -163,13 +163,15 @@ (define possible-sources (if (directory-exists? fn) empty ;; folders don't have source files - (filter file-in-dir? (list (->preproc-source-path filename) (->markup-source-path filename) (->null-source-path filename))))) + (filter file-in-dir? (list (->preproc-source-path filename) (->markup-source-path filename) (->null-source-path filename) (->scribble-source-path filename))))) (define source (and (not (empty? possible-sources)) (->string (car possible-sources)))) `(tr ,@(map make-link-cell (append (list (cond ; main cell [(directory-exists? (build-path dir filename)) ; links subdir to its dashboard (cons (format "~a/~a" filename world:dashboard-name) (format "~a/" filename))] + [(and source (equal? (get-ext source) "scrbl")) + (cons #f `(a ((href ,filename)) ,filename (span ((class "file-ext")) " (from " ,source ")")))] [source (cons #f `(a ((href ,filename)) ,filename (span ((class "file-ext")) "." ,(get-ext source))))] [else (cons filename filename)]) diff --git a/world.rkt b/world.rkt index df3211c..7305473 100644 --- a/world.rkt +++ b/world.rkt @@ -10,6 +10,8 @@ (define null-source-ext 'p) (define ptree-source-ext 'ptree) (define template-source-ext 'pt) +(define scribble-source-ext 'scrbl) + (define reader-mode-auto 'auto) (define reader-mode-preproc 'pre)