Support codecov json.

Adds the ability to send codecov json to Codecov.io from Travis CI.

.travis.yml

@@ -18,8 +18,11 @@ before_install:
 
 install:
   - git clone https://github.com/florence/cover ../cover
-  - raco pkg install ../cover/
+  - raco pkg install --deps search-auto ../cover/
   - raco pkg install --deps search-auto $TRAVIS_BUILD_DIR
 
 script:
   - raco test $TRAVIS_BUILD_DIR # run tests. you wrote tests, right?
+
+after_success:
+  - raco cover -f codecov .

codecov/private/ci-service.rkt

@@ -1,16 +0,0 @@
-#lang racket/base
-
-(provide ci-service^)
-(require racket/unit)
-
-
-(define-signature ci-service^
-  ((contracted
-    ;; Return Git Branch that is being tested
-    [branch (-> string?)]
-    ;; The commit that the code is on
-    [commit (-> string?)]
-    ;; The Service Job identifier
-    [job (-> string?)]
-    ;; The codecov token
-    [token (-> string?)])))

cover/codecov.rkt

@@ -0,0 +1,3 @@
+#lang racket/base
+(provide generate-codecov-coverage)
+(require "private/codecov.rkt")

cover/private/ci-service.rkt

@@ -0,0 +1,10 @@
+#lang racket/base
+
+(provide ci-service^)
+
+(require racket/unit racket/contract/base)
+
+(define-signature ci-service^
+  ((contracted
+    ;; The Service's query string based on the environment
+    [query (-> (listof (cons/c symbol? (or/c string? #f))))])))

cover/private/codecov.rkt

@@ -0,0 +1,92 @@
+#lang racket/base
+(provide generate-codecov-coverage)
+(require
+  racket/file
+  racket/function
+  racket/list
+  racket/string
+  racket/unit
+  json
+  net/http-client
+  net/uri-codec
+  cover/private/file-utils
+  "ci-service.rkt"
+  "travis-service.rkt")
+
+(module+ test
+  (require rackunit cover racket/runtime-path))
+
+;; ->
+;; Submit cover information to Codecov
+(define (generate-codecov-coverage coverage files _dir)
+  (define json (codecov-json coverage files))
+  (define-values (status resp port) (send-codecov! json))
+  (displayln status)
+  (displayln resp)
+  (displayln "Coverage information sent to Codecov."))
+
+(define (codecov-json coverage files)
+  (hasheq 'messages (hasheq)
+          'coverage (calculate-line-coverage coverage files)))
+
+(define (calculate-line-coverage coverage files)
+  (for/hasheq ([file (in-list files)])
+    (define local-file (string->symbol (path->string (->relative file))))
+    (values local-file (line-coverage coverage file))))
+
+;; Coverage PathString Covered? -> [Listof CoverallsCoverage]
+;; Get the line coverage for the file to generate a coverage report
+(define (line-coverage coverage file)
+  (define covered? (curry coverage file))
+  (define split-src (string-split (file->string file) "\n"))
+  (define (process-coverage value rst-of-line)
+    (case (covered? value)
+      ['covered (if (equal? 'uncovered rst-of-line) rst-of-line 'covered)]
+      ['uncovered 'uncovered]
+      [else rst-of-line]))
+
+  (define-values (line-cover _)
+    (for/fold ([coverage `(,(json-null))] [count 1]) ([line (in-list split-src)])
+      (cond [(zero? (string-length line)) (values (cons (json-null) coverage) (add1 count))]
+            [else (define nw-count (+ count (string-length line) 1))
+                  (define all-covered (foldr process-coverage 'irrelevant (range count nw-count)))
+                  (values (cons (process-coverage-value all-covered) coverage) nw-count)])))
+  (reverse line-cover))
+
+(module+ test
+  (define-runtime-path path "tests/not-run.rkt")
+  (let ()
+    (parameterize ([current-cover-environment (make-cover-environment)])
+      (define file (path->string (simplify-path path)))
+      (test-files! file)
+      (check-equal? (line-coverage (get-test-coverage) file) `(,(json-null) 1 0)))))
+
+;; CoverageData -> [Or Number json-null]
+;; Converts CoverageData to coverage value recognized by Codecov
+(define (process-coverage-value value)
+  (case value
+    ['covered 1]
+    ['uncovered 0]
+    [else (json-null)]))
+
+;; Send Codecov data
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define services
+  (hash travis-ci? travis-service@))
+
+(define CODECOV_HOST "codecov.io")
+
+(define (send-codecov! json)
+  (define service (for/first ([(pred unit) services] #:when (pred)) unit))
+  (cond [(not service) (error "Failed to find a service.")]
+        [else
+          (define-values/invoke-unit service (import) (export ci-service^))
+          (define raw-params (filter cdr (query)))
+          (define params (alist->form-urlencoded raw-params))
+          (http-sendrecv CODECOV_HOST
+                         (string-append "/upload/v1?" params)
+                         #:method "POST"
+                         #:ssl? #t
+                         #:data (jsexpr->bytes json)
+                         #:headers '("Accept: application/json" "Content-Type: application/json"))]))

cover/private/tests/not-run.rkt

@@ -0,0 +1,2 @@
+#lang racket
+(if #f 10 2)

cover/private/travis-service.rkt

@@ -0,0 +1,21 @@
+#lang racket/base
+(provide travis-service@ travis-ci?)
+
+(require "ci-service.rkt" racket/unit racket/list racket/string)
+
+(define (travis-ci?) (and (getenv "CI") (getenv "TRAVIS")))
+
+(define-unit travis-service@
+  (import)
+  (export ci-service^)
+
+  (define (query)
+    (define repo-slug (getenv "TRAVIS_REPO_SLUG"))
+    (list (cons 'service "travis")
+          (cons 'token (getenv "CODECOV_TOKEN"))
+          (cons 'branch (getenv "TRAVIS_BRANCH"))
+          (cons 'pull_request (getenv "TRAVIS_PULL_REQUEST"))
+          (cons 'job (getenv "TRAVIS_JOB_ID"))
+          (cons 'slug (getenv "TRAVIS_REPO_SLUG"))
+          (cons 'build (getenv "TRAVIS_JOB_NUMBER"))
+          (cons 'commit (getenv "TRAVIS_COMMIT")))))

info.rkt

@@ -7,7 +7,6 @@
 
 (define deps '(
   ("base" #:version "6.1.1")
-  "envy"
   "cover"))
 
 (define build-deps '("rackunit-lib"))