diff --git a/library/html.rkt b/library/html.rkt
index 8be96b8..ec748bc 100644
--- a/library/html.rkt
+++ b/library/html.rkt
@@ -1,7 +1,5 @@
#lang racket/base
-(require "../syntax.rkt")
-
;; for now, body is deemed a block, not inline
;; todo: is this legit? Why is body inline?
(define block-tags
diff --git a/main-helper.rkt b/main-helper.rkt
index 52836cd..f2704a8 100644
--- a/main-helper.rkt
+++ b/main-helper.rkt
@@ -55,10 +55,10 @@
[(equal? 'pollen-lang-module ccr) 'nowhere]
[else ccr])])
(match-let-values ([(_ here-name _) (split-path ccr)])
- (->string (remove-all-ext here-name)))))))
+ (->string here-name))))))
(module+ test
- (check-equal? (get-here) "main-helper"))
+ (check-equal? (get-here) "main-helper.rkt"))
; Second step: apply a separate syntax transform to the identifier itself
; We can't do this in one step, because if the macro goes from identifier to function definition,
@@ -66,6 +66,6 @@
(define-syntax here (λ (stx) (datum->syntax stx '(get-here))))
(module+ test
- (check-equal? here "main-helper"))
+ (check-equal? here "main-helper.rkt"))
diff --git a/map.rkt b/map.rkt
deleted file mode 100644
index 3f8dced..0000000
--- a/map.rkt
+++ /dev/null
@@ -1,251 +0,0 @@
-#lang racket/base
-(require xml xml/path racket/list racket/string racket/contract racket/match racket/set)
-(require "tools.rkt" "world.rkt" "decode.rkt")
-
-(module+ test (require rackunit))
-
-; get the values out of the file, or make them up
-(define map-file (build-path START_DIR DEFAULT_MAP))
-(define map-main empty)
-
-
-;; todo: this ain't a function
-(if (file-exists? map-file)
- ; load it, or ...
- (set! map-main (dynamic-require map-file POLLEN_ROOT))
- ; ... synthesize it
- (let ([files (directory-list START_DIR)])
- (set! files (map remove-ext (filter (λ(x) (has-ext? x POLLEN_SOURCE_EXT)) files)))
- (set! map-main (make-tagged-xexpr 'map-main empty (map path->string files)))))
-
-;; todo: restrict this test
-;; all names must be unique
-(define/contract (map-tree? x)
- (any/c . -> . boolean?)
- (and (tagged-xexpr? x)
- ;; all locations must be unique. Check this by converting x to a list of strings ...
- (let ([locations (map ->string (flatten (remove-attrs x)))])
- ;; and then coercing to set (because set impliedly enforces uniqueness)
- ;; If set has same number of elements as original, all are unique.
- (= (len (apply set locations)) (len locations)))))
-
-;; recursively processes tree, converting map locations & their parents into xexprs of this shape:
-;; '(location ((parent "parent")))
-(define/contract (add-parents x [parent empty])
- ((map-tree?) (xexpr-tag?) . ->* . map-tree?)
- ; disallow map-main as parent tag
- ; (when (equal? parent 'map-main) (set! parent empty))
- (match x
- ;; this pattern signifies next level in hierarchy
- ;; where first element is new parent, and rest are children.
- [(list (? xexpr-tag? next-parent) children ...)
- (let-values ([(tag attr _) (break-tagged-xexpr (add-parents next-parent parent))])
- ;; xexpr with tag as name, parent as attr, children as elements with tag as next parent
- (make-tagged-xexpr tag attr (map (λ(c) (add-parents c tag)) children)))]
- ;; single map entry: convert to xexpr with parent
- [else (make-tagged-xexpr (->symbol x) (make-xexpr-attr 'parent (->string parent)))]))
-
-(module+ test
- (define test-map `(map-main "foo" "bar" ,(map-topic "one" (map-topic "two" "three"))))
- (check-equal? (add-parents test-map)
- '(map-main ((parent "")) (foo ((parent "map-main"))) (bar ((parent "map-main"))) (one ((parent "map-main")) (two ((parent "one")) (three ((parent "two"))))))))
-
-;; remove parents from tree (i.e., just remove attrs)
-;; is not the inverse of add-parents, i.e., you do not get back your original input.
-(define/contract (remove-parents mt)
- (map-tree? . -> . map-tree?)
- (remove-attrs mt))
-
-(module+ test
- (check-equal? (remove-parents
- '(map-main ((parent "")) (foo ((parent ""))) (bar ((parent "")))
- (one ((parent "")) (two ((parent "one")) (three ((parent "two")))))))
- '(map-main (foo) (bar) (one (two (three))))))
-
-;; todo: what is this for?
-(define/contract (main->tree main)
- (tagged-xexpr? . -> . map-tree?)
- (let-values ([(nx metas) (extract-tag-from-xexpr 'meta main)])
- (add-parents nx)))
-
-(module+ test
- (define mt-map `(map-main "foo" "bar" ,(map-topic "one" (map-topic "two" "three")) (meta "foo" "bar")))
- (check-equal? (main->tree mt-map)
- '(map-main ((parent "")) (foo ((parent "map-main"))) (bar ((parent "map-main"))) (one ((parent "map-main")) (two ((parent "one")) (three ((parent "two"))))))))
-
-
-;; todo: what is this for? to have default input?
-(define tree (main->tree map-main))
-
-
-(define/contract (map-key? x)
- (any/c . -> . boolean?)
- ;; OK for map-key to be #f
- (or (symbol? x) (string? x) (eq? x #f)))
-
-;; return the parent of a given name
-(define/contract (parent element [tree tree])
- ((map-key?) (map-tree?) . ->* . (or/c string? boolean?))
- (and element (let ([result (se-path* `(,(->symbol element) #:parent) tree)])
- (and result (->string result))))) ; se-path* returns #f if nothing found
-
-
-(module+ test
- (define test-tree (main->tree test-map))
- (check-equal? (parent 'three test-tree) "two")
- (check-equal? (parent "three" test-tree) "two")
- (check-false (parent 'nonexistent-name test-tree)))
-
-
-
-; get children of a particular element
-(define/contract (children element [tree tree])
- ((map-key?) (map-tree?) . ->* . (or/c list? boolean?))
- ;; se-path*/list returns '() if nothing found
- (and element (let ([children (se-path*/list `(,(->symbol element)) tree)])
- ; If there are sublists, just take first element
- (and (not (empty? children)) (map (λ(i) (->string (if (list? i) (car i) i))) children)))))
-
-(module+ test
- (check-equal? (children 'one test-tree) (list "two"))
- (check-equal? (children 'two test-tree) (list "three"))
- (check-false (children 'three test-tree))
- (check-false (children 'fooburger test-tree)))
-
-
-;; find all siblings on current level: go up to parent and ask for children
-(define/contract (siblings element [tree tree])
- ;; this never returns false: element is always a sibling of itself.
- ;; todo: how to use input value in contract? e.g., to check that element is part of output list
- ((map-key?) (map-tree?) . ->* . (or/c list? boolean?))
- (children (parent element tree) tree))
-
-(module+ test
- (check-equal? (siblings 'one test-tree) '("foo" "bar" "one"))
- (check-equal? (siblings 'foo test-tree) '("foo" "bar" "one"))
- (check-equal? (siblings 'two test-tree) '("two"))
- (check-false (siblings 'invalid-key test-tree)))
-
-;; helper function
-(define/contract (side-siblings side element [tree tree])
- ((symbol? map-key?) (map-tree?) . ->* . (or/c list? boolean?))
- (define result ((if (equal? side 'left) takef takef-right)
- (siblings element tree)
- (λ(i) (not (equal? (->string element) (->string i))))))
- (and (not (empty? result)) result))
-
-
-(define/contract (map-split element elements)
- (map-key? (listof map-key?) . -> . (values (listof map-key?) (listof map-key?)))
- (define-values (left right) (splitf-at elements
- (λ(e) (not (equal? (->string e) (->string element))))))
- (values left (cdr right)))
-
-(module+ test
- (check-equal? (values->list (map-split 'bar (siblings 'bar test-tree))) (list '("foo") '("one"))))
-
-
-;; siblings to the left of target element (i.e., precede in map order)
-(define (left-siblings element [tree tree])
- (side-siblings 'left element tree))
-
-(module+ test
- (check-equal? (left-siblings 'one test-tree) '("foo" "bar"))
- (check-false (left-siblings 'foo test-tree)))
-
-;; siblings to the right of target element (i.e., follow in map order)
-(define (right-siblings element [tree tree])
- (side-siblings 'right element tree))
-
-(module+ test
- (check-false (right-siblings 'one test-tree))
- (check-equal? (right-siblings 'foo test-tree) '("bar" "one")))
-
-
-;; get element immediately to the left in map
-(define/contract (left-sibling element [tree tree])
- ((map-key?) (map-tree?) . ->* . (or/c string? boolean?))
- (define siblings (left-siblings element tree))
- (and siblings (last siblings)))
-
-(module+ test
- (check-equal? (left-sibling 'bar test-tree) "foo")
- (check-false (left-sibling 'foo test-tree)))
-
-;; get element immediately to the right in map
-(define/contract (right-sibling element [tree tree])
- ((map-key?) (map-tree?) . ->* . (or/c string? boolean?))
- (define siblings (right-siblings element tree))
- (and siblings (first siblings)))
-
-(module+ test
- (check-equal? (right-sibling 'foo test-tree) "bar")
- (check-false (right-sibling 'one test-tree)))
-
-
-;; flatten tree to sequence
-(define/contract (make-page-sequence [tree tree])
- (map-tree? . -> . (listof string?))
- ; use cdr to get rid of main-map tag at front
- (map ->string (cdr (flatten (remove-parents tree)))))
-
-(module+ test
- (check-equal? (make-page-sequence test-tree) '("foo" "bar" "one" "two" "three")))
-
-;; helper function for get-previous-pages and get-next-pages
-(define/contract (adjacent-pages side element [tree tree])
- ((map-key? symbol?) (map-tree?) . ->* . (or/c list? boolean?))
- (define result ((if (equal? side 'left) takef takef-right)
- (make-page-sequence tree) (λ(y) (not (equal? (->string element) (->string y))))))
- (and (not (empty? result)) result))
-
-(module+ test
- (check-equal? (adjacent-pages 'left 'one test-tree) '("foo" "bar"))
- (check-equal? (adjacent-pages 'left 'three test-tree) '("foo" "bar" "one" "two"))
- (check-false (adjacent-pages 'left 'foo test-tree)))
-
-
-;; get sequence of earlier pages
-(define/contract (previous-pages element [tree tree])
- ((map-key?) (map-tree?) . ->* . (or/c list? boolean?))
- (adjacent-pages 'left element tree))
-
-(module+ test
- (check-equal? (previous-pages 'one test-tree) '("foo" "bar"))
- (check-equal? (previous-pages 'three test-tree) '("foo" "bar" "one" "two"))
- (check-false (previous-pages 'foo test-tree)))
-
-
-;; get sequence of next pages
-(define (next-pages element [tree tree])
- ((map-key?) (map-tree?) . ->* . (or/c list? boolean?))
- (adjacent-pages 'right element tree))
-
-(module+ test
- (check-equal? (next-pages 'foo test-tree) '("bar" "one" "two" "three"))
- (check-equal? (next-pages 'one test-tree) '("two" "three"))
- (check-false (next-pages 'three test-tree)))
-
-;; get page immediately previous
-(define/contract (previous-page element [tree tree])
- ((map-key?) (map-tree?) . ->* . (or/c string? boolean?))
- (define result (previous-pages element tree))
- (and result (last result)))
-
-(module+ test
- (check-equal? (previous-page 'one test-tree) "bar")
- (check-equal? (previous-page 'three test-tree) "two")
- (check-false (previous-page 'foo test-tree)))
-
-;; get page immediately next
-(define (next-page element [tree tree])
- ((map-key?) (map-tree?) . ->* . (or/c string? boolean?))
- (define result (next-pages element tree))
- (and result (first result)))
-
-(module+ test
- (check-equal? (next-page 'foo test-tree) "bar")
- (check-equal? (next-page 'one test-tree) "two")
- (check-false (next-page 'three test-tree)))
-
-(provide (all-defined-out))
\ No newline at end of file
diff --git a/pmap.rkt b/pmap.rkt
new file mode 100644
index 0000000..d3c9190
--- /dev/null
+++ b/pmap.rkt
@@ -0,0 +1,257 @@
+#lang racket/base
+(require xml xml/path racket/list racket/string racket/contract racket/match racket/set)
+(require "tools.rkt" "world.rkt" "decode.rkt")
+
+(module+ test (require rackunit))
+
+(provide (all-defined-out))
+
+; get the values out of the file, or make them up
+(define pmap-file (build-path START_DIR DEFAULT_MAP))
+(define pmap-main empty)
+
+;; todo: this ain't a function
+(if (file-exists? pmap-file)
+ ; load it, or ...
+ (set! pmap-main (dynamic-require pmap-file POLLEN_ROOT))
+ ; ... synthesize it
+ (let ([files (directory-list START_DIR)])
+ (set! files (map remove-ext (filter (λ(x) (has-ext? x POLLEN_SOURCE_EXT)) files)))
+ (set! pmap-main (make-tagged-xexpr 'map-main empty (map path->string files)))))
+
+;; todo: restrict this test
+;; all names must be unique
+(define/contract (pmap? x)
+ (any/c . -> . boolean?)
+ (and (tagged-xexpr? x)
+ ;; all locations must be unique. Check this by converting x to a list of strings ...
+ (let ([locations (map ->string (flatten (remove-attrs x)))])
+ ;; and then coercing to set (because set impliedly enforces uniqueness)
+ ;; If set has same number of elements as original, all are unique.
+ (= (len (apply set locations)) (len locations)))))
+
+;; recursively processes map, converting map locations & their parents into xexprs of this shape:
+;; '(location ((parent "parent")))
+(define/contract (add-parents x [parent empty])
+ ((pmap?) (xexpr-tag?) . ->* . pmap?)
+ ; disallow map-main as parent tag
+ ; (when (equal? parent 'map-main) (set! parent empty))
+ (match x
+ ;; this pattern signifies next level in hierarchy
+ ;; where first element is new parent, and rest are children.
+ [(list (? xexpr-tag? next-parent) children ...)
+ (let-values ([(tag attr _) (break-tagged-xexpr (add-parents next-parent parent))])
+ ;; xexpr with tag as name, parent as attr, children as elements with tag as next parent
+ (make-tagged-xexpr tag attr (map (λ(c) (add-parents c tag)) children)))]
+ ;; single map entry: convert to xexpr with parent
+ [else (make-tagged-xexpr (->symbol x) (make-xexpr-attr 'parent (->string parent)))]))
+
+(module+ test
+ (define test-pmap-main `(pmap-main "foo" "bar" ,(pmap-topic "one" (pmap-topic "two" "three"))))
+ (check-equal? (add-parents test-pmap-main)
+ '(pmap-main ((parent "")) (foo ((parent "pmap-main"))) (bar ((parent "pmap-main"))) (one ((parent "pmap-main")) (two ((parent "one")) (three ((parent "two"))))))))
+
+;; remove parents from map (i.e., just remove attrs)
+;; is not the inverse of add-parents, i.e., you do not get back your original input.
+(define/contract (remove-parents mt)
+ (pmap? . -> . pmap?)
+ (remove-attrs mt))
+
+(module+ test
+ (check-equal? (remove-parents
+ '(pmap-main ((parent "")) (foo ((parent ""))) (bar ((parent "")))
+ (one ((parent "")) (two ((parent "one")) (three ((parent "two")))))))
+ '(pmap-main (foo) (bar) (one (two (three))))))
+
+;; todo: what is this for?
+(define/contract (main->pmap main)
+ (tagged-xexpr? . -> . pmap?)
+ (let-values ([(nx metas) (extract-tag-from-xexpr 'meta main)])
+ (add-parents nx)))
+
+(module+ test
+ (define mt-pmap `(pmap-main "foo" "bar" ,(pmap-topic "one" (pmap-topic "two" "three")) (meta "foo" "bar")))
+ (check-equal? (main->pmap mt-pmap)
+ '(pmap-main ((parent "")) (foo ((parent "pmap-main"))) (bar ((parent "pmap-main"))) (one ((parent "pmap-main")) (two ((parent "one")) (three ((parent "two"))))))))
+
+
+;; todo: what is this for? to have default input?
+(define pmap (main->pmap pmap-main))
+
+
+(define/contract (pmap-key? x)
+ (any/c . -> . boolean?)
+ ;; OK for map-key to be #f
+ (or (symbol? x) (string? x) (eq? x #f)))
+
+;; return the parent of a given name
+(define/contract (parent element [pmap pmap])
+ ((pmap-key?) (pmap?) . ->* . (or/c string? boolean?))
+ (and element (let ([result (se-path* `(,(->symbol element) #:parent) pmap)])
+ (and result (->string result))))) ; se-path* returns #f if nothing found
+
+
+(module+ test
+ (define test-pmap (main->pmap test-pmap-main))
+ (check-equal? (parent 'three test-pmap) "two")
+ (check-equal? (parent "three" test-pmap) "two")
+ (check-false (parent 'nonexistent-name test-pmap)))
+
+
+
+; get children of a particular element
+(define/contract (children element [pmap pmap])
+ ((pmap-key?) (pmap?) . ->* . (or/c list? boolean?))
+ ;; se-path*/list returns '() if nothing found
+ (and element (let ([children (se-path*/list `(,(->symbol element)) pmap)])
+ ; If there are sublists, just take first element
+ (and (not (empty? children)) (map (λ(i) (->string (if (list? i) (car i) i))) children)))))
+
+(module+ test
+ (check-equal? (children 'one test-pmap) (list "two"))
+ (check-equal? (children 'two test-pmap) (list "three"))
+ (check-false (children 'three test-pmap))
+ (check-false (children 'fooburger test-pmap)))
+
+
+;; find all siblings on current level: go up to parent and ask for children
+(define/contract (siblings element [pmap pmap])
+ ;; this never returns false: element is always a sibling of itself.
+ ;; todo: how to use input value in contract? e.g., to check that element is part of output list
+ ((pmap-key?) (pmap?) . ->* . (or/c list? boolean?))
+ (children (parent element pmap) pmap))
+
+(module+ test
+ (check-equal? (siblings 'one test-pmap) '("foo" "bar" "one"))
+ (check-equal? (siblings 'foo test-pmap) '("foo" "bar" "one"))
+ (check-equal? (siblings 'two test-pmap) '("two"))
+ (check-false (siblings 'invalid-key test-pmap)))
+
+;; helper function
+(define/contract (side-siblings side element [pmap pmap])
+ ((symbol? pmap-key?) (pmap?) . ->* . (or/c list? boolean?))
+ (define result ((if (equal? side 'left) takef takef-right)
+ (siblings element pmap)
+ (λ(i) (not (equal? (->string element) (->string i))))))
+ (and (not (empty? result)) result))
+
+
+(define/contract (pmap-split element elements)
+ (pmap-key? (listof pmap-key?) . -> . (values (listof pmap-key?) (listof pmap-key?)))
+ (define-values (left right) (splitf-at elements
+ (λ(e) (not (equal? (->string e) (->string element))))))
+ (values left (cdr right)))
+
+(module+ test
+ (check-equal? (values->list (pmap-split 'bar (siblings 'bar test-pmap))) (list '("foo") '("one"))))
+
+
+;; siblings to the left of target element (i.e., precede in map order)
+(define (left-siblings element [pmap pmap])
+ (side-siblings 'left element pmap))
+
+(module+ test
+ (check-equal? (left-siblings 'one test-pmap) '("foo" "bar"))
+ (check-false (left-siblings 'foo test-pmap)))
+
+;; siblings to the right of target element (i.e., follow in map order)
+(define (right-siblings element [pmap pmap])
+ (side-siblings 'right element pmap))
+
+(module+ test
+ (check-false (right-siblings 'one test-pmap))
+ (check-equal? (right-siblings 'foo test-pmap) '("bar" "one")))
+
+
+;; get element immediately to the left in map
+(define/contract (left-sibling element [pmap pmap])
+ ((pmap-key?) (pmap?) . ->* . (or/c string? boolean?))
+ (define siblings (left-siblings element pmap))
+ (and siblings (last siblings)))
+
+(module+ test
+ (check-equal? (left-sibling 'bar test-pmap) "foo")
+ (check-false (left-sibling 'foo test-pmap)))
+
+;; get element immediately to the right in map
+(define/contract (right-sibling element [pmap pmap])
+ ((pmap-key?) (pmap?) . ->* . (or/c string? boolean?))
+ (define siblings (right-siblings element pmap))
+ (and siblings (first siblings)))
+
+(module+ test
+ (check-equal? (right-sibling 'foo test-pmap) "bar")
+ (check-false (right-sibling 'one test-pmap)))
+
+
+;; flatten map to sequence
+(define/contract (make-page-sequence [pmap pmap])
+ (pmap? . -> . (listof string?))
+ ; use cdr to get rid of main-map tag at front
+ (map ->string (cdr (flatten (remove-parents pmap)))))
+
+(module+ test
+ (check-equal? (make-page-sequence test-pmap) '("foo" "bar" "one" "two" "three")))
+
+;; helper function for get-previous-pages and get-next-pages
+(define/contract (adjacent-pages side element [pmap pmap])
+ ((symbol? pmap-key?) (pmap?) . ->* . (or/c list? boolean?))
+ (define result ((if (equal? side 'left) takef takef-right)
+ (make-page-sequence pmap) (λ(y) (not (equal? (->string element) (->string y))))))
+ (and (not (empty? result)) result))
+
+(module+ test
+ (check-equal? (adjacent-pages 'left 'one test-pmap) '("foo" "bar"))
+ (check-equal? (adjacent-pages 'left 'three test-pmap) '("foo" "bar" "one" "two"))
+ (check-false (adjacent-pages 'left 'foo test-pmap)))
+
+
+;; get sequence of earlier pages
+(define/contract (previous-pages element [pmap pmap])
+ ((pmap-key?) (pmap?) . ->* . (or/c list? boolean?))
+ (adjacent-pages 'left element pmap))
+
+(module+ test
+ (check-equal? (previous-pages 'one test-pmap) '("foo" "bar"))
+ (check-equal? (previous-pages 'three test-pmap) '("foo" "bar" "one" "two"))
+ (check-false (previous-pages 'foo test-pmap)))
+
+
+;; get sequence of next pages
+(define (next-pages element [pmap pmap])
+ ((pmap-key?) (pmap?) . ->* . (or/c list? boolean?))
+ (adjacent-pages 'right element pmap))
+
+(module+ test
+ (check-equal? (next-pages 'foo test-pmap) '("bar" "one" "two" "three"))
+ (check-equal? (next-pages 'one test-pmap) '("two" "three"))
+ (check-false (next-pages 'three test-pmap)))
+
+;; get page immediately previous
+(define/contract (previous-page element [pmap pmap])
+ ((pmap-key?) (pmap?) . ->* . (or/c string? boolean?))
+ (define result (previous-pages element pmap))
+ (and result (last result)))
+
+(module+ test
+ (check-equal? (previous-page 'one test-pmap) "bar")
+ (check-equal? (previous-page 'three test-pmap) "two")
+ (check-false (previous-page 'foo test-pmap)))
+
+;; get page immediately next
+(define (next-page element [pmap pmap])
+ ((pmap-key?) (pmap?) . ->* . (or/c string? boolean?))
+ (define result (next-pages element pmap))
+ (and result (first result)))
+
+(module+ test
+ (check-equal? (next-page 'foo test-pmap) "bar")
+ (check-equal? (next-page 'one test-pmap) "two")
+ (check-false (next-page 'three test-pmap)))
+
+(module+ test
+ ;; need to parameterize current-directory
+ ;; because pollen main depends on it to find the include functions
+ (define pm (parameterize ([current-directory "./tests/"])
+ (main->pmap (dynamic-require "test-pmap.p" 'main))))
+ (check-equal? (previous-page (parent 'printers-and-paper pm) pm) "ligatures"))
\ No newline at end of file
diff --git a/pollen-file-tools.rkt b/pollen-file-tools.rkt
index fd7cdf4..a55792b 100644
--- a/pollen-file-tools.rkt
+++ b/pollen-file-tools.rkt
@@ -75,6 +75,16 @@
(check-not-equal? (remove-all-ext foo.bar.txt-path) foo.bar-path) ; removes more than one ext
(check-equal? (remove-all-ext foo.bar.txt-path) foo-path))
+
+(define/contract (filename-of path)
+ (complete-path? . -> . path?)
+ (define-values (dir filename ignored) (split-path path))
+ filename)
+
+(module+ test
+ (check-equal? (filename-of (build-path (current-directory) "pollen-file-tools.rkt")) (->path "pollen-file-tools.rkt")))
+
+
(define/contract (preproc-source? x)
(any/c . -> . boolean?)
(has-ext? (->path x) POLLEN_PREPROC_EXT))
diff --git a/readability.rkt b/readability.rkt
index b865e7a..926e6e4 100644
--- a/readability.rkt
+++ b/readability.rkt
@@ -148,12 +148,13 @@
[else #f]))
;; don't return single-item results inside a list
- (if (and (sliceable-container? result) (= (len result) 1))
+ (if (and (sliceable-container? container) (= (len result) 1))
(car (->list result))
result))
(module+ test
(check-equal? (get '(0 1 2 3 4 5) 2) 2)
+ (check-equal? (get `(0 1 ,(list 2) 3 4 5) 2) (list 2))
(check-equal? (get '(0 1 2 3 4 5) 0 2) '(0 1))
(check-equal? (get '(0 1 2 3 4 5) 2 -1) '(2 3 4))
(check-equal? (get '(0 1 2 3 4 5) 2 'end) '(2 3 4 5))
@@ -169,7 +170,7 @@
(check-equal? (get 'purple 0 2) 'pu)
(check-equal? (get 'purple 2 -1) 'rpl)
(check-equal? (get 'purple 2 'end) 'rple)
- (check-equal? (get (make-hash '((a . 1) (b . 2) (c . 3))) 'a) 1))
+ (check-equal? (get (make-hash `((a . ,(list 1)) (b . ,(list 2)) (c . ,(list 3)))) 'a) (list 1)))
;; general way of testing for membership (à la Python 'in')
;; put item as first arg so function can use infix notation
diff --git a/regenerate.rkt b/regenerate.rkt
index 05c7708..b1a8207 100644
--- a/regenerate.rkt
+++ b/regenerate.rkt
@@ -1,56 +1,96 @@
-#lang racket
-(require xml/path)
-(require "world.rkt" "tools.rkt" "map.rkt")
-(require racket/rerequire)
-
-; hash of mod-dates takes lists of paths as keys,
-; and lists of modification times as values.
-; Reason: a templated page is a combination of two source files.
-; Because templates have a one-to-many relationship with source files,
-; Need to track template mod-date for each source file.
-; Otherwise a changed template will get reloaded only once,
-; and after that get reported as being up to date.
-; Possible: store hash on disk so mod records are preserved
-; between development sessions (prob a worthless optimization)
+#lang racket/base
+(require racket/list racket/path racket/port racket/system
+ racket/file racket/rerequire racket/contract)
+(require "world.rkt" "tools.rkt" "pmap.rkt" "readability.rkt")
+
+(module+ test (require rackunit))
+
+;; mod-dates is a hash that takes lists of paths as keys,
+;; and lists of modification times as values.
+;; Reason: a templated page is a combination of two source files.
+;; Because templates have a one-to-many relationship with source files,
+;; Need to track template mod-date for each source file.
+;; Otherwise a changed template will get reloaded only once,
+;; and after that get reported as being up to date.
+;; Possible: store hash on disk so mod records are preserved
+;; between development sessions (prob a worthless optimization)
(define mod-dates (make-hash))
-(define (mod-date . paths)
- (set! paths (flatten paths))
- (when (andmap file-exists? paths)
- (map file-or-directory-modify-seconds paths)))
-(define (log-refresh . paths)
- (set! paths (flatten paths))
- (hash-set! mod-dates paths (mod-date paths)))
+;; convert a path to a modification date value
+(define/contract (path->mod-date-value path)
+ (path? . -> . (or/c exact-integer? #f))
+ (and (file-exists? path) ; returns #f if a file doesn't exist
+ (file-or-directory-modify-seconds path)))
-(define (source-needs-refresh? . paths)
- (set! paths (flatten paths))
- (or (not (in? mod-dates paths)) ; no mod date
- (not (equal? (mod-date paths) (get mod-dates paths))))) ; data changed
+(module+ test
+ (check-false (path->mod-date-value (->path "foobarfoo.rkt")))
+ (check-true (exact-integer? (path->mod-date-value (build-path (current-directory) (->path "regenerate.rkt"))))))
+
+;; put list of paths into mod-dates
+;; want to take list as input (rather than individual path)
+;; because hash key needs to be a list
+(define/contract (store-refresh-in-mod-dates paths)
+ ((listof path?) . -> . void?)
+ (hash-set! mod-dates paths (map path->mod-date-value paths)))
+
+(module+ test
+ (reset-mod-dates)
+ (store-refresh-in-mod-dates (list (build-path (current-directory) (->path "regenerate.rkt"))))
+ (check-true (= (len mod-dates) 1))
+ (reset-mod-dates))
+
+;; when you want to generate everything fresh,
+;; but without having to #:force everything.
+;; Regenerate functions will always go when no mod-date is found.
+(define/contract (reset-mod-dates)
+ (-> void?)
+ (set! mod-dates (make-hash)))
+
+(module+ test
+ (reset-mod-dates)
+ (store-refresh-in-mod-dates (list (build-path (current-directory) (->path "regenerate.rkt"))))
+ (reset-mod-dates)
+ (check-true (= (len mod-dates) 0)))
+
+;; how to know whether a certain combination of paths needs a refresh
+(define/contract (source-needs-refresh? paths)
+ ((listof path?) . -> . boolean?)
+ (or (not (paths . in? . mod-dates)) ; no stored mod date
+ (not (equal? (map path->mod-date-value paths) (get mod-dates paths))))) ; data has changed
+
+(module+ test
+ (reset-mod-dates)
+ (let ([path (build-path (current-directory) (->path "regenerate.rkt"))])
+ (store-refresh-in-mod-dates (list path))
+ (check-false (source-needs-refresh? (list path)))
+ (reset-mod-dates)
+ (check-true (source-needs-refresh? (list path)))))
-; when you want to generate everything fresh, but not force everything
-(define (reset-mod-dates)
- (let [(keys (hash-keys mod-dates))]
- (map (λ(k) (hash-remove mod-dates k)) keys)))
; helper functions for regenerate functions
(define pollen-file-root (current-directory))
-(define (regenerate-file f)
- (let ([path (build-path pollen-file-root f)])
- (displayln (format "Regenerating: ~a" f))
- (regenerate path)))
+; complete pollen path =
+;(build-path pollen-file-root f)
+
+
+;; regenerate with message
+(define/contract (regenerate-path/message path)
+ (complete-path? . -> . void?)
+ (message "Regenerating: " path)
+ (regenerate path))
+
+;; todo: write test
-;; todo: maybe move this tools.rkt as a utility
-(define (filename-of path)
- (let-values ([(dir filename ignored) (split-path path)])
- filename))
+;;;;;;;;;;;;;
+;; todo next
-(define (regenerate-pmap-pages pmap)
- (define pmap-sequence
- (make-page-sequence (main->tree (dynamic-require pmap 'main))))
- (displayln (format "Regenerating pages from pollen map: ~a" (filename-of pmap)))
- (for-each regenerate-file pmap-sequence))
+(define/contract (regenerate-with-pmap/message pmap)
+ (pmap-source? . -> . void?)
+ (message "Regenerating pages from pollen map: " (filename-of pmap))
+ (for-each regenerate-path/message
+ (make-page-sequence (main->pmap (dynamic-require pmap 'main)))))
(define (get-pollen-files-with-ext ext)
(filter (λ(f) (has-ext? f ext)) (directory-list pollen-file-root)))
@@ -60,10 +100,10 @@
(reset-mod-dates)
(define all-preproc-files (get-pollen-files-with-ext POLLEN_PREPROC_EXT))
- (for-each regenerate-file all-preproc-files)
+ (for-each regenerate-path/message all-preproc-files)
(define all-pollen-maps (get-pollen-files-with-ext POLLEN_MAP_EXT))
- (for-each regenerate-pmap-pages all-pollen-maps)
+ (for-each regenerate-with-pmap/message all-pollen-maps)
(displayln "Completed"))
@@ -77,7 +117,7 @@
(cond
[(needs-preproc? path) (do-preproc path #:force force)]
[(needs-template? path) (do-template path #:force force)]
- [(pmap-source? path) (regenerate-pmap-pages path)])))
+ [(pmap-source? path) (regenerate-with-pmap/message path)])))
@@ -96,7 +136,7 @@
(or force
(not (file-exists? preproc-out-path))
(source-needs-refresh? preproc-in-path)))
- (log-refresh preproc-in-path)
+ (store-refresh-in-mod-dates preproc-in-path)
; use single quotes to escape spaces in pathnames
(define command
(format "~a '~a' > '~a'" RACKET_PATH preproc-in-path preproc-out-path))
@@ -160,7 +200,7 @@
(not (file-exists? generated-path))
(source-needs-refresh? source-path template-path)
file-was-reloaded?)
- (log-refresh source-path template-path)
+ (store-refresh-in-mod-dates source-path template-path)
; Templates are part of the compile operation.
; Therefore no way to arbitrarily invoke template at run-time.
diff --git a/server-routes.rkt b/server-routes.rkt
index 37497d0..0cc6b56 100644
--- a/server-routes.rkt
+++ b/server-routes.rkt
@@ -17,13 +17,12 @@
(complete-path? . -> . tagged-xexpr?)
(regenerate path)
(dynamic-rerequire path)
- (define main (dynamic-require path 'main))
- main)
+ (dynamic-require path 'main))
+
(define/contract (slurp path #:regenerate? [regenerate? #t])
(complete-path? . -> . string?)
- (when regenerate?
- (regenerate path))
+ (when regenerate? (regenerate path))
(file->string path))
(define/contract (format-as-code tx)
diff --git a/syntax.rkt b/syntax.rkt
deleted file mode 100644
index 963d837..0000000
--- a/syntax.rkt
+++ /dev/null
@@ -1,23 +0,0 @@
-#lang racket
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; Macro that generates all the little xexpr functions
-;; For each tag.
-;;
-
-(require (for-syntax racket/syntax))
-(define-syntax (define-tags stx)
- (syntax-case stx ()
- [(_ name '(tags ...)) ; match pattern of the calling form
- #`(begin ; start with quasiquoted begin block & splice into it
- (define name '(tags ...)) ; assign the provided name to the tags as a group
- #,@(for/list ([tag (syntax->list #'(tags ...))]) ; step through list of tags
- (with-syntax ((tag-as-id (format-id stx "~a" tag))) ; convert tag into identifier
- ; todo: edit this to use tools:tagger
- #`(define (tag-as-id . x) `(tag-as-id ,@x)))))])) ; write out the xexpr function
-
-
-
-(provide (all-defined-out))
\ No newline at end of file
diff --git a/tests/requires/include-me.rkt b/tests/requires/include-me.rkt
index 441e4fc..cc57eb1 100644
--- a/tests/requires/include-me.rkt
+++ b/tests/requires/include-me.rkt
@@ -219,7 +219,7 @@
(define/contract (root . items)
(() #:rest (listof xexpr-element?) . ->* . tagged-xexpr?)
- (decode (cons 'root items)
+ (decode (cons 'root-function items)
; #:exclude-xexpr-tags 'em
; #:xexpr-tag-proc [xexpr-tag-proc (λ(x)x)]
; #:xexpr-attr-proc [xexpr-attr-proc (λ(x)x)]
diff --git a/tests/test-pmap.p b/tests/test-pmap.p
index 25aad1e..834929c 100644
--- a/tests/test-pmap.p
+++ b/tests/test-pmap.p
@@ -1,21 +1,21 @@
#lang planet mb/pollen
-◊map-topic{index
+◊pmap-topic{index
typography-in-ten-minutes
summary-of-key-rules
foreword
introduction
how-to-use
how-to-pay-for-this-book
- ◊map-topic{why-typography-matters
+ ◊pmap-topic{why-typography-matters
what-is-typography
where-do-the-rules-come-from}
- ◊map-topic{type-composition
+ ◊pmap-topic{type-composition
straight-and-curly-quotes
one-space-between-sentences
trademark-and-copyright-symbols
ligatures}
- ◊map-topic{appendix
+ ◊pmap-topic{appendix
printers-and-paper
how-to-make-a-pdf
typewriter-habits
diff --git a/tests/test-requirer.p b/tests/test-requirer.p
index 09b85a1..0e2ad82 100644
--- a/tests/test-requirer.p
+++ b/tests/test-requirer.p
@@ -1,13 +1,13 @@
#lang racket/base
-(require (planet mb/pollen/map))
+(require (planet mb/pollen/pmap))
;
;(require "test-pmap.p")
;(require "pollen-lang-test.p")
-(let ([left (make-page-sequence (main->tree (dynamic-require "test.pmap" 'main)))]
- [right (make-page-sequence (main->tree (dynamic-require "test-pmap.p" 'main)))])
+(let ([left (make-page-sequence (main->pmap (dynamic-require "test.pmap" 'main)))]
+ [right (make-page-sequence (main->pmap (dynamic-require "test-pmap.p" 'main)))])
(print left)
(print right)
(andmap (λ(l r) (equal? l r)) left right))
\ No newline at end of file
diff --git a/tests/test.pmap b/tests/test.pmap
index 25aad1e..834929c 100644
--- a/tests/test.pmap
+++ b/tests/test.pmap
@@ -1,21 +1,21 @@
#lang planet mb/pollen
-◊map-topic{index
+◊pmap-topic{index
typography-in-ten-minutes
summary-of-key-rules
foreword
introduction
how-to-use
how-to-pay-for-this-book
- ◊map-topic{why-typography-matters
+ ◊pmap-topic{why-typography-matters
what-is-typography
where-do-the-rules-come-from}
- ◊map-topic{type-composition
+ ◊pmap-topic{type-composition
straight-and-curly-quotes
one-space-between-sentences
trademark-and-copyright-symbols
ligatures}
- ◊map-topic{appendix
+ ◊pmap-topic{appendix
printers-and-paper
how-to-make-a-pdf
typewriter-habits
diff --git a/tools.rkt b/tools.rkt
index c2636b3..ced9acb 100644
--- a/tools.rkt
+++ b/tools.rkt
@@ -13,7 +13,7 @@
(module+ test (require rackunit))
; make these independent of local includes
-(define (map-topic topic . subtopics)
+(define (pmap-topic topic . subtopics)
(make-tagged-xexpr (->symbol topic) empty (filter-not whitespace? subtopics)))
diff --git a/where.rkt b/where.rkt
deleted file mode 100644
index ada9fad..0000000
--- a/where.rkt
+++ /dev/null
@@ -1,7 +0,0 @@
-#lang racket
-
-(define places '(home-dir pref-dir pref-file temp-dir init-dir init-file links-file addon-dir doc-dir desk-dir sys-dir exec-file run-file collects-dir orig-dir))
-
-(displayln (string-join (map (λ(x) (format "~a: ~a" x (find-system-path x))) places) "\n") )
-
-(displayln (format "current-directory: ~a" (current-directory)))
\ No newline at end of file
diff --git a/world.rkt b/world.rkt
index 3cdacd5..cf8bc36 100644
--- a/world.rkt
+++ b/world.rkt
@@ -1,6 +1,4 @@
-#lang racket
-
-; in the dev branch
+#lang racket/base
(define POLLEN_PREPROC_EXT 'pp)
(define POLLEN_SOURCE_EXT 'p)