From b70851367db7a4bdb3ea9d134341ebb9c21c97bc Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 21 May 2015 12:41:16 -0700 Subject: [PATCH] permit multiple-valued meta tags (closes #51) --- main-base.rkt | 65 ++++++++------------------------------- metas.rkt | 58 ++++++++++++++++++++++++++++++++++ scribblings/command.scrbl | 18 +++++++++-- 3 files changed, 86 insertions(+), 55 deletions(-) create mode 100644 metas.rkt diff --git a/main-base.rkt b/main-base.rkt index 6449850..2454143 100644 --- a/main-base.rkt +++ b/main-base.rkt @@ -25,69 +25,30 @@ ;; Change behavior of undefined identifiers with #%top ;; Get project values from world (require pollen/top pollen/world) - (provide (all-from-out pollen/top pollen/world)) - - (provide (all-defined-out)) + (provide (all-defined-out) (all-from-out pollen/top pollen/world)) body-exprs (... ...)) - (require 'inner racket/list) - + (require 'inner racket/list pollen/metas) ;; in an inline module, reader-here-path and parser-mode are undefined ;; (because there's no reader) ;; but they'll become tag functions courtesy of #%top ;; so that's how we can detect if they are undefined - (define here-path - (if (procedure? inner:reader-here-path) "anonymous-module" inner:reader-here-path)) - (define parser-mode - (if (procedure? inner:parser-mode) mode-arg inner:parser-mode)) - - - ;; Split out the metas. - (define (split-metas-to-hash x) - (define (first-attribute x) (caadr x)) - (define (meta-key x) (first (first-attribute x))) - (define (meta-value x) (second (first-attribute x))) - (define (properly-formed-meta-payload? x) (and (list? (second x)) - (pair? (first-attribute x)) - (symbol? (meta-key x)) ; attribute key is symbol - (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 meta-acc empty) - (define (split-metas x) - (cond - [(list? x) (define-values (new-metas rest) (partition is-meta-element? x)) - (set! meta-acc (append new-metas meta-acc)) - (map split-metas rest)] - [else x])) - (define result (split-metas x)) - (values result meta-acc)) - - (define-values (doc-without-metas meta-elements) (splitter x)) - (define metas-xexpr (apply metaroot meta-elements)) - (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)) + (define here-path (if (procedure? inner:reader-here-path) + "anonymous-module" + inner:reader-here-path)) + (define parser-mode (if (procedure? inner:parser-mode) + mode-arg + inner:parser-mode)) (define doc-with-metas `(placeholder-root ,@(cons (meta 'here-path: here-path) (if (list? doc-raw) (dropf doc-raw (λ(i) (equal? i "\n"))) ; discard all newlines at front of file - doc-raw)))) - - (define-values (doc-without-metas metas) (split-metas-to-hash doc-with-metas)) + doc-raw)))) + (define-values (doc-without-metas metas) (split-metas-to-hash doc-with-metas)) ; split out the metas ;; set up the 'doc export (require pollen/decode) @@ -101,7 +62,5 @@ [else (λ xs (apply string-append (map to-string xs)))]) ; default mode is preprocish (cdr doc-without-metas))) ;; cdr strips placeholder-root tag - - (provide metas doc - ;; hide the exports that were only for internal use. - (except-out (all-from-out 'inner) doc-raw #%top))))]))))])) \ No newline at end of file + ;; hide the exports that were only for internal use. + (provide metas doc (except-out (all-from-out 'inner) doc-raw #%top))))]))))])) diff --git a/metas.rkt b/metas.rkt new file mode 100644 index 0000000..c78fb9d --- /dev/null +++ b/metas.rkt @@ -0,0 +1,58 @@ +#lang racket/base +(require racket/list pollen/top txexpr) ; pollen/top needed for metaroot +(provide split-metas-to-hash) + +(define (meta-element? x) + (or (trivial-meta-element? x) (nontrivial-meta-element? x))) + +(define (trivial-meta-element? x) ; trivial meta has no attributes. + (and (possible-meta-element? x) (empty? (get-attrs x)))) + +(define (nontrivial-meta-element? x) ; nontrivial meta has attributes that are valid. + (and (possible-meta-element? x) + (let ([attrs (get-attrs x)]) + (and (not (empty? attrs)) (andmap valid-meta-attr? attrs))))) + +(define (possible-meta-element? x) + (and (txexpr? x) (equal? 'meta (get-tag x)))) + +(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))) + +(define (explode-meta-element me) + ;; convert a meta with multiple key/value pairs into multiple metas with a single key/value pair + ;; only gets nontrivial metas to start. + (let loop ([me me][acc empty]) + (cond + [(not (trivial-meta-element? me)) ; meta might become trivial during loop (no attrs) + (define attrs (get-attrs me)) + (loop `(meta ,(cdr attrs)) (cons `(meta ,(list (car attrs))) acc))] + [else (reverse acc)]))) + +(define (split-meta-elements x) ; pull metas out of doc and put them into meta-elements accumulator + (define meta-elements empty) + (define (extract-meta-elements x) + (cond + [(list? x) (define-values (new-metas rest) (partition meta-element? x)) + (set! meta-elements (append (filter nontrivial-meta-element? new-metas) meta-elements)) ; trivial metas are discarded + (map extract-meta-elements rest)] + [else x])) + (define thing-without-meta-elements (extract-meta-elements x)) + (values thing-without-meta-elements (append-map explode-meta-element 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-attrs x))) + (define (meta-key x) (first (first-attribute x))) + (define (meta-value x) (second (first-attribute x))) + (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)) + + diff --git a/scribblings/command.scrbl b/scribblings/command.scrbl index fd2271b..9cefeaf 100644 --- a/scribblings/command.scrbl +++ b/scribblings/command.scrbl @@ -474,7 +474,7 @@ When you mark a meta like this, two things happen. First, when you run the file, '(some-tag ((key "value")) "Another normal tag") } -@margin-note{If your @code{meta} includes a text argument between curly braces — or any other arguments aside from the initial key–value pair — they will be ignored.} +@margin-note{If your @code{meta} includes a text argument between curly braces, it will be ignored.} Second, the meta is collected into a hash table that is exported with the name @code{metas}. To see this hash table, run the file above in DrRacket, then move to the interactions window and type @exec{metas} at the prompt: @@ -503,7 +503,7 @@ When you run this code, the result will be the same as before, but this time the '#hash((dog . "Roxy") (here-path . "nowhere")) } -It doesn't matter how many metas you put in a source file or where you put them. They'll all be extracted and put into the @code{metas} hash table. The order of the metas is not preserved (because order is not preserved in a hash table). But if you have two metas with the same key, the later one will supersede the earlier one: +It doesn't matter how many metas you put in a source file, or where you put them. They'll all be extracted into the @code{metas} hash table. The order of the metas is not preserved (because order is not preserved in a hash table). But if you have two metas with the same key, the later one will supersede the earlier one: @codeblock{ #lang pollen @@ -521,6 +521,20 @@ Though there are two metas named @racket['dog], only the second one persists: '#hash((dog . "Lex") (here-path . "unsaved-editor167056")) } +You're allowed to put multiple keys and values within a single @code{meta} tag. As above, later keys supersede earlier ones. + +@codeblock{ +#lang pollen + +◊some-tag['key: "value"]{Normal tag} +◊meta['dog: "Roxy" 'lion: "P22" 'dog: "Lex"] +◊some-tag['key: "value"]{Another normal tag} +} + +@terminal{ +> metas +'#hash((dog . "Lex") (here-path . "unsaved-editor167056") (lion . "P22")) +} @;-------------------------------------------------------------------- @subsubsection{Inserting a comment}