extract define-error-text

Getting this macro right (with good error reporting and small code size
for a macro-generating macro) was fun, because I almost had it on the
first try! I mistakenly used internal-definition-context? instead of
syntax-local-context, but now I know about that. And I don't need to
smuggle the macro name into the error message; it's present already.
Not syntax-quoting the @error-text identifier did bite me but in
retrospect the #' is definitely needed.

Close #82

gui/helpers.rkt

@@ -1,12 +1,17 @@
-#lang racket/base
+#lang racket
 
 (provide
   translate-to-top-coords
-  escape-text)
+  escape-text
+  define-error-text)
 
-(require racket/class)
+(require racket/class
+         syntax/parse/define
+         racket/gui/easy/operator)
 
-(module+ test (require rackunit))
+(module+ test (require rackunit
+                       racket/gui/easy
+                       syntax/macro-testing))
 
 (define (translate-to-top-coords this top x y)
   (define-values (xs ys) (send this client->screen x y))
@@ -20,3 +25,35 @@
     (check-equal? (escape-text "foo") "foo")
     (check-equal? (escape-text "Flourish & Fletch & Foo") "Flourish && Fletch && Foo")
     (check-equal? (escape-text "Flourish && Fletch") "Flourish &&& Fletch")))
+
+(define-syntax define-error-text
+  (syntax-parser
+   [(_ @error-text:id with-error-text:id)
+    #:fail-when (equal? 'expression (syntax-local-context)) "not allowed in an expression context"
+    (syntax/loc this-syntax
+      (begin
+        (define/obs @error-text "")
+        (define-syntax with-error-text (-with-error-text #'@error-text))))]))
+
+(define-for-syntax (-with-error-text error-text-id)
+  (syntax-parser
+   [(_ e:expr ...+)
+    (quasisyntax/loc this-syntax
+      (call-with-error-text #,error-text-id (thunk e ...)))]))
+
+(define (call-with-error-text @error-text th)
+  (:= @error-text "")
+  (with-handlers ([exn:fail? (λ (e) (:= @error-text (exn-message e)))])
+    (th)))
+
+(module+ test
+  (let ()
+    (define-error-text @e wet)
+    (check-equal? (obs-peek @e) "")
+    (check-equal? (wet (add1 2)) 3)
+    (check-equal? (obs-peek @e) "")
+    (check-not-exn (thunk (wet (/ 1 0))))
+    (check-regexp-match #rx"division by zero" (obs-peek @e)))
+  (check-exn #rx"expression context"
+             (thunk
+              (convert-syntax-error (if 1 (define-error-text @x wxt) 2)))))

gui/loot.rkt

@@ -27,6 +27,7 @@
          frosthaven-manager/files
          frosthaven-manager/gui/mixins
          frosthaven-manager/gui/counter
+         frosthaven-manager/gui/helpers
          frosthaven-manager/gui/render
          frosthaven-manager/gui/table
          frosthaven-manager/gui/rich-text-display
@@ -74,13 +75,7 @@
   (hpanel (spacer) (counter (@> @n {(~a label _)}) add-card subtract-card) (spacer)))
 
 (define (loot-cards-loader @type->deck #:on-deck [on-deck void])
-  (define/obs @error-text "")
-  (define (call-with-error-text th)
-    (:= @error-text "")
-    (with-handlers ([exn:fail? (λ (e) (:= @error-text (exn-message e)))])
-      (th)))
-  (define-syntax-rule (with-error-text e ...)
-    (call-with-error-text (thunk e ...)))
+  (define-error-text @error-text with-error-text)
   (define (load-standard-cards)
     (:= @error-text "")
     (on-deck standard-loot-deck))

gui/manager.rkt

@@ -32,6 +32,7 @@
          frosthaven-manager/gui/loot
          (only-in frosthaven-manager/elements elements)
          frosthaven-manager/gui/elements
+         frosthaven-manager/gui/helpers
          frosthaven-manager/monster-db
          frosthaven-manager/gui/monsters
          frosthaven-manager/gui/render
@@ -124,13 +125,7 @@
            (button "Next" (to-choose-monster-db s)))))
 
 (define (choose-monster-db-view s)
-  (define/obs @error-text "")
-  (define (call-with-error-text th)
-    (:= @error-text "")
-    (with-handlers ([exn:fail? (λ (e) (:= @error-text (exn-message e)))])
-      (th)))
-  (define-syntax-rule (with-error-text e ...)
-    (call-with-error-text (thunk e ...)))
+  (define-error-text @error-text with-error-text)
   (vpanel
     (db-view (state-@info-db s)
              (state-@ability-db s)

scribblings/gui/helpers.scrbl

@@ -20,3 +20,12 @@ Returns translated @racket[x] and @racket[y] coordinates relative to
 Escapes @racket[s] for use in @racket[text]; only needed when @racket[s] is
 derived from user input.
 }
+
+@defform[(define-error-text |@error-text-id| with-error-text-id)]{
+Binds @racket[|@error-text-id|] to an observable string and
+@racket[with-error-text-id] to a form accepting arbitrarily many expressions.
+The form resets @racket[|@error-text-id|] evaluates all of its body expressions
+and returns the result of the last one; if any raise an exception, instead, the
+exception's error message is stored in @racket[|@error-text-id|] and returned
+from the form.
+}