mbutterick
/
pollen
3
3
Fork 0
Code Issues 1 Pull Requests Projects Releases Wiki Activity

better error for malformed meta

Browse Source
pull/58/head
Matthew Butterick 10 years ago
parent 5f9fd6bd19
commit d2c9a5d057
1 changed files with 33 additions and 25 deletions
Show Stats Download Patch File Download Diff File

36
main-base.rkt
Unescape Escape View File

@ -31,7 +31,7 @@
body-exprs (... ...)) body-exprs (... ...))
(require 'inner) (require 'inner racket/list)
;; in an inline module, reader-here-path and parser-mode are undefined ;; in an inline module, reader-here-path and parser-mode are undefined
@ -46,18 +46,28 @@
;; Split out the metas. ;; Split out the metas.
(define (split-metas-to-hash x) (define (split-metas-to-hash x)
(define (meta-key x) (car (caadr x))) (define (first-attribute x) (caadr x))
(define (meta-value x) (cadr (caadr x))) (define (meta-key x) (first (first-attribute x)))
(define is-meta-element? (λ(x) (and (list? x) ; possible txexpr (define (meta-value x) (second (first-attribute x)))
(>= (length x) 2) ; = tag + attribute + other elements (which are ignored) (define (properly-formed-meta-payload? x) (and (list? (second x))
(equal? 'meta (car x)) ; tag is 'meta (pair? (first-attribute x))
(symbol? (meta-key x)) ; attribute key is symbol (symbol? (meta-key x)) ; attribute key is symbol
(string? (meta-value x))))) ; attribute value is string (string? (meta-value x)))) ; attribute value is string
(define is-meta-element?
(λ(x)
(define possible-meta (and (list? x) ; possible txexpr
(>= (length x) 2) ; = tag + attribute + other elements (which are ignored)
(equal? 'meta (car x)))) ; tag is 'meta
(if possible-meta
(if (properly-formed-meta-payload? x)
#t
(error 'is-meta-element? "error: meta must be a symbol / string pair, instead got: ~v" x))
#f)))
(define (splitter x) (define (splitter x)
(define meta-acc null) (define meta-acc empty)
(define (split-metas x) (define (split-metas x)
(cond (cond
[(list? x) (define-values (new-metas rest) (values (filter is-meta-element? x) (filter (compose1 not is-meta-element?) x))) [(list? x) (define-values (new-metas rest) (partition is-meta-element? x))
(set! meta-acc (append new-metas meta-acc)) (set! meta-acc (append new-metas meta-acc))
(map split-metas rest)] (map split-metas rest)]
[else x])) [else x]))
@ -65,13 +75,11 @@
(values result meta-acc)) (values result meta-acc))
(define-values (doc-without-metas meta-elements) (splitter x)) (define-values (doc-without-metas meta-elements) (splitter x))
(define meta-xexpr (apply metaroot meta-elements)) (define metas-xexpr (apply metaroot meta-elements))
(define meta-element->assoc (λ(x) (let ([key (meta-key x)][value (meta-value x)]) (cons key value)))) (define meta-element->assoc (λ(me) (cons (meta-key me) (meta-value me))))
(define metas (make-hash (map meta-element->assoc (cdr meta-xexpr)))) (define metas (make-hash (map meta-element->assoc (cdr metas-xexpr))))
(values doc-without-metas metas)) (values doc-without-metas metas))
(require racket/list)
(define doc-with-metas (define doc-with-metas
`(placeholder-root `(placeholder-root
,@(cons (meta 'here-path: here-path) ,@(cons (meta 'here-path: here-path)

Write Preview
Loading…
Cancel
Save