correct pagetree rendering (fixes #237)

dev-poly-fix-201114
Matthew Butterick 4 years ago
parent e434406b46
commit 1f1bee90fd

@ -1 +1 @@
1603077405
1603312643

@ -178,23 +178,31 @@
;; meaning, if source is "test.poly.pm" and we get `raco pollen render test.txt`,
;; then the output path argument should force .txt rendering, regardless of `current-poly-target` setting
;; so the output path may contain information we need that we can't necessarily derive from the source path.
(define expanded-source-paths
(let loop ([paths paths-in] [acc null])
(define-values (expanded-source-paths expanded-output-paths)
;; we generate the output paths in parallel with the source paths
;; rather than afterward, because
;; for poly files we want to be able to look at
;; the original path provided as an argument
;; but the path arguments might also include pagetrees,
;; which expand to multiple files.
;; so this keeps everything correlated correctly.
(let loop ([paths paths-in] [sps null] [ops null])
(match paths
[(? null?) (sort (remove-duplicates acc) string<? #:key path->string)]
[(? null?)
(define (cleanup paths)
(sort (remove-duplicates paths) string<? #:key path->string))
(apply values (map cleanup (list sps ops)))]
[(cons path rest)
(match (->complete-path path)
[(? pagetree-source? pt)
(loop (append (pagetree->paths pt) rest) acc)]
(loop (append (pagetree->paths pt) rest) sps ops)]
[(app ->source-path (and (not #false) (? file-exists?) sp))
(loop rest (cons sp acc))]
[_ (loop rest acc)])])))
(define expanded-output-paths
(for/list ([path (in-list paths-in)]
[sp (in-list expanded-source-paths)])
(if (equal? (->output-path path) path)
path
(->output-path sp))))
(define op (match path
[(== (->output-path path)) path]
[_ (->output-path sp)]))
(loop rest (cons sp sps) (cons op ops))]
[_ (loop rest sps ops)])])))
(cond
[(null? expanded-source-paths) (message "[no paths to render]")]
[(eq? special-output 'dry-run) (for-each message expanded-source-paths)]

@ -0,0 +1,3 @@
#lang pollen
this is bar

@ -0,0 +1,3 @@
#lang pollen
this is foo

@ -0,0 +1,4 @@
#lang pollen/ptree
foo.txt
bar.txt

@ -0,0 +1,27 @@
#lang at-exp racket/base
(require rackunit racket/runtime-path pollen/render racket/file pollen/setup)
;; define-runtime-path only allowed at top level
(define-runtime-path dir "data/pagetree-output")
(define-runtime-path index.ptree "data/pagetree-output/index.ptree")
(define-runtime-path foo.txt.pp "data/pagetree-output/foo.txt.pp")
(define-runtime-path foo.txt "data/pagetree-output/foo.txt")
(define-runtime-path bar.txt.pp "data/pagetree-output/bar.txt.pp")
(define-runtime-path bar.txt "data/pagetree-output/bar.txt")
(define-runtime-path pollen-cache "data/pagetree-output/compiled")
(parameterize ([current-output-port (open-output-string)]
[current-directory dir]
[current-project-root dir])
;; passing "index.ptree" as argument should work
(for ([parallel? (list #true #false)])
(render-batch #:parallel parallel? index.ptree)
(check-true (file-exists? foo.txt))
(check-equal? (file->string foo.txt) "this is foo")
(delete-file foo.txt)
(check-true (file-exists? bar.txt))
(check-equal? (file->string bar.txt) "this is bar")
(delete-file bar.txt)))
(delete-directory/files pollen-cache)

@ -1,5 +1,5 @@
#lang at-exp racket/base
(require rackunit racket/runtime-path pollen/render racket/file racket/system pollen/setup txexpr xml)
(require rackunit racket/runtime-path pollen/render racket/file pollen/setup txexpr xml)
;; define-runtime-path only allowed at top level
(define-runtime-path poly-output-path-dir "data/poly-output-path")

Loading…
Cancel
Save