change `meta` tags to `define-meta` and add `metas` submodule
parent
9a6176ae58
commit
bbab98f0a5
@ -1,122 +0,0 @@
|
|||||||
#lang racket/base
|
|
||||||
(require racket/list pollen/top txexpr pollen/world) ; pollen/top needed for metaroot
|
|
||||||
(provide split-metas-to-hash)
|
|
||||||
|
|
||||||
(require sugar)
|
|
||||||
|
|
||||||
(module+ test
|
|
||||||
(require rackunit))
|
|
||||||
|
|
||||||
|
|
||||||
(define (possible-meta-element? x)
|
|
||||||
(and (txexpr? x) (equal? (world:current-meta-tag-name) (get-tag x))))
|
|
||||||
|
|
||||||
|
|
||||||
(define (trivial-meta-element? x)
|
|
||||||
(and (possible-meta-element? x) (not (nontrivial-meta-element? x))))
|
|
||||||
|
|
||||||
|
|
||||||
(define (has-meta-attrs x)
|
|
||||||
(let ([attrs (get-attrs x)])
|
|
||||||
(and (not (empty? attrs)) (andmap valid-meta-attr? attrs))))
|
|
||||||
|
|
||||||
|
|
||||||
(define (has-meta-elements x)
|
|
||||||
(not (empty? (filter txexpr? (get-elements x)))))
|
|
||||||
|
|
||||||
|
|
||||||
(define (nontrivial-meta-element? x)
|
|
||||||
(and (possible-meta-element? x)
|
|
||||||
(or (has-meta-attrs x) (has-meta-elements x))))
|
|
||||||
|
|
||||||
|
|
||||||
(define (meta-element? x)
|
|
||||||
(or (trivial-meta-element? x) (nontrivial-meta-element? x)))
|
|
||||||
|
|
||||||
|
|
||||||
(module+ test
|
|
||||||
(check-true (nontrivial-meta-element? '(meta ((foo "bar")))))
|
|
||||||
(check-true (nontrivial-meta-element? '(meta (foo "bar"))))
|
|
||||||
(check-true (trivial-meta-element? '(meta)))
|
|
||||||
(check-true (trivial-meta-element? '(meta "bar"))))
|
|
||||||
|
|
||||||
|
|
||||||
;; strictly speaking, this predicate isn't necessary (implied by txexpr-ness)
|
|
||||||
;; but it produces a helpful error
|
|
||||||
(define (valid-meta-attr? x)
|
|
||||||
(or (and (list? x) (symbol? (first x)) (string? (second x)))
|
|
||||||
(error 'is-meta-element? "error: meta must be a symbol / string pair, instead got: ~v" x)))
|
|
||||||
|
|
||||||
|
|
||||||
;; all metas are converted into "atomic meta" format
|
|
||||||
;; which is '(meta (key value ...))
|
|
||||||
(define (make-atomic-meta key . values)
|
|
||||||
`(,(world:current-meta-tag-name) (,key ,@values)))
|
|
||||||
|
|
||||||
|
|
||||||
(define (explode-meta-element me)
|
|
||||||
;; convert a meta with multiple key/value pairs into multiple metas with a single txexpr element
|
|
||||||
;; only gets nontrivial metas to start.
|
|
||||||
(let loop ([me (make-txexpr (get-tag me) (get-attrs me) (filter txexpr? (get-elements me)))][acc empty])
|
|
||||||
(cond
|
|
||||||
[(not (trivial-meta-element? me)) ; meta might become trivial during loop
|
|
||||||
(cond
|
|
||||||
[(has-meta-attrs me) ; might have txexpr elements, so preserve them
|
|
||||||
(define attrs (get-attrs me))
|
|
||||||
(loop (make-txexpr (world:current-meta-tag-name) (cdr attrs) (get-elements me)) (cons (apply make-atomic-meta (car attrs)) acc))]
|
|
||||||
[else ; has txexpr elements, but not meta-attrs
|
|
||||||
(define txexpr-elements (get-elements me)) ; elements were filtered for txexpr at loop entry
|
|
||||||
(loop (make-txexpr (world:current-meta-tag-name) null (cdr txexpr-elements)) (cons (apply make-atomic-meta (car txexpr-elements)) acc))])]
|
|
||||||
[else (reverse acc)])))
|
|
||||||
|
|
||||||
(define (splitter x pred)
|
|
||||||
(define acc null)
|
|
||||||
(define leftover (let loop ([x x])
|
|
||||||
(cond
|
|
||||||
[(list? x) (define-values (pred-elements rest) (partition pred x))
|
|
||||||
(set! acc (append pred-elements acc))
|
|
||||||
(map loop rest)]
|
|
||||||
[else x])))
|
|
||||||
(values leftover (reverse acc)))
|
|
||||||
|
|
||||||
|
|
||||||
(define (split-meta-elements x) ; pull metas out of doc and put them into meta-elements accumulator
|
|
||||||
;; watch out: x may not be a txexpr, because we are extracting metas before the pollen parser has finished its work
|
|
||||||
;; for instance, floating-point numbers will eventually become strings, but here they're still numbers
|
|
||||||
;; thus instead of split-txexpr, use a custom splitter
|
|
||||||
(define-values (thing-without-meta-elements meta-elements) (splitter x meta-element?))
|
|
||||||
;; trivial metas are discarded
|
|
||||||
(define exploded-meta-elements (append-map explode-meta-element (filter nontrivial-meta-element? meta-elements)))
|
|
||||||
(values thing-without-meta-elements exploded-meta-elements))
|
|
||||||
|
|
||||||
|
|
||||||
(define (split-metas-to-hash x)
|
|
||||||
(define-values (doc-without-metas meta-elements) (split-meta-elements x))
|
|
||||||
;; 'metaroot is the hook for the meta decoder function.
|
|
||||||
;; If it's not a defined identifier, it just hits #%top and becomes `(metaroot ,@metas ...)
|
|
||||||
;; because of `explode-meta-element`, meta-elements will be a list of metas with a single key/value pair
|
|
||||||
;; metaroot can rely on this
|
|
||||||
(define metas-xexpr (apply metaroot meta-elements))
|
|
||||||
(define (first-attribute x) (car (get-elements x)))
|
|
||||||
(define (meta-key x) (car (first-attribute x)))
|
|
||||||
(define (meta-value x) (let ([rest (cdr (first-attribute x))])
|
|
||||||
(if (= (length rest) 1)
|
|
||||||
(car rest)
|
|
||||||
rest)))
|
|
||||||
(define (meta-element->assoc me) (cons (meta-key me) (meta-value me)))
|
|
||||||
(define metas (make-hash (map meta-element->assoc (cdr metas-xexpr))))
|
|
||||||
(values doc-without-metas metas))
|
|
||||||
|
|
||||||
|
|
||||||
(module+ test
|
|
||||||
(require rackunit)
|
|
||||||
;; 1.5 instead of "1.5" is deliberate: input may not yet be a true txexpr
|
|
||||||
(let ([x '(root (meta ((foo "bar"))) "hello" (p (meta ((foo "zam"))) (meta) "there" 1.5))])
|
|
||||||
(define-values (doc-without-metas metahash) (split-metas-to-hash x))
|
|
||||||
(check-equal? doc-without-metas '(root "hello" (p "there" 1.5)))
|
|
||||||
(check-equal? (hash-ref metahash 'foo) "zam"))
|
|
||||||
|
|
||||||
(let ([x '(root (meta (foo "bar")) "hello" (p (meta (foo (zim "zam"))) (meta) "there" 1.5))])
|
|
||||||
(define-values (doc-without-metas metahash) (split-metas-to-hash x))
|
|
||||||
(check-equal? doc-without-metas '(root "hello" (p "there" 1.5)))
|
|
||||||
(check-equal? (hash-ref metahash 'foo) '(zim "zam"))))
|
|
||||||
@ -1,3 +1,3 @@
|
|||||||
#lang pollen
|
#lang pollen
|
||||||
∆metaover{∆dog{Roxy}}
|
∆define-meta[dog]{Roxy}
|
||||||
∆(number->string (+ 1 1))
|
∆(number->string (+ 1 1))
|
||||||
Loading…
Reference in New Issue