19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
|
(vector-ref (car curr-trec) 1) #f))
(all-parts (if curr-ttype (append (string-split curr-ttype "/") '("runname" "testname")) '()))
(tfilter (or (s:session-var-get "target-filter") "%"))
(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:session-var-get "row-or-col") "") ","))
(all-data (pgdb:get-stats-given-target dbh tfilter))
;; (all-data (pgdb:get-tests dbh tfilter))
(ordered-data (pgdb:coalesce-runs dbh all-data all-parts row-or-col)))
(list
"<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">"
(s:html
(s:title (conc "Megatest"))
(s:head
index:kickstart-junk
)
(s:body
;; (s:session-var-get "target-type")
;; (conc " selected = " selected ", ttypes = " ttypes ", curr-ttype = " curr-ttype ", curr-trec = " curr-trec)
(conc (hash-table->alist ordered-data))
(s:div 'class "grid flex" 'id "top_of_page"
;; add visible to columns to help visualize them e.g. "col_12 visible"
;; BEGINNING OF HEADER
(s:div 'class "col_12"
(s:fieldset
"Area type and target filter"
(s:form
|
|
>
|
|
|
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
|
(vector-ref (car curr-trec) 1) #f))
(all-parts (if curr-ttype (append (string-split curr-ttype "/") '("runname" "testname")) '()))
(tfilter (or (s:session-var-get "target-filter") "%"))
(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:session-var-get "row-or-col") "") ","))
(all-data (if selected (pgdb:get-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)))
(list
"<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">"
(s:html
(s:title (conc "Megatest"))
(s:head
index:kickstart-junk
)
(s:body
;; (s:session-var-get "target-type")
;; (conc " selected = " selected ", ttypes = " ttypes ", curr-ttype = " curr-ttype ", curr-trec = " curr-trec)
;; (conc (hash-table->alist ordered-data))
(s:div 'class "grid flex" 'id "top_of_page"
;; add visible to columns to help visualize them e.g. "col_12 visible"
;; BEGINNING OF HEADER
(s:div 'class "col_12"
(s:fieldset
"Area type and target filter"
(s:form
|
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
|
(list ttype tt-id ttype #f))))
ttypes)
'name 'target-type)
(s:input-preserve 'name "tfilter" 'placeholder "Filter targets")
(s:input 'type "submit" 'name "set-filter-vals" 'value "Submit" 'class "col_3"))
;; 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:fieldset
(conc "Runs data for " tfilter)
;;
;; This is completely wrong!!! However it may provide some ideas!
(s:table
(map
(lambda (key)
(let ((subdat (hash-table-ref ordered-data key)))
(s:tr (s:td key)
(map
(lambda (remkey)
(s:td remkey
(let ((dat (hash-table-ref subdat remkey)))
(s:td (vector-ref dat 1) (vector-ref dat 0)))))
(sort (hash-table-keys subdat) string>=?)))))
(sort (hash-table-keys ordered-data) string>=?)))
;;(map (lambda (area)
;; (s:p "data=" (conc area)))
;; ;; (pgdb:get-tests dbh tfilter))
;; (pgdb:get-stats-given-target dbh tfilter))
index:jquery
index:javascript
))))))))
;; (s:div 'class "col_12"
;; (s:div 'class "col_1" "row")
;; (map (lambda (target-var)
;; (s:div 'class "col_1" (s:input 'type "radio" 'name target-var 'value "row")))
;; all-parts))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
<
>
>
>
>
>
>
>
>
>
>
|
>
|
|
|
|
|
|
<
|
>
|
|
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
|
|
|
|
|
|
|
|
|
|
|
|
|
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
|
(list ttype tt-id ttype #f))))
ttypes)
'name 'target-type)
(s:input-preserve 'name "tfilter" 'placeholder "Filter targets")
(s:input 'type "submit" 'name "set-filter-vals" 'value "Submit" 'class "col_3"))
;; 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:fieldset
(conc "Runs data for " tfilter)
;;
;; A very basic display
;;
(let* ((a-keys (sort (hash-table-keys ordered-data) string>=?))
(b-keys (sort (apply
append
(map (lambda (sub-key)
(let ((subdat (hash-table-ref ordered-data sub-key)))
(hash-table-keys subdat)))
a-keys))
string>=?)))
(if #f ;; swap rows/cols
(s:table
(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
(lambda (col-key)
(s:td (let ((dat (hash-table-ref/default subdat col-key #f)))
(s:td (if dat
(list (vector-ref dat 1) (vector-ref dat 0))
"")))))
b-keys))))
a-keys))
(s:table
(s:tr (s:td "")(map s:td a-keys))
(map
(lambda (row-key)
(s:tr (s:td row-key)
(map
(lambda (col-key)
(let ((val (let* ((ht (hash-table-ref/default ordered-data col-key #f)))
(if ht (hash-table-ref/default ht row-key #f)))))
(if val
(let* ((total (vector-ref val 1))
(pass (vector-ref val 2))
(fail (vector-ref val 3))
(other (vector-ref val 4))
(passper (round (* (/ pass total) 100)))
(failper (- 100 passper)))
(s:td 'style (conc "background: linear-gradient(to right, green " passper "%, red " failper "%);")
(conc total "/" pass "/" fail "/" other)))
(s:td ""))))
a-keys)))
b-keys))))))
;;(map (lambda (area)
;; (s:p "data=" (conc area)))
;; ;; (pgdb:get-tests dbh tfilter))
;; (pgdb:get-stats-given-target dbh tfilter))
index:jquery
index:javascript
))))))
;; (s:div 'class "col_12"
;; (s:div 'class "col_1" "row")
;; (map (lambda (target-var)
;; (s:div 'class "col_1" (s:input 'type "radio" 'name target-var 'value "row")))
;; all-parts))
|