#lang racket
(require raco/command-name "cover.rkt" "format.rkt" "private/shared.rkt")
(module+ test
  (require rackunit racket/runtime-path))

(module+ main

  (define coverage-dir "coverage")
  (define output-format "html")
  (define exclude-dirs '())
  (define include-exts '())

  (define args
     (command-line
      #:program (short-program+command-name)
      #:once-each
      [("-d" "--directory") d
       "Specify output directory. Defaults to ./coverage."
       (set! coverage-dir d)]
      [("-c" "--coverage") format
       "Specify that coverage should be run and optional what format. Defaults to html."
       (set! output-format format)]
      [("-v" "--verbose")
       "Verbose mode"
       (verbose #t)]
      #:multi
      [("-e" "--exclude-from-output") t
       "exclude all directories named this from the coverage report. By default excludes dirs named tests"
       (set! exclude-dirs (cons t exclude-dirs))]
      [("-i" "--include-extentions") f
       "include these extentions in files to cover."
       (set! include-exts (cons f include-exts))]
      #:args (file . files)
      (cons file files)))
  (define files (expand-directories args include-exts))
  (define generate-coverage
    (case output-format
      [("html") generate-html-coverage]
      [("coveralls") generate-coveralls-coverage]
      [("raw") generate-raw-coverage]
      [else (error 'cover "given unknown coverage output format: ~s" output-format)]))
  (printf "generating test coverage for ~s\n" files)
  (define passed (apply test-files! files))
  (define coverage (remove-dirs (get-test-coverage) exclude-dirs))
  (printf "dumping coverage info into ~s\n" coverage-dir)
  (generate-coverage coverage coverage-dir)
  (exit
   (case passed
     [(#t) 0]
     [(#f) 1])))

;; TODO allow for arbitrary extensions
(define extensions '(#rx"\\.rkt$" #rx"\\.ss$"))
(define (expand-directories files [exts null])
  (define comped (map regexp exts))
  (flatten
   (for/list ([f files])
     (if (not (directory-exists? f))
         f
         (parameterize ([current-directory
                         (if (absolute-path? f)
                             f
                             (build-path (current-directory) f))])
           (expand-directory (append extensions comped)))))))

;; -> (HorribyNestedListsOf PathString)
(define (expand-directory exts)
  (for/list ([p (directory-list)])
    (cond [(directory-exists? p)
           (parameterize ([current-directory (build-path (current-directory) p)])
             (expand-directory exts))]
          [(ormap (lambda (r) (regexp-match r (path->string p))) exts)
           (path->string (build-path (current-directory) p))]
          [else null])))
(module+ test
  (define-runtime-path cur ".")
  (parameterize ([current-directory (build-path cur "tests/basic")])
    (check-equal? (list->set (map (compose path->string ->relative)
                                  (flatten (expand-directory extensions))))
                  (set "prog.rkt"
                       "not-run.rkt"))))

;; Coverage -> Coverage
(define (remove-dirs cover dirs)
  (for/hash ([(k v) cover]
             #:unless (is-dir? k dirs))
    (values k v)))
(module+ test
  (parameterize ([current-directory (build-path "/tests")])
    (check-equal? (remove-dirs (hash "/tests/tests/x.rkt" null
                                     "/tests/x/tests/x/x.rkt" null
                                     "/tests/x.rkt" null)
                               '("tests"))
                  (hash "/tests/x.rkt" null))))


;; PathString -> any/c
(define (is-dir? k dirs)
  (define expl (explode-path (->relative k)))
  (ormap (lambda (d) (member (build-path d) expl))
         dirs))
(module+ test
  (parameterize ([current-directory (build-path "/tests")])
    (check-not-false (is-dir? "/test/test/x.rkt" '("test")))
    (check-false (is-dir? "/test/x.rkt" '("test")))
    (check-false (is-dir? "/test/t/x.rkt" '("test")))))

;; PathString -> Path
(define (->relative path)
  (if (relative-path? path)
      (build-path path)
      (let-values ([(_ lst)
                    (split-at (explode-path path)
                              (length (explode-path (current-directory))))])
        (apply build-path lst))))
(module+ test
  (parameterize ([current-directory (build-path "/test")])
    (check-equal? (->relative "a")
                  (build-path "a"))
    (check-equal? (->relative "/test/a/b")
                  (build-path "a" "b"))))