<commit_before>#lang racket/base
(provide make-covered?)
(require racket/file
         racket/function
         racket/list
         racket/match
         racket/port
         racket/set
         syntax-color/racket-lexer
         syntax/modread
         syntax/parse
         "shared.rkt")

(module+ test (require rackunit "../cover.rkt" racket/runtime-path racket/set))

;;;;; a Coverage is the output of (get-test-coverage)
;;;;; a FileCoverage is the values of the hashmap from (get-test-coverage)

;;;;; utils

;;; a Cover is (U 'covered 'uncovered 'irrelevant)

;; [Hashof PathString [Hashof Natural Cover]]

;; A Covered? is a [Nat [#:byte? Boolean] -> Cover]

;; FileCoverage PathString -> Covered?
(define (make-covered? c path)
  (define vec
    (list->vector (string->list (file->string path))))
  (define file/byte->str-offset (make-byte->str-offset vec))
  (define file-location-coverage-cache
    (coverage-cache-file path c))
  (lambda (loc #:byte? [byte? #f])
    (hash-ref file-location-coverage-cache (if (not byte?) loc (- loc (file/byte->str-offset loc)))
              'missing)))


;; Path FileCoverage OffsetFunc -> [Hashof Natural Cover]
(define (coverage-cache-file f c)
  (vprintf "caching coverage info for ~s\n" f)
  (with-input-from-file f
    (thunk
     (define lexer
       (with-handlers ([exn:fail:read? (const racket-lexer)])
         (define f (read-language))
         (if f
             (f 'color-lexer racket-lexer)
             racket-lexer)))
     (define irrelevant? (make-irrelevant? lexer f))
     (define file-length (string-length (file->string f)))
     (define cache
       (for/hash ([i (in-range 1 (add1 file-length))])
         (values i
                 (cond [(irrelevant? i) 'irrelevant]
                       [else (raw-covered? i c)]))))
     cache)))

;; TODO should we only ignore test (and main) submodules?
(define (make-irrelevant? lexer f)
  (define s (mutable-set))
  (define-values (for-lex for-str) (replicate-file-port f (current-input-port)))
  (define str (apply vector (string->list (port->string for-str))))
  (define init-offset (- (string-length (file->string f))
                         (vector-length str)))

  (define offset (make-byte->str-offset str))

  (let loop ()
    (define-values (v type _m start end) (lexer for-lex))
    (case type
      [(eof) (void)]
      [(comment sexp-comment no-color white-space)
       (for ([i (in-range (- start (offset start)) (- end (offset end)))])
         (set-add! s (+ init-offset i)))
       (loop)]
      [else (loop)]))
  (define stx
    (with-input-from-file f
      (thunk (with-module-reading-parameterization read-syntax))))

  (define offset/mod (make-byte->str-offset str))
  (let loop ([stx stx] [first? #t])
    (define (loop* stx) (loop stx #f))
    (syntax-parse stx
      #:datum-literals (module module* module+ begin-for-syntax)
      [((~or module module* module+ begin-for-syntax)
        e ...)
       #:when (not first?)
       (define ?start (syntax-position stx))
       (when ?start
         (define start (- ?start (* 2 (offset/mod ?start))))
         (define end (+ start (syntax-span stx)))
         (for ([i (in-range start end)])
           (set-add! s i)))]
      [(e ...) (for-each loop* (syntax->list #'(e ...)))]
      [_else (void)]))
  (lambda (i) (set-member? s i)))<commit_msg>laying groundwork for submodule ignoring<commit_after>#lang racket/base
(provide make-covered?)
(require racket/file
         racket/function
         racket/list
         racket/match
         racket/port
         racket/set
         racket/bool
         syntax-color/racket-lexer
         syntax/modread
         syntax/parse
         "shared.rkt")

(module+ test (require rackunit "../cover.rkt" racket/runtime-path racket/set))

;;;;; a Coverage is the output of (get-test-coverage)
;;;;; a FileCoverage is the values of the hashmap from (get-test-coverage)

;;;;; utils

;;; a Cover is (U 'covered 'uncovered 'irrelevant)

;; [Hashof PathString [Hashof Natural Cover]]

;; A Covered? is a [Nat [#:byte? Boolean] -> Cover]

;; FileCoverage PathString -> Covered?
(define (make-covered? c path #:ignored-submods [submods #f])
  (define vec
    (list->vector (string->list (file->string path))))
  (define file/byte->str-offset (make-byte->str-offset vec))
  (define file-location-coverage-cache
    (coverage-cache-file path c submods))
  (lambda (loc #:byte? [byte? #f])
    (hash-ref file-location-coverage-cache (if (not byte?) loc (- loc (file/byte->str-offset loc)))
              'missing)))


;; Path FileCoverage OffsetFunc -> [Hashof Natural Cover]
(define (coverage-cache-file f c submods)
  (vprintf "caching coverage info for ~s\n" f)
  (with-input-from-file f
    (thunk
     (define lexer
       (with-handlers ([exn:fail:read? (const racket-lexer)])
         (define f (read-language))
         (if f
             (f 'color-lexer racket-lexer)
             racket-lexer)))
     (define irrelevant? (make-irrelevant? lexer f submods))
     (define file-length (string-length (file->string f)))
     (define cache
       (for/hash ([i (in-range 1 (add1 file-length))])
         (values i
                 (cond [(irrelevant? i) 'irrelevant]
                       [else (raw-covered? i c)]))))
     cache)))

(define (make-irrelevant? lexer f submods)
  (define s (mutable-set))
  (define-values (for-lex for-str) (replicate-file-port f (current-input-port)))
  (define str (apply vector (string->list (port->string for-str))))
  (define init-offset (- (string-length (file->string f))
                         (vector-length str)))

  (define offset (make-byte->str-offset str))

  (let loop ()
    (define-values (v type _m start end) (lexer for-lex))
    (case type
      [(eof) (void)]
      [(comment sexp-comment no-color white-space)
       (for ([i (in-range (- start (offset start)) (- end (offset end)))])
         (set-add! s (+ init-offset i)))
       (loop)]
      [else (loop)]))
  (define stx
    (with-input-from-file f
      (thunk (with-module-reading-parameterization read-syntax))))

  (define offset/mod (make-byte->str-offset str))
  (let loop ([stx stx] [first? #t])
    (define (loop* stx) (loop stx #f))
    (syntax-parse stx
      #:datum-literals (module module* module+ begin-for-syntax)
      [((~or module module* module+ begin-for-syntax)
        n:id
        e ...)
       #:when (and (not first?)
                   (submods
                    . implies .
                    (member (syntax-e #'n) submods)))
       (define ?start (syntax-position stx))
       (when ?start
         (define start (- ?start (* 2 (offset/mod ?start))))
         (define end (+ start (syntax-span stx)))
         (for ([i (in-range start end)])
           (set-add! s i)))]
      [(e ...) (for-each loop* (syntax->list #'(e ...)))]
      [_else (void)]))
  (lambda (i) (set-member? s i)))
{'fraction_non_alphanumeric': 0.1613420860685631, 'fraction_numerical': 0.00087527352297593, 'mean_word_length': 2.4696356275303644, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 35, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1151408', 'n_tokens_mistral': 2319, 'n_tokens_neox': 2212, 'n_words': 632}