From ccb6bbebec77e74e312de3d84726d0c27b575ce5 Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Tue, 7 Jan 2020 10:18:27 -0800
Subject: [PATCH] better error msg for miscalled tag function

---
 pollen/private/ts.rktd |  2 +-
 pollen/tag.rkt         | 23 +++++++++++++----------
 2 files changed, 14 insertions(+), 11 deletions(-)

diff --git a/pollen/private/ts.rktd b/pollen/private/ts.rktd
index 7fa2ee3..4fd9567 100644
--- a/pollen/private/ts.rktd
+++ b/pollen/private/ts.rktd
@@ -1 +1 @@
-1576590927
+1578421107
diff --git a/pollen/tag.rkt b/pollen/tag.rkt
index 68eeb2b..2c0e03e 100644
--- a/pollen/tag.rkt
+++ b/pollen/tag.rkt
@@ -1,4 +1,4 @@
-#lang pollen/mode racket/base
+#lang pollen/mode debug racket/base
 (require (for-syntax
           racket/base
           syntax/parse)
@@ -53,7 +53,7 @@
   (make-keyword-procedure
    (λ (outer-kws outer-kw-args . ids)
      (define tag-proc (apply compose1 (for/list ([id (in-list ids)])
-                                               (make-one-tag-function outer-kws outer-kw-args id))))
+                                        (make-one-tag-function outer-kws outer-kw-args id))))
      (define tag-proc-name (string->symbol (format "pollen-tag:~a" (string-join (map symbol->string ids) "+"))))
      (procedure-rename tag-proc tag-proc-name))))
 
@@ -78,19 +78,22 @@
 (define-syntax (define-tag-function stx)
   (syntax-parse stx
     #:literals (λ)
-    [(_ (ID:id ARG:id ...) EXPR:expr ...)
-     #'(define-tag-function ID (λ (ARG ...) EXPR ...))]
+    [(THIS (ID:id ARG:id ...) EXPR:expr ...)
+     #'(THIS ID (λ (ARG ...) EXPR ...))]
     [(_ ID:id (λ (ATTRS:id ELEMS:id ARG:id ...) EXPR:expr ...))
      #:fail-when (> (length (syntax->list #'(ARG ...))) 0) "tag function must have exactly 2 positional arguments"
      #:fail-when (check-duplicate-identifier (list #'ATTRS #'ELEMS)) "duplicate variable name"
      #:fail-when (null? (syntax->list #'(EXPR ...))) "body of definition cannot be empty"
-     #'(define ID
+     ;; the srcloc of the `lambda` expression determines the srcloc of errors raised within its body
+     #`(define ID
          (make-keyword-procedure
-          (λ (kws kwargs . args)
-            (define tx-proc (keyword-apply default-tag-function kws kwargs (list 'ID)))
-            (define tx (apply tx-proc args))
-            (define-values (_ ATTRS ELEMS) (txexpr->values tx))
-            EXPR ...)))]))
+          #,(syntax/loc #'ID (lambda (kws kwargs attrs . elems)
+                               (define tx-proc (keyword-apply default-tag-function kws kwargs (list 'ID)))
+                               (unless (and (list? elems) (andmap txexpr-element? elems))
+                                 (raise-argument-error 'ID (format "elements need to be passed to tag function as individual trailing arguments (or, if you want to pass them as a single list, use `(apply ~a ···)` here instead of `(~a ···)`)" 'ID 'ID) (car elems)))
+                               (define tx (apply tx-proc attrs elems))
+                               (define-values (_ ATTRS ELEMS) (txexpr->values tx))
+                               EXPR ...))))]))
 
 
 (module+ test