Add debug logs and display them in tests (#242)

This makes test failures cause by unexpectedly discarded suggestions much easier to diagnose. In the future I might expose a CLI switch to show these messages too, but for now just surfacing them in test failures is enough.

main.rkt

@@ -12,6 +12,7 @@
 
 
 (require fancy-app
+         guard
          racket/port
          racket/sequence
          racket/syntax-srcloc
@@ -25,6 +26,7 @@
          resyntax/default-recommendations
          resyntax/private/comment-reader
          resyntax/private/file-group
+         resyntax/private/logger
          resyntax/private/refactoring-result
          resyntax/private/source
          resyntax/private/string-replacement
@@ -56,17 +58,26 @@
               (format "~a: refactoring attempt failed\n  syntax: ~e\n  cause: ~e"
                       (object-name rule) syntax e))
             (raise (exn:fail:refactoring message (current-continuation-marks) rule syntax e)))])
-      (option-map
-       (option-filter
-        (option-filter
-         (refactoring-rule-refactor rule syntax #:analysis analysis)
-         syntax-replacement-preserves-free-identifiers?)
-        (syntax-replacement-preserves-comments? _ comments))
-       (refactoring-result
-        #:source (source-code-analysis-code analysis)
-        #:rule-name (object-name rule)
-        #:message (refactoring-rule-description rule)
-        #:replacement _))))
+      (guarded-block
+        (guard-match (present replacement)
+          (refactoring-rule-refactor rule syntax #:analysis analysis)
+          #:else absent)
+        (guard (syntax-replacement-preserves-free-identifiers? replacement) #:else
+          (log-resyntax-debug
+           "suggestion from ~a discarded because it does not preserve all free identifiers"
+           (object-name rule))
+          absent)
+        (guard (syntax-replacement-preserves-comments? replacement comments) #:else
+          (log-resyntax-debug
+           "suggestion from ~a discarded because it does not preserve all comments"
+           (object-name rule))
+          absent)
+        (present
+         (refactoring-result
+          #:source (source-code-analysis-code analysis)
+          #:rule-name (object-name rule)
+          #:message (refactoring-rule-description rule)
+          #:replacement replacement)))))
 
   (falsey->option
    (for*/first ([rule (in-list rules)]

private/logger.rkt

@@ -0,0 +1,12 @@
+#lang racket/base
+
+
+(provide log-resyntax-fatal
+         log-resyntax-error
+         log-resyntax-warning
+         log-resyntax-info
+         log-resyntax-debug
+         resyntax-logger)
+
+
+(define-logger resyntax)

testing/refactoring-test.rkt

@@ -13,6 +13,7 @@
 (require (for-syntax racket/base
                      racket/sequence)
          racket/list
+         racket/logging
          racket/match
          racket/port
          racket/pretty
@@ -23,12 +24,14 @@
          rebellion/collection/hash
          rebellion/collection/list
          rebellion/collection/multiset
+         rebellion/collection/vector/builder
          rebellion/streaming/transducer
          rebellion/type/tuple
          resyntax
+         resyntax/private/logger
          resyntax/private/refactoring-result
-         resyntax/refactoring-suite
          resyntax/private/string-replacement
+         resyntax/refactoring-suite
          syntax/parse
          syntax/parse/define
          syntax/modread)
@@ -117,12 +120,21 @@
 
 
 (define-check (check-suite-refactors suite original-program expected-program)
-  (define results (refactor original-program #:suite suite))
+  (define logged-messages-builder (make-vector-builder))
+  (define results
+    (with-intercepted-logging
+        (λ (log-entry)
+          (vector-builder-add logged-messages-builder (vector-ref log-entry 1)))
+      #:logger resyntax-logger
+      (λ () (refactor original-program #:suite suite))
+      'debug))
+  (define logged-messages (build-vector logged-messages-builder))
 
   (with-check-info*
       (if (empty? results)
-          '()
-          (list (check-info 'matched-rules (refactoring-results-matched-rules-info results))))
+          (list (check-info 'logs logged-messages))
+          (list (check-info 'logs logged-messages)
+                (check-info 'matched-rules (refactoring-results-matched-rules-info results))))
     (λ ()
       (define replacement
         (with-handlers