codecov.rkt (3495B)
1 #lang racket/base 2 (provide generate-codecov-coverage) 3 (require 4 racket/file 5 racket/function 6 racket/list 7 racket/string 8 racket/unit 9 json 10 net/http-client 11 net/uri-codec 12 cover/private/file-utils 13 "ci-service.rkt" 14 "travis-service.rkt" 15 "gitlab-service.rkt" 16 "github-service.rkt") 17 18 (module+ test 19 (require rackunit cover racket/runtime-path)) 20 21 ;; -> 22 ;; Submit cover information to Codecov 23 (define (generate-codecov-coverage coverage files [_dir "coverage"]) 24 (define json (codecov-json coverage files)) 25 (define-values (status resp port) (send-codecov! json)) 26 (displayln status) 27 (displayln resp) 28 (displayln "Coverage information sent to Codecov.")) 29 30 (define (codecov-json coverage files) 31 (hasheq 'messages (hasheq) 32 'coverage (calculate-line-coverage coverage files))) 33 34 (define (calculate-line-coverage coverage files) 35 (for/hasheq ([file (in-list files)]) 36 (define local-file (string->symbol (path->string (->relative file)))) 37 (values local-file (line-coverage coverage file)))) 38 39 ;; Coverage PathString Covered? -> [Listof CoverallsCoverage] 40 ;; Get the line coverage for the file to generate a coverage report 41 (define (line-coverage coverage file) 42 (define covered? (curry coverage file)) 43 (define split-src (string-split (file->string file) "\n")) 44 (define (process-coverage value rst-of-line) 45 (case (covered? value) 46 ['covered (if (equal? 'uncovered rst-of-line) rst-of-line 'covered)] 47 ['uncovered 'uncovered] 48 [else rst-of-line])) 49 50 (define-values (line-cover _) 51 (for/fold ([coverage `(,(json-null))] [count 1]) ([line (in-list split-src)]) 52 (cond [(zero? (string-length line)) (values (cons (json-null) coverage) (add1 count))] 53 [else (define nw-count (+ count (string-length line) 1)) 54 (define all-covered (foldr process-coverage 'irrelevant (range count nw-count))) 55 (values (cons (process-coverage-value all-covered) coverage) nw-count)]))) 56 (reverse line-cover)) 57 58 (module+ test 59 (define-runtime-path path "tests/test-not-run.rkt") 60 (let () 61 (parameterize ([current-cover-environment (make-cover-environment)]) 62 (define file (path->string (simplify-path path))) 63 (test-files! file) 64 (check-equal? (line-coverage (get-test-coverage) file) `(,(json-null) 1 0))))) 65 66 ;; CoverageData -> [Or Number json-null] 67 ;; Converts CoverageData to coverage value recognized by Codecov 68 (define (process-coverage-value value) 69 (case value 70 ['covered 1] 71 ['uncovered 0] 72 [else (json-null)])) 73 74 ;; Send Codecov data 75 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 76 77 (define services 78 (hash travis-ci? travis-service@ 79 gitlab-ci? gitlab-service@ 80 github-ci? github-service@)) 81 82 (define CODECOV_HOST "codecov.io") 83 84 (define (send-codecov! json) 85 (define service (for/first ([(pred unit) services] #:when (pred)) unit)) 86 (cond [(not service) (error "Failed to find a service.")] 87 [else 88 (define-values/invoke-unit service (import) (export ci-service^)) 89 (define raw-params (filter cdr (query))) 90 (define params (alist->form-urlencoded raw-params)) 91 (http-sendrecv CODECOV_HOST 92 (string-append "/upload/v1?" params) 93 #:method "POST" 94 #:ssl? #t 95 #:data (jsexpr->bytes json) 96 #:headers '("Accept: application/json" "Content-Type: application/json"))]))