Centralize .rktd document policy

Handle `.rktd` file policy logic in doc-lang module

Author: 6cdh

doclib/check-syntax.rkt

@@ -8,6 +8,7 @@
          racket/port
          "editor.rkt"
          "doc-trace.rkt"
+         "doc-lang.rkt"
          "../common/path-util.rkt"
          "internal-types.rkt")
 
@@ -55,19 +56,18 @@
 (define (check-syntax uri doc-text)
   (define path (uri->path uri))
   (define text (send doc-text get-text))
-  ; rktd <-> rkt is just like JSON <-> js
-  (define data-file? (equal? (path-get-extension path) #".rktd"))
+  (define expand? (requires-expansion? path))
   (define new-trace (new build-trace% [src path] [doc-text doc-text]))
 
   (define in (open-input-string text))
-  (define er (expand-source path in new-trace #:expand? (not data-file?)))
+  (define er (expand-source path in new-trace #:expand? expand?))
 
   (send new-trace walk-stx er)
   (send new-trace walk-log (ExpandResult-logs er))
   (CSResult new-trace text
-            (if data-file?
-                (and (ExpandResult-pre-syntax er) #t)
-                (ExpandResult-all-succeed? er))))
+            (if expand?
+                (ExpandResult-all-succeed? er)
+                (and (ExpandResult-pre-syntax er) #t))))
 
 (provide
   (struct-out CSResult)

doclib/doc-lang.rkt

@@ -263,6 +263,18 @@
     (and (regexp-match? (Known-Language-name-rx language) text)
          language)))
 
+(define/contract (racket-data-file-path? path)
+  (-> path-string? boolean?)
+  (equal? (path-get-extension path) #".rktd"))
+
+(define/contract (requires-expansion? path)
+  (-> path-string? boolean?)
+  (not (racket-data-file-path? path)))
+
+(define/contract (requires-language-declaration? path)
+  (-> path-string? boolean?)
+  (not (racket-data-file-path? path)))
+
 (define (uri->suffix uri)
   (define extension (path-get-extension (uri->path uri)))
   (bytes->string/utf-8 (subbytes extension 1)))
@@ -366,6 +378,9 @@
          Known-Language~kw
          known-languages
          find-language-by-text
+         racket-data-file-path?
+         requires-expansion?
+         requires-language-declaration?
          parse-language-prefix
          parse-language
          guess-language-by-uri

doclib/service/diagnostic.rkt

@@ -4,7 +4,6 @@
          racket/class
          racket/string
          racket/set
-         racket/path
          racket/match
          racket/list
          setup/path-to-relative
@@ -44,7 +43,7 @@
       (define pre-exn (ExpandResult-pre-exn expand-result))
       (define post-exn (ExpandResult-post-exn expand-result))
       (define maybe-language-diag
-        (and (not (equal? (path-get-extension src) #".rktd"))
+        (and (requires-language-declaration? src)
              (language-diagnostic doc-text)))
       (when maybe-language-diag
         (add-diag! maybe-language-diag))

tests/lib/doc-lang-test.rkt

@@ -232,6 +232,20 @@
                   'scribble)
     (check-false (guess-language-by-uri "file:///tmp/demo.rkt")))
 
+  (test-case
+    "rktd files are Racket data, not expandable modules"
+    (define path (string->path "/tmp/demo.rktd"))
+    (check-true (racket-data-file-path? path))
+    (check-false (requires-expansion? path))
+    (check-false (requires-language-declaration? path)))
+
+  (test-case
+    "rkt files still require module policy"
+    (define path (string->path "/tmp/demo.rkt"))
+    (check-false (racket-data-file-path? path))
+    (check-true (requires-expansion? path))
+    (check-true (requires-language-declaration? path)))
+
   (test-case
     "sexp-language? is true only for known sexp families"
     (check-true (sexp-language? "#lang racket/base\n(define x 1)\n"))