From 1d418a7dea6ec653c075f55601c00c8fc80a70da Mon Sep 17 00:00:00 2001
From: Ryan Plessner <plessner.ryan@gmail.com>
Date: Tue, 1 Sep 2015 12:53:54 -0400
Subject: [PATCH] Support codecov json.

Adds the ability to send codecov json to Codecov.io from Travis CI.
---
 .travis.yml                      |  5 +-
 codecov/private/ci-service.rkt   | 16 ------
 cover/codecov.rkt                |  3 ++
 {codecov => cover}/info.rkt      |  0
 cover/private/ci-service.rkt     | 10 ++++
 cover/private/codecov.rkt        | 92 ++++++++++++++++++++++++++++++++
 cover/private/tests/not-run.rkt  |  2 +
 cover/private/travis-service.rkt | 21 ++++++++
 info.rkt                         |  1 -
 9 files changed, 132 insertions(+), 18 deletions(-)
 delete mode 100644 codecov/private/ci-service.rkt
 create mode 100644 cover/codecov.rkt
 rename {codecov => cover}/info.rkt (100%)
 create mode 100644 cover/private/ci-service.rkt
 create mode 100644 cover/private/codecov.rkt
 create mode 100644 cover/private/tests/not-run.rkt
 create mode 100644 cover/private/travis-service.rkt

diff --git a/.travis.yml b/.travis.yml
index 7d7bea5..24f1931 100644
--- a/.travis.yml
+++ b/.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 .
diff --git a/codecov/private/ci-service.rkt b/codecov/private/ci-service.rkt
deleted file mode 100644
index 004d544..0000000
--- a/codecov/private/ci-service.rkt
+++ /dev/null
@@ -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?)])))
diff --git a/cover/codecov.rkt b/cover/codecov.rkt
new file mode 100644
index 0000000..1c8cbfb
--- /dev/null
+++ b/cover/codecov.rkt
@@ -0,0 +1,3 @@
+#lang racket/base
+(provide generate-codecov-coverage)
+(require "private/codecov.rkt")
diff --git a/codecov/info.rkt b/cover/info.rkt
similarity index 100%
rename from codecov/info.rkt
rename to cover/info.rkt
diff --git a/cover/private/ci-service.rkt b/cover/private/ci-service.rkt
new file mode 100644
index 0000000..214c1b5
--- /dev/null
+++ b/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))))])))
diff --git a/cover/private/codecov.rkt b/cover/private/codecov.rkt
new file mode 100644
index 0000000..89679cb
--- /dev/null
+++ b/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"))]))
diff --git a/cover/private/tests/not-run.rkt b/cover/private/tests/not-run.rkt
new file mode 100644
index 0000000..26917b0
--- /dev/null
+++ b/cover/private/tests/not-run.rkt
@@ -0,0 +1,2 @@
+#lang racket
+(if #f 10 2)
diff --git a/cover/private/travis-service.rkt b/cover/private/travis-service.rkt
new file mode 100644
index 0000000..6670853
--- /dev/null
+++ b/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")))))
diff --git a/info.rkt b/info.rkt
index e0cdbbb..3a0bd87 100644
--- a/info.rkt
+++ b/info.rkt
@@ -7,7 +7,6 @@
 
 (define deps '(
   ("base" #:version "6.1.1")
-  "envy"
   "cover"))
 
 (define build-deps '("rackunit-lib"))