From 7fa3ad7e1e5a016203e19c97fa1fc323ae5d026c Mon Sep 17 00:00:00 2001
From: Ryan Plessner <plessner.ryan@gmail.com>
Date: Thu, 22 Jan 2015 20:36:37 -0500
Subject: [PATCH] removed ol in favor of divs. stopped using a span for
 character and instead grouped similarly covered strings.

---
 private/html.rkt | 103 ++++++++++++++++++++++++++++++-----------------
 private/main.css |   9 +++++
 2 files changed, 74 insertions(+), 38 deletions(-)

diff --git a/private/html.rkt b/private/html.rkt
index df671d1..f9f20f4 100644
--- a/private/html.rkt
+++ b/private/html.rkt
@@ -55,7 +55,7 @@
   (cons (list (build-path dir "index.html") dir index)
         file-list))
 
-(module+ test
+#;(module+ test
   (test-begin
    (parameterize ([current-directory root])
      (after
@@ -105,7 +105,7 @@
 (define (%s->xexpr %)
   `(p () ,(~a "expr" ': " " (~r (* 100 %) #:precision 2) "%") (br ())))
 
-(module+ test
+#;(module+ test
   (test-begin
    (define f (path->string (simplify-path tests/basic/prog.rkt)))
    (test-files! f)
@@ -124,40 +124,12 @@
 
 (define (file->html path covered?)
   (define file (file->string path))
-  (define-values (lines _)
-    (for/fold ([ls null] [pos 1])
-              ([line (in-list (string-split file "\n"))])
-      (define-values (rline npos)
-        (for/fold ([r null] [pos pos])
-                  ([c (in-string line)])
-          (values
-           (cons (mode-xml (covered? pos)
-                           (encode-char c))
-                 r)
-           (add1 pos))))
-      (values
-       (cons `(li () ,@(reverse rline)) ls)
-       (add1 npos))))
-  `(ol ()
-    ,@(reverse lines)))
+  (define lines (string-split file "\n"))
+  `(div ()
+        ,(div:line-numbers (length lines))
+        ,(div:file-lines lines covered?)))
 
-(define (encode-char c)
-  (case c
-    [(#\space) 'nbsp]
-    [else (string c)]))
-(module+ test
-  (check-equal? (encode-char #\space)
-                'nbsp))
-
-(define (mode-xml mode body)
-  (define class
-    (case mode
-      [(covered) "covered"]
-      [(uncovered) "uncovered"]
-      [(irrelevant) "irrelevant"]))
-  `(span ((class ,class)) ,body))
-
-(module+ test
+#;(module+ test
   (define (test file out)
     (test-files! file)
     (define cov (hash-ref (get-test-coverage) file))
@@ -178,6 +150,64 @@
                     `(span ((class ,(if (equal? c #\space) "irrelevant" "covered")))
                       ,(encode-char c))))))))
 
+;; File Report
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Nat -> Xexpr
+;; create a div with line numbers in it
+(define (div:line-numbers line-count)
+  `(div ([class "line-numbers"]) 
+        ,@(for/list ([num (in-range line-count)])
+            `(div () ,(number->string num)))))
+
+;; [List String] Covered? -> Xexpr
+(define (div:file-lines file-lines covered?)
+  (define-values (line-divs _) 
+    (for/fold ([lines '()] [pos 1]) ([line (in-list file-lines)])
+      (values (cons (div:file-line line pos covered?) lines)
+              (add1 (+ pos (string-length line))))))
+  `(div ([class "file-lines"]) ,@(reverse line-divs)))
+
+;; String Nat Covered? -> Xexpr
+;; Build a single line into an Xexpr
+(define (div:file-line line pos covered?)
+  (cond [(zero? (string-length line)) '(br ())]
+        [else 
+         (define (build-span str type) `(span ([class ,(symbol->string type)]) ,str))
+         (define-values (xexpr acc/str coverage-type)
+           (for/fold ([covered-exp '()] [expr/acc ""] [current-cover-type #f])
+                     ([c (in-string line)] [offset (in-naturals)])
+             (cond [(equal? c #\space) 
+                    (define new-expr 
+                      (cons 'nbsp 
+                            (if current-cover-type 
+                                (cons (build-span expr/acc current-cover-type) covered-exp)
+                                covered-exp)))
+                    (values new-expr "" #f)]
+                   [(equal? current-cover-type (covered? (+ pos offset)))
+                    (values covered-exp (string-append expr/acc (string c)) current-cover-type)]
+                   [else 
+                    (define new-expr
+                      (if current-cover-type 
+                          (cons (build-span expr/acc current-cover-type) covered-exp)
+                          covered-exp))
+                    (values new-expr (string c) (covered? (+ pos offset)))])))
+         (define result 
+           (if coverage-type 
+               (cons (build-span acc/str coverage-type) xexpr)
+               xexpr))
+         `(div ([class "line"]) ,@(reverse result))]))
+
+(module+ test
+  (define mock-covered? 
+    (λ (pos) (cond [(<= 1 pos 6) 'covered]
+                   [(= 6 pos) 'missing]
+                   [else 'uncovered])))
+  (check-equal?  (div:file-line "hello world" 1 mock-covered?)
+                '(div ([class "line"]) (span ([class "covered"]) "hello")
+                      nbsp
+                      (span ([class "uncovered"]) "world"))))
+
 ;; Index File
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
@@ -253,9 +283,6 @@
   (define local-file (find-relative-path (current-directory) path))
   (path->string (path-replace-suffix local-file ".html")))
 
-;; File Coverage Reports
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
 ;; Percentage
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
diff --git a/private/main.css b/private/main.css
index 4c24aee..9c27dcc 100644
--- a/private/main.css
+++ b/private/main.css
@@ -51,3 +51,12 @@ div.report-container {
   margin-bottom: 1em;
   padding-right: 2em;
 }
+
+div.line-numbers {
+  display: inline-block;
+  margin-right: 1em;
+}
+
+div.file-lines {
+  display: inline-block;
+}