change pollen language to export a hash called 'metas (rather than storing metas as xexprs within main)

decode.rkt

@@ -114,44 +114,8 @@
 
 
 
-;; test for well-formed meta
-(define/contract (meta-xexpr? x)
-  (any/c . -> . boolean?)
-  (match x
-    [`(meta ,(? string? key) ,(? string? value)) #t]
-    [else #f]))
-
-(module+ test
-  (check-true (meta-xexpr? '(meta "key" "value")))
-  (check-false (meta-xexpr? '(meta "key" "value" "foo")))
-  (check-false (meta-xexpr? '(meta))))
-
-
-;; function to strip metas (or any tag)
-(define/contract (extract-tag-from-xexpr tag nx)
-  (xexpr-tag? tagged-xexpr? . -> . (values tagged-xexpr? xexpr-elements?))
-  (define matches '())
-  (define (extract-tag x)
-    (cond
-      [(and (tagged-xexpr? x) (equal? tag (car x)))
-       ; stash matched tag but return empty value
-       (begin
-         (set! matches (cons x matches))
-         empty)]
-      [(tagged-xexpr? x) (let-values([(tag attr body) (break-tagged-xexpr x)]) 
-                           (make-tagged-xexpr tag attr (extract-tag body)))]
-      [(xexpr-elements? x) (filter-not empty? (map extract-tag x))]
-      [else x]))
-  (values (extract-tag nx) (reverse matches))) 
 
 
-(module+ test
-  (define x '(root (meta "foo" "bar") "hello" "world" (meta "foo2" "bar2") 
-                   (em "goodnight" "moon" (meta "foo3" "bar3"))))
-  
-  (check-equal? (values->list (extract-tag-from-xexpr 'meta x)) 
-                (list '(root "hello" "world" (em "goodnight" "moon"))
-                      '((meta "foo" "bar") (meta "foo2" "bar2") (meta "foo3" "bar3")))))
 ;; decoder wireframe
 (define/contract (decode nx
                          #:exclude-xexpr-tags [excluded-xexpr-tags '()]
@@ -160,8 +124,7 @@
                          #:xexpr-elements-proc [xexpr-elements-proc (λ(x)x)]
                          #:block-xexpr-proc [block-xexpr-proc (λ(x)x)]
                          #:inline-xexpr-proc [inline-xexpr-proc (λ(x)x)]
-                         #:string-proc [string-proc (λ(x)x)]
+                         #:string-proc [string-proc (λ(x)x)])
-                         #:meta-proc [meta-proc (λ(x)x)])
   ;; use xexpr/c for contract because it gives better error messages
   ((xexpr/c) (#:exclude-xexpr-tags (λ(i) (or (symbol? i) (list? i)))
                                    #:xexpr-tag-proc procedure?
@@ -169,8 +132,7 @@
                                    #:xexpr-elements-proc procedure?
                                    #:block-xexpr-proc procedure?
                                    #:inline-xexpr-proc procedure?
-                                   #:string-proc procedure?
+                                   #:string-proc procedure?)
-                                   #:meta-proc procedure?)
              . ->* . tagged-xexpr?)
   (when (not (tagged-xexpr? nx))
     (error (format "decode: ~v not a full tagged-xexpr" nx)))
@@ -193,6 +155,4 @@
       [else x]))
   
   
-  (let-values ([(nx metas) (extract-tag-from-xexpr 'meta nx)])
+  (&decode nx))
-    (append (&decode nx) (map meta-proc metas))))
-

main.rkt

@@ -1,5 +1,5 @@
 #lang racket/base
-(require racket/match)
+(require racket/list)
 (require (planet mb/pollen/tools) (planet mb/pollen/main-helper))
 (provide (except-out (all-from-out racket/base) #%module-begin)
          (rename-out [module-begin #%module-begin]))
@@ -43,25 +43,43 @@
    
    (require 'pollen-inner) ; provides doc & #%top, among other things
    
+   ;; prepare the elements, and append inner-here as meta.
+   (define all-elements (append 
+                                (cond
+                                  ;; doc is probably a list, but might be a single string
+                                  [(string? doc) (list doc)] 
+                                  [(tagged-xexpr? doc) (list doc)] ; if it's a single nx, just leave it
+                                  [(list? doc) doc]) ; if it's nx content, splice it in
+                                (list `(meta "here" ,inner-here)))) ; append inner-here as meta
+   
+   ;; split out the metas now (in raw form)
+   (define-values (main-raw metas-raw) 
+     (extract-tag-from-xexpr 'meta (make-tagged-xexpr 'irrelevant-tag empty all-elements)))
+   
    ;; Policy: here in the core lang, do as little to main as possible.
    ;; The point is just to set it up for further processing.
    ;; One of the annoyances of Scribble is its insistence on decoding.
    ;; Better just to pass through the minimally processed data.
    ;; Root is treated as a function. 
    ;; If it's not defined elsewhere, it just hits #%top and becomes a tagged-xexpr.
