From d2c9a5d057a3b9c097ce18d2ff804bb41eaa3af4 Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Mon, 4 May 2015 23:54:47 -0400
Subject: [PATCH] better error for malformed meta

---
 main-base.rkt | 58 +++++++++++++++++++++++++++++----------------------
 1 file changed, 33 insertions(+), 25 deletions(-)

diff --git a/main-base.rkt b/main-base.rkt
index 7f17b22..6449850 100644
--- a/main-base.rkt
+++ b/main-base.rkt
@@ -9,7 +9,7 @@
      (with-syntax ([new-module-begin (format-id stx "new-module-begin")])
        #'(begin
            (provide (except-out (all-from-out racket/base) #%module-begin)
-                   (rename-out [new-module-begin #%module-begin]))
+                    (rename-out [new-module-begin #%module-begin]))
            (define-syntax (new-module-begin stx-arg)
              (syntax-case stx-arg ()
                [(_ body-exprs (... ...))
@@ -31,7 +31,7 @@
                       
                       body-exprs (... ...))
                     
-                    (require 'inner)
+                    (require 'inner racket/list)
                     
                     
                     ;; in an inline module, reader-here-path and parser-mode are undefined 
@@ -46,36 +46,44 @@
                     
                     ;; Split out the metas.   
                     (define (split-metas-to-hash x)
-                      (define (meta-key x) (car (caadr x)))
-                      (define (meta-value x) (cadr (caadr x)))
-                      (define is-meta-element? (λ(x) (and (list? x) ; possible txexpr
-                                                         (>= (length x) 2) ; = tag + attribute + other elements (which are ignored)
-                                                         (equal? 'meta (car x)) ; tag is 'meta
-                                                         (symbol? (meta-key x)) ; attribute key is symbol
-                                                         (string? (meta-value x))))) ; attribute value is string
+                      (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 null)
+                        (define meta-acc empty)
                         (define (split-metas x)
                           (cond
-                            [(list? x) (define-values (new-metas rest) (values (filter is-meta-element? x) (filter (compose1 not is-meta-element?) x)))
-                                      (set! meta-acc (append new-metas meta-acc))
-                                      (map split-metas rest)]
+                            [(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 meta-xexpr (apply metaroot meta-elements))
-                      (define meta-element->assoc (λ(x) (let ([key (meta-key x)][value (meta-value x)]) (cons key value))))
-                      (define metas (make-hash (map meta-element->assoc (cdr meta-xexpr))))
-                      (values doc-without-metas metas)) 
-                    
-                    (require racket/list)
+                      (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 doc-with-metas
-                        `(placeholder-root 
-                          ,@(cons (meta 'here-path: here-path) 
-                                 (if (list? doc-raw) 
+                      `(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)))) 
                     
@@ -91,9 +99,9 @@
                                          [(equal? parser-mode world:mode-markdown) (λ xs (apply root (apply (compose1 (dynamic-require 'markdown 'parse-markdown) string-append) (map to-string xs))))]
                                          ;; for preprocessor output, just make a string.
                                          [else (λ xs (apply string-append (map to-string xs)))]) ; default mode is preprocish
-                                      (cdr doc-without-metas))) ;; cdr strips placeholder-root tag
+                                       (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.
+                             (except-out (all-from-out 'inner) doc-raw #%top))))]))))]))
\ No newline at end of file