diff --git a/cache.rkt b/cache.rkt index d1168db..073bddd 100644 --- a/cache.rkt +++ b/cache.rkt @@ -34,7 +34,7 @@ (when (not (current-cache)) (error "cached-require: No cache set up.")) (define path - (with-handlers ([exn:fail? (λ(exn) (displayln (format "cached-require: ~a is not a valid path" path-string)))]) + (with-handlers ([exn:fail? (λ(exn) (error (format "cached-require: ~a is not a valid path" path-string)))]) (->complete-path path-string))) (when (or (not (cache-has-key? path)) diff --git a/file.rkt b/file.rkt index 79145ad..ee7a5c0 100644 --- a/file.rkt +++ b/file.rkt @@ -43,6 +43,7 @@ (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)] + [get-stem-source (format-id stx "get-~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)] @@ -52,9 +53,14 @@ (define+provide (stem-source? x) (->boolean (and (pathish? x) (has-ext? (->path x) file-ext)))) + (define+provide (get-stem-source x) + (and (pathish? x) + (let ([source-path (->stem-source-path (->path x))]) + (and source-path (file-exists? source-path) source-path)))) + ;; does the source-ified version of the file exist (define+provide (has-stem-source? x) - (->boolean (and (pathish? x) (file-exists? (->stem-source-path (->path x)))))) + (->boolean (get-stem-source x))) ;; it's a file-ext source file, or a file that's the result of a file-ext source (define+provide (has/is-stem-source? x) @@ -62,12 +68,15 @@ ;; 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))))) + (pathish? . -> . (or/c #f path?)) + (define result (if (stem-source? x) + x + #,(if (equal? stem-datum 'scribble) + #'(if (x . has-ext? . 'html) ; different logic for scribble sources + (add-ext (remove-all-ext x) file-ext) + #f) + #'(add-ext x file-ext)))) + (and result (->path result))) ;; coerce either a source or output file to both (define+provide/contract (->stem-source+output-paths path) @@ -84,15 +93,9 @@ (make-source-utility-functions scribble) -;; todo: use has-source? for this (define/contract+provide (->source-path path) - (coerce/path? . -> . path?) - (define possible-sources - (if (directory-exists? path) - null - (filter file-exists? (map (λ(proc) (proc path)) (list ->preproc-source-path ->markup-source-path ->null-source-path ->scribble-source-path))))) - (if (null? possible-sources) path (car possible-sources))) - + (coerce/path? . -> . (or/c #f path?)) + (ormap (λ(proc) (proc path)) (list get-markup-source get-preproc-source get-null-source get-scribble-source))) (define+provide/contract (->output-path x) (coerce/path? . -> . coerce/path?) diff --git a/project-requires.rkt b/project-requires.rkt index 29e2a9d..f1209d9 100644 --- a/project-requires.rkt +++ b/project-requires.rkt @@ -9,7 +9,7 @@ (define+provide/contract (require+provide-project-require-files here-path #:provide [provide #t]) - (coerce/path? . -> . list?) + (coerce/path? . -> . (or/c list? void?)) (define (put-file-in-require-form file) `(file ,(path->string file))) (define project-require-files (get-project-require-files here-path)) @@ -21,7 +21,7 @@ ,@(if provide (list `(provide (all-from-out ,@files-in-require-form))) '()))) - (void))) + '(begin))) (define+provide (require-project-require-files here-path) diff --git a/render.rkt b/render.rkt index eb97358..233ec6c 100644 --- a/render.rkt +++ b/render.rkt @@ -166,7 +166,7 @@ (local-require pollen/pagemap pollen/template pollen/top) (include-template #:command-char ,world:template-field-delimiter ,(->string (find-relative-path source-dir template-path)))))) - (time (parameterize ([current-directory source-dir]) + (time (parameterize ([current-directory source-dir]) ; because include-template wants to work relative to source location (render-through-eval expr-to-eval)))) diff --git a/server-routes.rkt b/server-routes.rkt index a3eaa81..e4e1d77 100644 --- a/server-routes.rkt +++ b/server-routes.rkt @@ -138,11 +138,11 @@ ;; dashboard route -(define (dashboard dashfile) - (define dir (get-enclosing-dir dashfile)) +(define (dashboard dashboard-pmap) + (define dashboard-dir (get-enclosing-dir dashboard-pmap)) (define (in-project-root?) - (directories-equal? dir (world:current-project-root))) - (define parent-dir (and (not (in-project-root?)) (get-enclosing-dir dir))) + (directories-equal? dashboard-dir (world:current-project-root))) + (define parent-dir (and (not (in-project-root?)) (get-enclosing-dir dashboard-dir))) (define empty-cell (cons #f #f)) (define (make-link-cell href+text) (match-define (cons href text) href+text) @@ -157,13 +157,14 @@ `(tr (th ((colspan "3")) (a ((href ,url-to-parent-dashboard)) ,(format "up to ~a" url-to-parent))))) `(tr (th ((colspan "3")(class "root")) "Pollen root")))) - (define (make-path-row fn) - (define filename (->string fn)) - (define source (->string (->source-path fn))) + (define (make-path-row filename-path) + (define filename (->string filename-path)) + (define possible-source (->source-path (build-path dashboard-dir filename-path))) + (define source (and possible-source (->string possible-source))) `(tr ,@(map make-link-cell (append (list (cond ; main cell - [(directory-exists? (build-path dir filename)) ; links subdir to its dashboard + [(directory-exists? (build-path dashboard-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 ")")))] @@ -176,7 +177,7 @@ [else empty-cell]) (cond ; out cell - [(directory-exists? (build-path dir filename)) (cons #f #f)] + [(directory-exists? (build-path dashboard-dir filename)) (cons #f #f)] [(pagemap-source? filename) empty-cell] [else (cons (format "out/~a" filename) "out")])))))) @@ -186,7 +187,7 @@ (define output-paths (map ->output-path xs)) (define (unique-members xs) (set->list (list->set xs))) (define all-paths (unique-members output-paths)) - (define path-is-directory? (λ(f) (directory-exists? (build-path dir f)))) + (define path-is-directory? (λ(f) (directory-exists? (build-path dashboard-dir f)))) (define subdirectories (filter path-is-directory? all-paths)) (define files (filter-not path-is-directory? all-paths)) (define pagemap-sources (filter pagemap-source? files)) @@ -195,9 +196,11 @@ ;; put subdirs in list ahead of files (so they appear at the top) (append (sort-names subdirectories) (sort-names pagemap-sources) (sort-names other-files))) - (define project-paths (filter-not ineligible-path? (if (file-exists? dashfile) - (map ->path (pagemap->list (cached-require (->path dashfile) world:main-pollen-export))) - (unique-sorted-output-paths (directory-list dir))))) + (define project-paths + (filter-not ineligible-path? + (if (file-exists? dashboard-pmap) + (map ->path (pagemap->list (cached-require (->path dashboard-pmap) world:main-pollen-export))) + (unique-sorted-output-paths (directory-list dashboard-dir))))) (body-wrapper `(table diff --git a/template.rkt b/template.rkt index 3f59d9e..bf5a055 100644 --- a/template.rkt +++ b/template.rkt @@ -9,30 +9,37 @@ (define/contract+provide (get-doc x) - (coerce/path? . -> . txexpr?) - (cached-require (->source-path x) world:main-pollen-export)) + (coerce/path? . -> . (or/c #f txexpr? string?)) + (define source-path (->source-path x)) + (if source-path + (cached-require source-path world:main-pollen-export) + (error (format "get-doc: no source found for '~a' in directory ~a" x (current-directory))))) (define/contract+provide (get-metas x) (coerce/path? . -> . hash?) - (cached-require (->source-path x) world:meta-pollen-export)) + (define source-path (->source-path x)) + (if source-path + (cached-require source-path world:meta-pollen-export) + (error (format "get-doc: no source found for '~a' in directory ~a" x (current-directory))))) -(define/contract+provide (find query . xs) - ((coerce/symbol?) #:rest (listof (or/c #f hash? txexpr? pathish?)) . ->* . (or/c #f txexpr-element?)) - (define result (apply find* query xs)) - (or (null? result) (car result))) +(define/contract+provide (from-node query node) + (coerce/symbol? coerce/symbol? . -> . (or/c #f txexpr-element?)) + (define node-path (build-path (world:current-project-root) (->string node))) + (define result (append (find-in-metas query node-path) (find-in-doc query node-path))) + (if (null? result) #f (car result))) -(define/contract+provide (find* query . pxs) - ((coerce/symbol?) #:rest (listof (or/c #f hash? txexpr? pathish?)) . ->* . (or/c #f txexpr-elements?)) +(define/contract+provide (find* query . nodes) + ((coerce/symbol?) #:rest (listof symbol?) . ->* . (or/c #f txexpr-elements?)) (define (finder x) (cond [(hash? x) (find-in-metas query x)] [(txexpr? x) (find-in-doc query x)] [(pathish? x) (find* query (get-doc x) (get-metas x))] [else null])) - (append-map finder pxs)) + (append-map finder nodes)) (define/contract+provide (find-in-metas query hash-or-path) @@ -65,8 +72,8 @@ (define+provide/contract (->html x) - (txexpr? . -> . string?) - (txexpr->html x)) + (xexpr? . -> . string?) + (xexpr->html x)) (provide when/block) @@ -74,7 +81,11 @@ (syntax-case stx () [(_ condition body ...) #'(if condition (string-append* - (with-handlers ([exn:fail? (λ(exn) (error (format "when/block: ~a" (exn-message exn))))]) - (map ->string (list body ...)))) ; todo: should this be ->html not ->string? + (with-handlers ([exn:fail? (λ(exn) (error (format "within when/block, ~a" (exn-message exn))))]) + (map ->string (list body ...)))) "")])) + +(module+ main + (parameterize ([current-directory (string->path "/Users/MB/git/bpt/down/")]) + (get-doc "introduction.html"))) \ No newline at end of file