Improve #lang detection (#551)

This also opens up the possibility of using different refactoring suites for different languages.

Author: jackfirth

main.rkt

@@ -34,6 +34,7 @@
          racket/file
          racket/match
          racket/sequence
+         racket/set
          racket/string
          rebellion/base/comparator
          rebellion/base/option
@@ -143,10 +144,22 @@
     (git-commit! message)))
 
 
+(define allowed-langs (set 'racket 'racket/base 'racket/gui))
+
+
 (define/guard (resyntax-analyze source
                           #:suite [suite default-recommendations]
                           #:lines [lines (range-set (unbounded-range #:comparator natural<=>))])
   (define comments (with-input-from-source source read-comment-locations))
+  (define source-lang (source-read-language source))
+  (guard source-lang #:else
+    (log-resyntax-warning "skipping ~a because its #lang could not be determined"
+                          (or (source-path source) "string source"))
+    (refactoring-result-set #:base-source source #:results '()))
+  (guard (set-member? allowed-langs source-lang) #:else
+    (log-resyntax-warning "skipping ~a because it's written in #lang ~a, which is unsupported"
+                          (or (source-path source) "string source") source-lang)
+    (refactoring-result-set #:base-source source #:results '()))
   (define full-source (source->string source))
   (guard (string-prefix? full-source "#lang racket") #:else
     (log-resyntax-warning "skipping ~a because it does not start with #lang racket"

private/source.rkt

@@ -13,6 +13,7 @@
   [source-directory (-> source? (or/c path? #false))]
   [source-original (-> source? unmodified-source?)]
   [source-read-syntax (-> source? syntax?)]
+  [source-read-language (-> source? (or/c module-path? #false))]
   [source-analyze (->* (source?) (#:lines range-set?) source-code-analysis?)]
   [file-source? (-> any/c boolean?)]
   [file-source (-> path-string? file-source?)]
@@ -67,6 +68,11 @@
          syntax/parse)
 
 
+(module+ test
+  (require (submod "..")
+           rackunit))
+
+
 ;@----------------------------------------------------------------------------------------------------
 
 
@@ -121,6 +127,32 @@
   (syntax-label-original-paths (with-input-from-source code read-from-input)))
 
 
+(define (source-read-language code)
+  (define (read-lang-from-input)
+    (port-count-lines! (current-input-port))
+    (with-module-reading-parameterization
+      (λ ()
+        (call/ec
+         (λ (escape)
+           (parameterize ([current-reader-guard escape])
+             (read-syntax))
+           #false)))))
+  (define detected-lang (with-input-from-source code read-lang-from-input))
+  (match detected-lang
+    [(list 'submod path 'reader) path]
+    [#false #false]))
+
+
+(module+ test
+  (test-case "source-read-language"
+    (check-equal? (source-read-language (string-source "#lang racket")) 'racket)
+    (check-equal? (source-read-language (string-source "#lang at-exp racket")) 'at-exp)
+    (check-equal? (source-read-language (string-source "#lang scribble/manual")) 'scribble/manual)
+    (check-equal? (source-read-language (string-source "#lang info")) 'info)
+    (check-equal? (source-read-language (string-source "#lang setup/infotab")) 'setup/infotab)
+    (check-equal? (source-read-language (string-source "(void)")) #false)))
+
+
 (define/guard (source-path code)
   (guard-match (or (file-source path) (modified-source (file-source path) _)) code #:else #false)
   path)