diff --git a/decode.rkt b/decode.rkt index 4d128b5..ee6319f 100644 --- a/decode.rkt +++ b/decode.rkt @@ -2,7 +2,7 @@ (require xml txexpr sugar/define) (require "decode/block.rkt" "decode/typography.rkt" "debug.rkt") -(provide (all-from-out "decode/typography.rkt")) +(provide (all-from-out "decode/block.rkt" "decode/typography.rkt")) (define+provide (to-string x) diff --git a/decode/typography.rkt b/decode/typography.rkt index 3c3f4b0..e11f9eb 100644 --- a/decode/typography.rkt +++ b/decode/typography.rkt @@ -152,11 +152,11 @@ (define+provide/contract (whitespace/nbsp? x) (any/c . -> . coerce/boolean?) - (or (whitespace? x) (equal? (->string x) (->string #\u00AD)))) + (or (whitespace? x) (equal? (->string x) (->string #\u00A0)))) ;; is x a paragraph break? -(define (paragraph-break? x #:separator [sep world:paragraph-separator]) - ; ((any/c) (#:separator pregexp?) . ->* . coerce/boolean?) +(define+provide/contract (paragraph-break? x #:separator [sep world:paragraph-separator]) + ((any/c) (#:separator pregexp?) . ->* . coerce/boolean?) (define paragraph-pattern (pregexp (format "^~a+$" sep))) (and (string? x) (regexp-match paragraph-pattern x))) @@ -185,7 +185,7 @@ ;; Find adjacent newline characters in a list and merge them into one item ;; Scribble, by default, makes each newline a separate list item ;; In practice, this is worthless. -(define (merge-newlines x) +(define+provide/contract (merge-newlines x) (txexpr-elements? . -> . txexpr-elements?) (cond [(list? x) (do-merge (map merge-newlines x))] diff --git a/file.rkt b/file.rkt index b5f83b7..afc545b 100644 --- a/file.rkt +++ b/file.rkt @@ -13,15 +13,6 @@ (except [exn:fail? (λ(e) #f)]))) -;; like pathish, but for directories -;; todo: is this contract too restrictive? -;; pathish doesn't require the path to exist, -;; but this one does. -(define+provide/contract (directory-pathish? x) - (any/c . -> . coerce/boolean?) - (and (pathish? x) (directory-exists? (->path x)))) - - ;; compare directories by their exploded path elements, ;; not by equal?, which will give wrong result if no slash on the end (define+provide/contract (directories-equal? dirx diry) @@ -39,7 +30,7 @@ (define+provide/contract (visible-files dir) - (directory-pathish? . -> . (listof path?)) + (pathish? . -> . (listof path?)) (filter visible? (map (λ(p) (find-relative-path dir p)) (filter file-exists? diff --git a/main.rkt b/main.rkt index cf3e038..0306069 100644 --- a/main.rkt +++ b/main.rkt @@ -77,7 +77,7 @@ (define doc (apply (cond [(equal? parser-mode world:reader-mode-ptree) (λ xs (decode (cons world:ptree-root-node xs) - #:xexpr-elements-proc (λ(xs) (filter (compose1 not (def/c whitespace?)) xs))))] + #:txexpr-elements-proc (λ(xs) (filter (compose1 not (def/c whitespace?)) xs))))] ;; 'root is the hook for the decoder function. ;; If it's not a defined identifier, it just hits #%top and becomes `(root ,@body ...) [(or (equal? parser-mode world:reader-mode-markup) diff --git a/ptree.rkt b/ptree.rkt index 45e35fb..be001e8 100644 --- a/ptree.rkt +++ b/ptree.rkt @@ -1,11 +1,11 @@ #lang racket/base -(require racket/path racket/bool) +(require racket/path racket/bool xml) (require "tools.rkt" "world.rkt" "decode.rkt" sugar txexpr "cache.rkt") (define+provide (pnode? x) - (->boolean (try (not (whitespace? (->string x))) - (except [exn:fail? (λ(e) #f)])))) + (->boolean (and (xexpr? x) (try (not (whitespace/nbsp? (->string x))) + (except [exn:fail? (λ(e) #f)]))))) (define+provide/contract (pnode?/error x) @@ -14,23 +14,14 @@ (define+provide (ptree? x) - (->boolean (and (txexpr? x) (andmap (λ(i) (or (pnode? i) (ptree? i))) x)))) - - -(define+provide/contract (file->ptree p) - (pathish? . -> . ptree?) - (cached-require (->path p) world:main-pollen-export)) - - -(define+provide/contract (directory->ptree dir) - (directory-pathish? . -> . ptree?) - (let ([files (map remove-ext (filter (λ(x) (has-ext? x world:markup-source-ext)) (directory-list dir)))]) - (ptree-root->ptree (cons world:ptree-root-node files)))) + (->boolean (and (txexpr? x) + (andmap (λ(i) (or (pnode? i) (ptree? i))) x) + (members-unique? (ptree->list x))))) ;; Try loading from ptree file, or failing that, synthesize ptree. (define+provide/contract (make-project-ptree project-dir) - (directory-pathish? . -> . ptree?) + (pathish? . -> . ptree?) (define ptree-source (build-path project-dir world:default-ptree)) (cached-require ptree-source world:main-pollen-export)) @@ -127,10 +118,10 @@ (define+provide/contract (ptree-source-decode . elements) (() #:rest pnodes-unique?/error . ->* . ptree?) (ptree-root->ptree (decode (cons world:ptree-root-node elements) - #:xexpr-elements-proc (λ(xs) (filter-not whitespace? xs))))) + #:txexpr-elements-proc (λ(xs) (filter-not whitespace? xs))))) -(define current-ptree (make-parameter `(,world:ptree-root-node))) +(define current-ptree (make-parameter #f)) (define current-url-context (make-parameter (world:current-project-root))) (provide current-ptree current-url-context) diff --git a/scribblings/decode.scrbl b/scribblings/decode.scrbl index e6a27e2..7d0b6ff 100644 --- a/scribblings/decode.scrbl +++ b/scribblings/decode.scrbl @@ -44,8 +44,8 @@ For instance, here's how @racket[decode] is attached to @racket['root] in @itali @codeblock|{ (define (root . items) (decode (make-txexpr 'root null items) - #:xexpr-elements-proc detect-paragraphs - #:block-xexpr-proc + #:txexpr-elements-proc detect-paragraphs + #:block-txexpr-proc (λ(bx) (wrap-hanging-quotes (nonbreaking-last-space bx))) #:string-proc (compose1 smart-quotes smart-dashes)))}| @@ -213,7 +213,7 @@ A predicate that returns @racket[#t] for any stringlike @racket[_v] that's entir (whitespace? (string->symbol "\n\n ")) (whitespace? "") (whitespace? '("" " " "\n\n\n" " \n")) -(define nonbreaking-space (format "~a" #\u00AD)) +(define nonbreaking-space (format "~a" #\u00A0)) (whitespace? nonbreaking-space) ] @@ -229,7 +229,7 @@ Like @racket[whitespace?], but also returns @racket[#t] for nonbreaking spaces. (whitespace/nbsp? (string->symbol "\n\n ")) (whitespace/nbsp? "") (whitespace/nbsp? '("" " " "\n\n\n" " \n")) -(define nonbreaking-space (format "~a" #\u00AD)) +(define nonbreaking-space (format "~a" #\u00A0)) (whitespace/nbsp? nonbreaking-space) ] diff --git a/scribblings/file.scrbl b/scribblings/file.scrbl index 9fbed04..3cde7b5 100644 --- a/scribblings/file.scrbl +++ b/scribblings/file.scrbl @@ -156,7 +156,7 @@ path?] [p pathish?]) path?] )] -Convert an output path @racket[_p] into the source path of the specified type that would produce this output path. Does not generate this source file nor verify that it exists. +Convert an output path @racket[_p] into the source path of the specified type that would produce this output path. This function simply generates a path for a file — it does not ask whether the file exists. @examples[#:eval my-eval (define name "default.html") @@ -174,4 +174,11 @@ Convert an output path @racket[_p] into the source path of the specified type th (->output-path [p pathish?]) path?] -Convert a source path @racket[_p] into its corresponding output path. \ No newline at end of file +Convert a source path @racket[_p] into its corresponding output path. This function simply generates a path for a file — it does not ask whether the file exists. + +@examples[#:eval my-eval +(->output-path "main.css.pp") +(->output-path "default.html.pm") +(->output-path "index.html.p") +(->output-path "file.scrbl") +] \ No newline at end of file diff --git a/scribblings/ptree.scrbl b/scribblings/ptree.scrbl index 29e04cd..09af669 100644 --- a/scribblings/ptree.scrbl +++ b/scribblings/ptree.scrbl @@ -1,6 +1,6 @@ #lang scribble/manual -@(require scribble/eval pollen/cache pollen/world (for-label racket (except-in pollen #%module-begin) pollen/world pollen/ptree txexpr)) +@(require scribble/eval pollen/cache pollen/world (for-label racket (except-in pollen #%module-begin) pollen/world pollen/ptree txexpr sugar pollen/decode xml)) @(define my-eval (make-base-eval)) @(my-eval `(require pollen pollen/ptree)) @@ -9,21 +9,42 @@ @defmodule[pollen/ptree] -A @italic{ptree} — short for @italic{Pollen tree} — is a hierchical list of Pollen output files. A ptree source file has the extension @code[(format ".~a" world:ptree-source-ext)]. A ptree provides a convenient way of separating the structure of the pages from the page sources, and navigating around this structure. +A @italic{ptree} — short for @italic{Pollen tree} — is a hierarchical list of Pollen output files. A ptree source file has the extension @code[(format ".~a" world:ptree-source-ext)]. A ptree provides a convenient way of separating the structure of the pages from the page sources, and navigating around this structure. -Books and other long documents are usually organized in a structured format — at minimum they have a sequence of pages, but more often they have hierarchical sections with subsequences within. Individual Pollen source files don't know anything about how they're connected to other files. (Well, you could maintain this information within each source file, but this would be a poor use of human energy.) +Books and other long documents are usually organized in a structured way — at minimum they have a sequence of pages, but more often they have sections with subsequences within. Individual Pollen source files don't know anything about how they're connected to other files. In theory, you could maintain this information within each source file. This would be a poor use of human energy. Let the ptree figure it out. @defproc[ (ptree? [v any/c]) boolean?] -Test whether @racket[_v] is a valid ptree. A valid ptree is a @racket[txexpr?] whose elements are either @racket[pnode?] or @racket[ptree?]. Also, all the pnodes in a ptree must be unique. +Test whether @racket[_v] is a valid ptree: a @racket[txexpr?] whose elements are either @racket[pnode?] or @racket[ptree?]. Also, all the pnodes in a ptree must be unique. The root node is ignored. @examples[#:eval my-eval -(ptree? '(index.html)) -(ptree? '(index.html index.html)) -(define nested-pt '(1.html 2.html (3.html 3a.html 3b.html))) +(ptree? '(root index.html)) +(ptree? '(root index.html index.html)) +(define nested-pt '(root 1.html 2.html (3.html 3a.html 3b.html))) (ptree? nested-pt) -(ptree? `(index.html ,nested-pt (subsection.html more.html))) -(ptree? `(index.html ,nested-pt (subsection.html more.html) ,nested-pt)) +(ptree? `(root index.html ,nested-pt (subsection.html more.html))) +(ptree? `(root index.html ,nested-pt (subsection.html ,nested-pt))) ] + +@defproc[ +(pnode? +[v any/c]) +boolean?] +Test whether @racket[_v] is a valid pnode. Every leaf of a ptree is a pnode. A pnode can be any @racket[stringish?] value that is both an @racket[xexpr?] and not @racket[whitespace/nbsp?] In practice, your pnodes will likely be names of output files. + +@examples[#:eval my-eval +(map pnode? (list 'symbol "string" "index.html" "\n\n ah! \n\n")) +(map pnode? (list 9.999 (string->path "index.html") '(p "Hello") "\n\n")) +] + + + +@defparam[current-ptree ptree ptree? + #:value #f]{ +A parameter that defines the default ptree used by ptree navigation functions if another is not explicitly specified.} + +@defparam[current-url-context dir path? + #:value world:current-project-root]{ +A parameter that defines the default directory used to resolve @racket[pnode->url]. Initialized to the root directory of the current project.} diff --git a/server-routes.rkt b/server-routes.rkt index 1c78fb2..278b2e0 100644 --- a/server-routes.rkt +++ b/server-routes.rkt @@ -5,7 +5,7 @@ (require web-server/http/request-structs) (require web-server/http/response-structs) (require 2htdp/image) -(require "world.rkt" "render.rkt" sugar txexpr "file.rkt" "debug.rkt" "ptree.rkt") +(require "world.rkt" "render.rkt" sugar txexpr "file.rkt" "debug.rkt" "ptree.rkt" "cache.rkt") (module+ test (require rackunit)) @@ -201,7 +201,7 @@ (append (sort-names subdirectories) (sort-names ptree-sources) (sort-names other-files))) (define project-paths (filter-not ineligible-path? (if (file-exists? dashfile) - (map ->path (ptree->list (file->ptree dashfile))) + (map ->path (ptree->list (cached-require (->path dashfile) world:main-pollen-export))) (unique-sorted-output-paths (directory-list dir))))) (body-wrapper diff --git a/tests/test-file-tools.rkt b/tests/test-file-tools.rkt index 37557de..509007b 100644 --- a/tests/test-file-tools.rkt +++ b/tests/test-file-tools.rkt @@ -16,11 +16,6 @@ (check-true (pathish? "/Users/MB/home")) (check-true (pathish? (->symbol "/Users/MB/home")))) - -(module+ test - (check-true (directory-pathish? "/Users/")) - (check-false (directory-pathish? "foobarzooblish"))) - (module+ test (check-true (directories-equal? "/Users/MB/foo" "/Users/MB/foo/")) (check-false (directories-equal? "/Users/MB/foo" "Users/MB/foo"))) diff --git a/tests/test-ptree.rkt b/tests/test-ptree.rkt index 7e43663..e08c40e 100644 --- a/tests/test-ptree.rkt +++ b/tests/test-ptree.rkt @@ -15,6 +15,7 @@ (check-true (ptree? '(foo))) (check-true (ptree? '(foo (hee)))) (check-true (ptree? '(foo (hee (uncle "foo"))))) +(check-false (ptree? '(foo (hee hee (uncle "foo"))))) (define test-ptree-main `(ptree-main "foo" "bar" (one (two "three"))))