-   (define main (apply root
+   (define main (apply root (tagged-xexpr-elements main-raw)))
-                        (append 
-                         (cond
-                           [(string? doc) (list doc)] ; doc is probably a list, but might be a single string
-                           [(tagged-xexpr? doc) (list doc)] ; if it's a single nx, just leave it
-                           [(list? doc) doc]) ; if it's nx content, splice it in
-                         (list `(meta "here" ,inner-here))))) ; append inner-here as meta
    
-   (provide main
+   (define metas (make-meta-hash metas-raw))
+   
+   (provide main metas
             (except-out (all-from-out 'pollen-inner) inner-here) ; everything from user 
             (rename-out (inner-here here))) ; change identifier back (now safe from macrofication)
    
    (module+ main
+     (displayln ";-------------------------")
+     (displayln "; pollen decoded 'main")     
+     (displayln ";-------------------------")
      main
      (displayln "")
-     (displayln (format "tagged-xexpr? ~a" (tagged-xexpr? main)))))) 
+     (displayln (format "(tagged-xexpr? main) ~a" (tagged-xexpr? main)))
+     (displayln "")
+     (displayln ";-------------------------")
+     (displayln "; pollen 'metas")
+     (displayln ";-------------------------")
+     metas
+     ))) 

tests/pollen-lang-test.p

@@ -16,6 +16,7 @@ We
 Goodnight
 moon
 
+
 ◊foo
 
 

tests/requires/include-me.rkt

@@ -13,14 +13,6 @@
 
 
 
-;; handle meta tags
-(define/contract (meta-proc meta)
-  (meta-xexpr? . -> . tagged-xexpr?)
-  `(meta ((name ,(second meta))(content ,(third meta)))))
-
-(module+ test
-  (check-equal? (meta-proc '(meta "key" "value")) '(meta ((name "key")(content "value")))))
-
 ;; is x a paragraph break?
 (define/contract (paragraph-break? x #:pattern [paragraph-pattern #px"^\n\n+$"])
   ((any/c) (#:pattern pregexp?) . ->* . boolean?)
@@ -234,9 +226,7 @@
           #:xexpr-elements-proc xexpr-elements-proc
           #:block-xexpr-proc block-xexpr-proc
           ;          #:inline-xexpr-proc [inline-xexpr-proc (λ(x)x)]
-          #:string-proc string-proc
+          #:string-proc string-proc))
-          #:meta-proc meta-proc
-          ))
 
 
 (define foo "bar")

tools.rkt

@@ -94,6 +94,7 @@
     [else #f]))
 
 (module+ test  
+  (check-true (xexpr-attr? empty))
   (check-true (xexpr-attr? '((key "value"))))
   (check-true (xexpr-attr? '((key "value") (foo "bar"))))
   (check-false (xexpr-attr? '((key "value") "foo" "bar"))) ; content, not attr
@@ -184,6 +185,9 @@
   (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?)
@@ -254,7 +258,7 @@
 (module+ test
   (check-equal? (remove-attrs '(p ((foo "bar")) "hi")) '(p "hi"))
   (check-equal? (remove-attrs '(p ((foo "bar")) "hi" (p ((foo "bar")) "hi"))) '(p "hi" (p "hi"))))
-  
+
 
 ;; apply filter proc recursively
 (define/contract (filter-tree proc tree)
@@ -301,3 +305,53 @@
 (module+ test
   (check-equal? (map-tree (λ(i) (if (number? i) (* 2 i) i)) '(p 1 2 3 (em 4 5))) '(p 2 4 6 (em 8 10)))
   (check-equal? (map-tree (λ(i) (if (symbol? i) 'foo i)) '(p 1 2 3 (em 4 5))) '(foo 1 2 3 (foo 4 5))))
+
+
+;; function to strip metas (or any tag)
+(define/contract (extract-tag-from-xexpr tag nx)
+  (xexpr-tag? tagged-xexpr? . -> . (values tagged-xexpr? xexpr-elements?))
+  (define matches '())
+  (define (extract-tag x)
+    (cond
+      [(and (tagged-xexpr? x) (equal? tag (car x)))
+       ; stash matched tag but return empty value
+       (begin
+         (set! matches (cons x matches))
+         empty)]
+      [(tagged-xexpr? x) (let-values([(tag attr body) (break-tagged-xexpr x)]) 
+                           (make-tagged-xexpr tag attr (extract-tag body)))]
+      [(xexpr-elements? x) (filter-not empty? (map extract-tag x))]
+      [else x]))
+  (values (extract-tag nx) (reverse matches))) 
+
+
+(module+ test
+  (define x '(root (meta "foo" "bar") "hello" "world" (meta "foo2" "bar2") 
+                   (em "goodnight" "moon" (meta "foo3" "bar3"))))
+  
+  (check-equal? (values->list (extract-tag-from-xexpr 'meta x)) 
+                (list '(root "hello" "world" (em "goodnight" "moon"))
+                      '((meta "foo" "bar") (meta "foo2" "bar2") (meta "foo3" "bar3")))))
+
+;; test for well-formed meta
+(define/contract (meta-xexpr? x)
+  (any/c . -> . boolean?)
+  (match x
+    [`(meta ,(? string? key) ,(? string? value)) #t]
+    [else #f]))
+
+(module+ test
+  (check-true (meta-xexpr? '(meta "key" "value")))
+  (check-false (meta-xexpr? '(meta "key" "value" "foo")))
+  (check-false (meta-xexpr? '(meta))))
+
+
+;; convert list of meta tags to a hash for export from pollen document.
+;; every meta is form (meta "key" "value") (enforced by contract)
+(define/contract (make-meta-hash mxs)
+  ((listof meta-xexpr?) . -> . hash?)
+  (apply hash (append-map tagged-xexpr-elements mxs)))
+
+(module+ test
+  (check-equal? (make-meta-hash '((meta "foo" "bar")(meta "hee" "haw")))
+                (hash "foo" "bar" "hee" "haw")))