added make-xexpr-attr function

template.rkt

@@ -1,9 +1,11 @@
 #lang racket/base
-(require xml xml/path racket/list racket/string racket/contract)
+(require xml xml/path racket/list racket/string racket/contract racket/match)
 (require (except-in web-server/templates in))
 (require "tools.rkt" "world.rkt")
 
-(module+ test (require rackunit)
+(module+ test (require rackunit))
+
+(module+ test
   (define tt (main->tree (dynamic-require "tests/test.pmap" POLLEN_ROOT))))
 
 ; get the values out of the file, or make them up
@@ -17,7 +19,7 @@
     ; ... 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 `(map-main ,@(map path->string files)))))
+      (set! map-main (make-tagged-xexpr 'map-main empty (map path->string files)))))
 
 ;; todo: restrict this test
 (define/contract (pmap-tree? x)
@@ -25,23 +27,23 @@
   (tagged-xexpr? x))
 
 ;; insert parents into pmap tree as attrs
-(define/contract (add-parents x [parent null] [previous null])
-  ((pmap-tree?) (xexpr-tag? xexpr-tag?) . ->* . pmap-tree?)
+(define/contract (add-parents x [parent empty])
+  ((pmap-tree?) (xexpr-tag?) . ->* . pmap-tree?)
   ; disallow main as parent tag
   (when (equal? parent 'map-main) (set! parent empty)) 
-  (cond
-    [(list? x) 
-     (let ([new-parent (car x)])
-       ; xexpr with topic as name, parent as attr, children as elements
-       `(,@(add-parents new-parent parent) ,@(map (λ(i) (add-parents i new-parent)) (cdr x))))]
-    [else `(,(->symbol x) ((parent ,(->string parent))))]))
+  (match x
+    [(list (? xexpr-tag? tag) elements ...) ; next level in hierarchy 
+     (let-values ([(tag attr _) (break-tagged-xexpr (add-parents tag parent))])
+       ;; xexpr with tag as name, parent as attr, children as elements with tag as next parent
+       (make-tagged-xexpr tag attr (map (λ(e) (add-parents e tag)) elements)))]
+    ;; single map entry: convert to xexpr with parent
+    [else (make-tagged-xexpr (->symbol x) (make-xexpr-attr 'parent (->string parent)))]))
 
 (module+ test
-  (define stt `(map-main "foo" ,(map-topic "one" "two")))
-  (check-equal? (add-parents stt) '(map-main
-                                    ((parent ""))
-                                    (foo ((parent "")))
-                                    (one ((parent "")) (two ((parent "one")))))))
+  (define stt `(map-main "foo" ,(map-topic "one" (map-topic "two" "three"))))
+  (check-equal? (add-parents stt) 
+                '(map-main ((parent "")) (foo ((parent ""))) (one ((parent "")) 
+                                                                  (two ((parent "one")) (three ((parent "two"))))))))
 
 (define (remove-parents x)  
   (cond

tools.rkt

@@ -2,7 +2,7 @@
 (require racket/contract racket/match)
 (require (only-in racket/path filename-extension))
 (require (only-in racket/format ~a))
-(require (only-in racket/list empty empty? second filter-not splitf-at takef dropf dropf-right))
+(require racket/list)
 (require (only-in racket/string string-join))
 (require (only-in xml xexpr? xexpr/c))
 (require (prefix-in scribble: (only-in scribble/decode whitespace?)))
@@ -139,6 +139,36 @@
   (call-with-values (λ() vs) list))
 
 
+;; convert list of alternating keys & values to attr
+;; todo: make contract. Which is somewhat complicated:
+;; list of items, made of xexpr-attr or even numbers of symbol/string pairs
+;; use splitf*-at with xexpr-attr? as test, then check lengths of resulting lists
+(define/contract (make-xexpr-attr . items)
+  (() #:rest (listof (λ(i) (or (xexpr-attr? i) (symbol? i) (string? i)))) . ->* . xexpr-attr?)
+  
+  ;; need this function to make sure that 'foo and "foo" are treated as the same hash key
+  (define (make-attr-list items)
+    (if (empty? items)
+        empty
+        (let ([key (->symbol (first items))]
+              [value (->string (second items))]
+              [rest (drop items 2)])
+          (append (list key value) (make-attr-list rest)))))
+  
+  ;; use flatten to splice xexpr-attrs into list
+  (define attr-hash (apply hash (make-attr-list (flatten items))))
+  `(,@(map (λ(k v) (list k v)) (hash-keys attr-hash) (hash-values attr-hash))))
+
+(module+ test
+  (check-equal? (make-xexpr-attr 'foo "bar") '((foo "bar")))
+  (check-equal? (make-xexpr-attr "foo" 'bar) '((foo "bar")))
+  (check-equal? (make-xexpr-attr "foo" "bar" "goo" "gar") '((foo "bar")(goo "gar")))
+  (check-equal? (make-xexpr-attr '((foo "bar")(goo "gar")) "hee" "haw") 
+                '((foo "bar")(goo "gar")(hee "haw")))
+  (check-equal? (make-xexpr-attr '((foo "bar")(goo "gar")) "foo" "haw") '((foo "haw")(goo "gar")))
+)
+
+
 ;; create tagged-xexpr from parts (opposite of break-tagged-xexpr)
 (define/contract (make-tagged-xexpr name [attr empty] [content empty])
   ((symbol?) (xexpr-attr? xexpr-elements?) . ->* . tagged-xexpr?)