Index: cgisetup/pages/home_ctrl.scm ================================================================== --- cgisetup/pages/home_ctrl.scm +++ cgisetup/pages/home_ctrl.scm @@ -25,7 +25,16 @@ (string-intersperse row-or-col ",") row-or-col)) (s:set! "target-type" target-type) (s:set! "tfilter" target-filter) (s:set! "target" target) - (s:set! "target-filter" target-filter))))) + (s:set! "target-filter" target-filter))) +((filter2) + (let ((tslice-select (s:get-input 'tslice-select)) + (t-slice-filter (s:get-input 't-slice-filter))) + ;; + ;; s:set! is a page local var. Better than s:session-var-set! but still not a good idea. + ;; + (s:set! "tslice" tslice-select) + (s:set! "t-slice-patt" t-slice-filter))) +)) Index: cgisetup/pages/home_view.scm ================================================================== --- cgisetup/pages/home_view.scm +++ cgisetup/pages/home_view.scm @@ -10,31 +10,95 @@ ;;====================================================================== (define (pages:home session db shared) (let* ((dbh (s:db)) (ttypes (pgdb:get-target-types dbh)) + (target-slice (pgdb:get-distict-target-slice dbh)) (selected (string->number (or (s:get "target-type") "0"))) + (selected-slice (or (s:get "tslice") "")) (curr-trec (filter (lambda (x)(eq? selected (vector-ref x 0))) ttypes)) (curr-ttype (if (and selected (not (null? curr-trec))) (vector-ref (car curr-trec) 1) #f)) (all-parts (if curr-ttype (append (string-split curr-ttype "/") '("runname" "testname")) '())) (tfilter (or (s:get "target-filter") "%")) + (tslice-filter (or (s:get "t-slice-patt") "")) + (target-patt (if (or (equal? selected-slice "") (equal? tslice-filter "" )) + "" + (conc selected-slice "/" tslice-filter ))) + (tab2-data (if (equal? target-patt "") + `() + (pgdb:get-all-run-stats-target-slice dbh target-patt))) + (tab2-ordered-data (pgdb:coalesce-runs-by-slice tab2-data selected-slice)) (targets (pgdb:get-targets-of-type dbh selected tfilter)) - ;; (target (s:session-var-get "target")) - ;; (target-patt (or target "%")) (row-or-col (string-split (or (s:get "row-or-col") "") ",")) - (all-data (if selected (pgdb:get-stats-given-target dbh selected tfilter) + (all-data (if selected (pgdb:get-latest-run-stats-given-target dbh selected tfilter) '())) - ;; (all-data (pgdb:get-tests dbh tfilter)) (ordered-data (pgdb:coalesce-runs dbh all-data all-parts row-or-col 0))) - - (s:div 'class "col_12" - (s:fieldset - "Area type and target filter" + (s:div 'class "col_12" + (s:ul 'class "tabs left" + (s:li (s:a 'href "#tabr1" "Sliced Filter")) + (s:li (s:a 'href "#tabr2" "Genral Filter"))) + (s:div 'id "tabr1" 'class "tab-content" + (s:div 'class "col_11" + (s:fieldset "Filter Targets by slice" + (s:form + 'action "home.filter2" 'method "post" + (s:div 'class "col_12" + (s:div 'class "col_6" + (s:select (map (lambda (x) + (let ((t-slice (vector-ref x 0))) + (if (equal? t-slice selected-slice) + (list t-slice t-slice t-slice #t) + (list t-slice t-slice t-slice #f)))) + target-slice) + 'name 'tslice-select)) + (s:div 'class "col_4" + (s:input-preserve 'name "t-slice-filter" 'placeholder "Filter remainder target")) + (s:div 'class "col_2" + (s:input 'type "submit" 'name "set-filter-vals" 'value "Submit"))))) + (s:br) + (s:p "  Result Format:   total / pass / fail / other") + (s:fieldset (conc "Runs data for " target-patt) + (let* ((target-keys (hash-table-keys tab2-ordered-data)) + (run-keys (delete-duplicates (apply append (map (lambda (sub-key) + (let ((subdat (hash-table-ref tab2-ordered-data sub-key))) + (hash-table-keys subdat))) + target-keys))))) + (s:table 'class "striped" + (s:tr (s:th 'class "heading" ) + (map + (lambda (th-key) + (s:th 'class "heading" th-key )) + run-keys)) + (map + (lambda (row-key) + (s:tr (s:td row-key) + (map + (lambda (col-key) + (let ((val (let* ((ht (hash-table-ref/default tab2-ordered-data row-key #f))) + (if ht (hash-table-ref/default ht col-key #f))))) + (if val + (let* ((total (vector-ref val 3)) + (pass (vector-ref val 4)) + (fail (vector-ref val 5)) + (other (vector-ref val 6)) + (passper (round (* (/ pass total) 100))) + (target-param (string-substitute "[/]" "_x_" (conc selected-slice "/" row-key) 'all))) + (s:td 'style (conc "background: -webkit-linear-gradient(left, green " passper "%, red); background: -o-linear-gradient(right, green " passper "%, red); background: -moz-linear-gradient(right, green " passper "%, red); background: linear-gradient(to right, green " passper "%, red);") + (s:a 'class "white" 'href (s:link-to "run" 'target target-param 'run col-key) +(conc total "/" pass "/" fail "/" other)))) + (s:td "")))) + run-keys))) + target-keys)) +)) +)) + (s:div 'id "tabr2" 'class "tab-content" + (s:div 'class "col_11" + (s:fieldset "Area type and target filter" (s:form - 'action "home.filter" 'method "get" + 'action "home.filter#tabr2" 'method "post" (s:div 'class "col_12" (s:div 'class "col_6" (s:select (map (lambda (x) (let ((tt-id (vector-ref x 0)) (ttype (vector-ref x 1))) @@ -44,47 +108,26 @@ ttypes) 'name 'target-type)) (s:div 'class "col_4" (s:input-preserve 'name "tfilter" 'placeholder "Filter targets")) (s:div 'class "col_2" - (s:input 'type "submit" 'name "set-filter-vals" 'value "Submit"))) - ;; use radio buttons to select whether to put this identifier in row or column. - ;; this seems clumsly and takes up a lot of screen realestate - ;; (s:div 'class "col_12" - ;; (s:div 'class "col_1" "identifier") - ;; (map (lambda (target-var) - ;; (s:div 'class "col_1" target-var)) - ;; all-parts)) - ;; (s:div 'class "col_12" - ;; (s:div 'class "col_1" "row") - ;; (map (lambda (target-var) - ;; (s:div 'class "col_1" (s:input 'type "checkbox" 'name "row-or-col" 'value target-var - ;; ;; this silly trick preserves the checkmark - ;; (if (member target-var row-or-col) 'checked "") - ;; ""))) - ;; all-parts)) - )) + (s:input 'type "submit" 'name "set-filter-vals" 'value "Submit"))))) (s:br) (s:p "  Result Format:   total / pass / fail / other") - - (s:fieldset - (conc "Runs data for " tfilter) + (s:fieldset (conc "Runs data for " tfilter) ;; ;; A very basic display ;; (let* ((a-keys (sort (hash-table-keys ordered-data) string>=?)) - (b-keys (delete-duplicates(sort (apply - append - (map (lambda (sub-key) + (b-keys (delete-duplicates(sort (apply append (map (lambda (sub-key) (let ((subdat (hash-table-ref ordered-data sub-key))) (hash-table-keys subdat))) a-keys)) string>=?)))) - ; (c-keys (delete-duplicates b-keys))) - (if #f ;; swap rows/cols + (if #f ;; swap rows/cols (s:table - (s:tr (s:td "")(map s:tr b-keys)) + (s:tr (s:td "")(map s:tr b-keys)) (map (lambda (row-key) (let ((subdat (hash-table-ref ordered-data row-key))) (s:tr (s:td row-key) (map @@ -93,13 +136,16 @@ (s:td (if dat (list (vector-ref dat 0)(vector-ref dat 1)) ""))))) b-keys)))) a-keys)) - - (s:table - (s:tr (s:td "")(map s:td a-keys)) + (s:table 'class "striped" + (s:tr (s:th 'class "heading" ) + (map + (lambda (th-key) + (s:th 'class "heading" th-key )) + a-keys)) (map (lambda (row-key) (s:tr (s:td row-key) (map (lambda (col-key) @@ -108,19 +154,44 @@ (if val (let* ((total (vector-ref val 1)) (pass (vector-ref val 2)) (fail (vector-ref val 3)) (other (vector-ref val 4)) + (id (vector-ref val 5)) (passper (round (* (/ pass total) 100))) (failper (- 100 passper)) - (run-key ;; (string-substitute ;; %2F = / - ;; "-" "%2D" - ;;(string-substitute "/" "%2F" (conc col-key "/" row-key) 'all) - (string-substitute "[/]" "_x_" (conc col-key "/" row-key) 'all) - ;; 'all))) - )) + (history (pgdb:get-run-stats-history-given-target dbh selected (conc col-key "/" row-key))) + (history-hash (pgdb:get-history-hash history)) + (history-keys (sort (hash-table-keys history-hash) string>=?)) + (run-key (string-substitute "[/]" "_x_" (conc col-key "/" row-key) 'all))) (s:td 'style (conc "background: -webkit-linear-gradient(left, green " passper "%, red); background: -o-linear-gradient(right, green " passper "%, red); background: -moz-linear-gradient(right, green " passper "%, red); background: linear-gradient(to right, green " passper "%, red);") - (s:a 'href (s:link-to "run" 'target run-key) - (conc total "/" pass "/" fail "/" other)))) + (s:a 'class "white" 'href (s:link-to "run" 'target run-key) + (conc "Latest:" total "/" pass "/" fail "/" other)) (s:span " | ") (s:a 'id id 'class "viewmodal" 'title "Click to see description" "History") (s:br) + (s:div 'id (conc "myModal" id) 'class "modal" + (s:div 'class "modal-content" + (s:span 'id id 'class "close" "×") + ;(s:p (conc "Modal " id "..")) + (s:div + (s:table + (s:tr + (s:th "Runame") + (s:th "Result") + ) + (map + (lambda (history-key) + (let* ((history-row (hash-table-ref/default history-hash history-key #f)) + (htotal (vector-ref history-row 1)) + (hpass (vector-ref history-row 2)) + (hfail (vector-ref history-row 3)) + (hother (vector-ref history-row 4)) + (passper (round (* (/ hpass htotal) 100)))) + (s:tr (s:td history-key) + (s:td 'style (conc "background: -webkit-linear-gradient(left, green " passper "%, red); background: -o-linear-gradient(right, green " passper "%, red); background: -moz-linear-gradient(right, green " passper "%, red); background: linear-gradient(to right, green " passper "%, red);") +(conc htotal "/" hpass "/" hfail "/" hother ))))) + history-keys))) + +)) + )) (s:td "")))) a-keys))) - b-keys)))))))) + b-keys))))))) +))) Index: cgisetup/pages/index_ctrl.scm ================================================================== --- cgisetup/pages/index_ctrl.scm +++ cgisetup/pages/index_ctrl.scm @@ -26,17 +26,25 @@ + EOF ) @@ -56,8 +64,9 @@ (define index:javascript #< + EOF ) Index: cgisetup/pages/run_view.scm ================================================================== --- cgisetup/pages/run_view.scm +++ cgisetup/pages/run_view.scm @@ -15,12 +15,13 @@ (s:get "target") (s:get-param 'target))) (target (if (equal? target1 #f) "%" (string-substitute "_x_" "/" target1 'all) - )) - (run-filter (or (s:get "run-name-filter") "%")) + )) + + (run-filter (or (or (s:get "run-name-filter") (s:get-param 'run)) "%")) (runs (pgdb:get-runs-by-target dbh target run-filter)) (ordered-runs (pgdb:runs-to-hash runs))) (s:div 'class "col_12" (s:fieldset @@ -64,11 +65,11 @@ (test-id (vector-ref val 4)) (bg (if (equal? result "PASS") "green" "red"))) (s:td 'style (conc "background: " bg ) - (s:a 'href (s:link-to "log" 'testid test-id) + (s:a 'class "white" 'href (s:link-to "log" 'testid test-id) result))) (s:td "")))) a-keys))) b-keys)))))))