| ︙ | | | ︙ | |
84
85
86
87
88
89
90
91
92
93
94
95
96
97
|
"-v"
"-q"
"-use-local"
"-skip-version-check"
)
args:arg-hash
0))
(if (args:get-arg "-h")
(begin
(print help)
(exit)))
;; TODO: Move this inside (main)
|
>
>
>
>
>
|
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
|
"-v"
"-q"
"-use-local"
"-skip-version-check"
)
args:arg-hash
0))
(if (not (null? remargs))
(begin
(print "Unrecognised arguments: " (string-intersperse remargs " "))
(exit)))
(if (args:get-arg "-h")
(begin
(print help)
(exit)))
;; TODO: Move this inside (main)
|
| ︙ | | | ︙ | |
254
255
256
257
258
259
260
261
262
263
264
265
266
267
|
;; tests data
((num-tests 10) : number) ;; total number of tests to show (used in the old runs display)
;; runs tree
((path-run-ids (make-hash-table)) : hash-table) ;; path (target / runname) => id
(runs-tree #f)
;; tab data
((view-changed #t) : boolean)
((xadj 0) : number) ;; x slider number (if using canvas)
((yadj 0) : number) ;; y slider number (if using canvas)
;; runs-summary tab state
((runs-summary-modes '((one-run . "Show One Run") (xor-two-runs . "XOR Two Runs") (xor-two-runs-hide-clean . "XOR; Hide Clean")) ) : list)
|
>
|
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
|
;; tests data
((num-tests 10) : number) ;; total number of tests to show (used in the old runs display)
;; runs tree
((path-run-ids (make-hash-table)) : hash-table) ;; path (target / runname) => id
(runs-tree #f)
((runs-tree-ht (make-hash-table)) : hash-table) ;; track which targests added to tree (merge functionality with path-run-ids?)
;; tab data
((view-changed #t) : boolean)
((xadj 0) : number) ;; x slider number (if using canvas)
((yadj 0) : number) ;; y slider number (if using canvas)
;; runs-summary tab state
((runs-summary-modes '((one-run . "Show One Run") (xor-two-runs . "XOR Two Runs") (xor-two-runs-hide-clean . "XOR; Hide Clean")) ) : list)
|
| ︙ | | | ︙ | |
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
|
;; used by run-controls
;;
(define (dashboard:update-tree-selector tabdat #!key (action-proc #f))
(let* ((tb (dboard:tabdat-runs-tree tabdat))
(runconf-targs (common:get-runconfig-targets))
(db-target-dat (rmt:get-targets))
(header (vector-ref db-target-dat 0))
(db-targets (vector-ref db-target-dat 1))
(munge-target (lambda (x) ;; create a target vector from a string. Pad with na if needed.
(take (append (string-split x "/")
(make-list (length header) "na"))
(length header))))
(all-targets (append (list (munge-target (string-intersperse
(map (lambda (x) "%") header)
"/")))
(map vector->list db-targets)
(map munge-target
runconf-targs)
)))
(for-each
(lambda (target)
(tree:add-node tb "Runs" target)) ;; (append key-vals (list run-name))
all-targets)))
;; Run controls panel
;;
(define (dashboard:run-controls commondat tabdat #!key (tab-num #f))
(let* ((targets (make-hash-table))
(test-records (make-hash-table))
|
>
>
>
>
>
|
>
|
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
|
;; used by run-controls
;;
(define (dashboard:update-tree-selector tabdat #!key (action-proc #f))
(let* ((tb (dboard:tabdat-runs-tree tabdat))
(runconf-targs (common:get-runconfig-targets))
(db-target-dat (rmt:get-targets))
(runs-tree-ht (dboard:tabdat-runs-tree-ht tabdat))
(header (vector-ref db-target-dat 0))
(db-targets (vector-ref db-target-dat 1))
(munge-target (lambda (x) ;; create a target vector from a string. Pad with na if needed.
(take (append (string-split x "/")
(make-list (length header) "na"))
(length header))))
(all-targets (append (list (munge-target (string-intersperse
(map (lambda (x) "%") header)
"/")))
(map vector->list db-targets)
(map munge-target
runconf-targs)
)))
(for-each
(lambda (target)
(if (not (hash-table-ref/default runs-tree-ht target #f))
;; (let ((existing (tree:find-node tb target)))
;; (if (not existing)
(begin
(tree:add-node tb "Runs" target) ;; (append key-vals (list run-name))
(hash-table-set! runs-tree-ht target #t))))
all-targets)))
;; Run controls panel
;;
(define (dashboard:run-controls commondat tabdat #!key (tab-num #f))
(let* ((targets (make-hash-table))
(test-records (make-hash-table))
|
| ︙ | | | ︙ | |
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
|
))
(tb
(iup:treebox
#:value 0
#:name "Runs"
#:expand "YES"
#:addexpanded "NO"
#:selection-cb
(lambda (obj id state)
(debug:catch-and-dump
(lambda ()
(let* ((run-path (tree:node->path obj id))
(run-id (tree-path->run-id tabdat (cdr run-path))))
;; (dboard:tabdat-view-changed-set! tabdat #t) ;; ?? done below when run-id is a number
|
>
|
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
|
))
(tb
(iup:treebox
#:value 0
#:name "Runs"
#:expand "YES"
#:addexpanded "NO"
#:size "10x"
#:selection-cb
(lambda (obj id state)
(debug:catch-and-dump
(lambda ()
(let* ((run-path (tree:node->path obj id))
(run-id (tree-path->run-id tabdat (cdr run-path))))
;; (dboard:tabdat-view-changed-set! tabdat #t) ;; ?? done below when run-id is a number
|
| ︙ | | | ︙ | |
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
|
(dboard:tabdat-last-runs-update-set! tabdat (- (current-seconds) 2))
(for-each (lambda (run-id)
(let* ((run-record (hash-table-ref/default runs-hash run-id #f))
(key-vals (map (lambda (key)(db:get-value-by-header run-record runs-header key))
(dboard:tabdat-keys tabdat)))
(run-name (db:get-value-by-header run-record runs-header "runname"))
(col-name (conc (string-intersperse key-vals "\n") "\n" run-name))
(run-path (append key-vals (list run-name)))
(existing (tree:find-node tb run-path)))
(if (not (hash-table-ref/default (dboard:tabdat-path-run-ids tabdat) run-path #f))
(begin
(hash-table-set! (dboard:tabdat-run-keys tabdat) run-id run-path)
;; (iup:attribute-set! (dboard:tabdat-runs-matrix tabdat)
;; (conc rownum ":" colnum) col-name)
;; (hash-table-set! runid-to-col run-id (list colnum run-record))
;; Here we update the tests treebox and tree keys
(tree:add-node tb "Runs" run-path ;; (append key-vals (list run-name))
userdata: (conc "run-id: " run-id))
(hash-table-set! (dboard:tabdat-path-run-ids tabdat) run-path run-id)
;; (set! colnum (+ colnum 1))
))))
|
|
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
|
(dboard:tabdat-last-runs-update-set! tabdat (- (current-seconds) 2))
(for-each (lambda (run-id)
(let* ((run-record (hash-table-ref/default runs-hash run-id #f))
(key-vals (map (lambda (key)(db:get-value-by-header run-record runs-header key))
(dboard:tabdat-keys tabdat)))
(run-name (db:get-value-by-header run-record runs-header "runname"))
(col-name (conc (string-intersperse key-vals "\n") "\n" run-name))
(run-path (append key-vals (list run-name))))
(if (not (hash-table-ref/default (dboard:tabdat-path-run-ids tabdat) run-path #f))
;; (let ((existing (tree:find-node tb run-path)))
;; (if (not existing)
(begin
(hash-table-set! (dboard:tabdat-run-keys tabdat) run-id run-path)
;; (iup:attribute-set! (dboard:tabdat-runs-matrix tabdat)
;; (conc rownum ":" colnum) col-name)
;; (hash-table-set! runid-to-col run-id (list colnum run-record))
;; Here we update the tests treebox and tree keys
(tree:add-node tb "Runs" run-path) ;; (append key-vals (list run-name))
;; userdata: (conc "run-id: " run-id))))
(hash-table-set! (dboard:tabdat-path-run-ids tabdat) run-path run-id)
;; (set! colnum (+ colnum 1))
))))
run-ids)))
(define (dashboard:tests-ht->tests-dat tests-ht)
(reverse
(sort
(hash-table-values tests-ht)
(lambda (a b)
|
| ︙ | | | ︙ | |
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
|
(for-each
(lambda (run-id)
(let* ((run-record (hash-table-ref/default runs-hash run-id #f))
(key-vals (map (lambda (key)(db:get-value-by-header run-record runs-header key))
(dboard:tabdat-keys tabdat)))
(run-name (db:get-value-by-header run-record runs-header "runname"))
(col-name (conc (string-intersperse key-vals "\n") "\n" run-name))
(run-path (append key-vals (list run-name)))
(existing (tree:find-node tb run-path)))
(if (not (hash-table-ref/default (dboard:tabdat-path-run-ids tabdat) run-path #f))
(begin
(hash-table-set! (dboard:tabdat-run-keys tabdat) run-id run-path)
;; Here we update the tests treebox and tree keys
(tree:add-node tb "Runs" run-path ;; (append key-vals (list run-name))
userdata: (conc "run-id: " run-id))
(hash-table-set! (dboard:tabdat-path-run-ids tabdat) run-path run-id)
;; (set! colnum (+ colnum 1))
))))
run-ids))
;; (print "Updating rundat")
(if (dboard:tabdat-keys tabdat) ;; have keys yet?
(let* ((num-keys (length (dboard:tabdat-keys tabdat)))
|
|
|
|
|
|
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
|
(for-each
(lambda (run-id)
(let* ((run-record (hash-table-ref/default runs-hash run-id #f))
(key-vals (map (lambda (key)(db:get-value-by-header run-record runs-header key))
(dboard:tabdat-keys tabdat)))
(run-name (db:get-value-by-header run-record runs-header "runname"))
(col-name (conc (string-intersperse key-vals "\n") "\n" run-name))
(run-path (append key-vals (list run-name))))
;; (existing (tree:find-node tb run-path)))
(if (not (hash-table-ref/default (dboard:tabdat-path-run-ids tabdat) run-path #f))
(begin
(hash-table-set! (dboard:tabdat-run-keys tabdat) run-id run-path)
;; Here we update the tests treebox and tree keys
(tree:add-node tb "Runs" run-path) ;; (append key-vals (list run-name))
;; userdata: (conc "run-id: " run-id))
(hash-table-set! (dboard:tabdat-path-run-ids tabdat) run-path run-id)
;; (set! colnum (+ colnum 1))
))))
run-ids))
;; (print "Updating rundat")
(if (dboard:tabdat-keys tabdat) ;; have keys yet?
(let* ((num-keys (length (dboard:tabdat-keys tabdat)))
|
| ︙ | | | ︙ | |