Megatest

;;======================================================================
;; T E S T S
;;======================================================================


;; Test browser
(define (dashboard:tree-browser data adat window-id)
  ;; (iup:split
  (let* ((tb      (iup:treebox
		   #:selection-cb
		   (lambda (obj id state)
		     ;; (print "obj: " obj ", id: " id ", state: " state)
		     (let* ((tree-path (tree:node->path obj id))
			    (area      (car tree-path))

;;======================================================================
;; R U N   C O N T R O L
;;======================================================================

;; General displayer
;;
(define (dashboard:area-display data adat window-id)
  (let* ((view-matrix     (iup:matrix
			   #:expand "YES"
			   ;; #:fittosize "YES"
			   #:scrollbar "YES"
			   #:numcol 100
			   #:numlin 100
			   #:numcol-visible 3

;;======================================================================
;; D A S H B O A R D
;;======================================================================

;; Main Panel
;;
(define (dashboard:main-panel data window-id)
  (iup:dialog
   #:title "Megatest Control Panel"
   #:menu (dcommon:main-menu data)
   #:shrink "YES"
   (iup:vbox
    (let* ((area-names  (hash-table-keys (dboard:data-cfgdat data)))
	   (area-panels (map (lambda (aname)
			       (let* ((apath      (configf:lookup (dboard:data-cfgdat data) aname "path")) ;;  (hash-table-ref (dboard:data-cfgdat data) area-name))
				      ;;          (hash-table-ref (dboard:data-cfgdat data) aname))
				      (area-dat   (dashboard:init-area data aname apath))
				      (tb         (dashboard:tree-browser data area-dat window-id)) ;; (dboard:areas-tree-browser data)
				      (ad         (dashboard:area-display data area-dat window-id))
				      (areas      (dboard:data-areas data))
				      (dboard-dat (make-dboard:tab
						   #f           ;; tree
						   #f           ;; matrix
						   area-dat     ;;
						   #f           ;; view path
						   'default     ;; view type

						   #f           ;; controls
						   #f           ;; cached data
						   #f           ;; filters
						   #f           ;; the run-id
						   (make-hash-table) ;; run-id -> test-id, for current test id
						   ""
						   )))
				 (hash-table-set! (dboard:data-areas data) aname dboard-dat)
				 (dboard:tab-tree-set!   dboard-dat tb)
				 (dboard:tab-matrix-set! dboard-dat ad)
				 (iup:split
				  #:value 200
				  tb ad)))
			     area-names))
	   (tabtop      (apply iup:tabs  
			       #:tabchangepos-cb (lambda (obj curr prev)
						   (dboard:data-current-tab-id-set! data curr)
						   (dboard:data-update-needed-set!  data #t)
						   (print "Tab is: " curr ", prev was " prev))
			       area-panels))
	   (tab-ids     (dboard:data-tab-ids data)))
      (let loop ((index 0)
		 (hed   (car area-names))
		 (tal   (cdr area-names)))
	(hash-table-set! tab-ids index hed)
	(debug:print 0 "Adding area " hed " with index " index " to dashboard")
	(iup:attribute-set! tabtop (conc "TABTITLE" index) hed)
	(if (not (null? tal))
	    (loop (+ index 1)(car tal)(cdr tal))))
      tabtop))))

(define (newdashboard data window-id)
  (let* (;; (keys     (db:get-keys *dbstruct-local* *area-dat*))
	 ;; (runname  "%")
	 ;; (testpatt "%")
	 ;; (keypatts (map (lambda (k)(list k "%")) keys))
	 ;; (states   '())
	 ;; (statuses '())
	 (nextmintime (current-milliseconds)))
    (dboard:data-current-window-id-set! data (+ 1 (dboard:data-current-window-id data)))
    ;; (dboard:data-set-runs! *data* data) ;; make this data available to the rest of the application
    (iup:show (dashboard:main-panel data (dboard:data-current-window-id data)))
    ;; Yes, running iup:show will pop up a new panel
    ;; (iup:show (main-panel my-window-id))
    (iup:callback-set! *tim*
		       "ACTION_CB"
		       (lambda (x)
			 (let ((starttime (current-milliseconds)))
			   ;; Want to dedicate no more than 50% of the time to this so skip if

(let* ((window-id 0)
       (groupn    (or (args:get-arg "-group") "default"))
       (cfname    (conc (getenv "HOME") "/.megatest/" groupn ".dat"))
       (cfgdat    (if (file-exists? cfname)(read-config cfname (make-hash-table) #t)))
       (data      (make-dboard:data
		   cfgdat ;; this is the data from ~/.megatest for the selected group
		   (make-hash-table) ;; areaname -> area-rec
		   0                 ;; current window id
		   0                 ;; current tab id
		   #f                ;; redraw needed for current tab id
		   (make-hash-table) ;; tab-id -> areaname
		   )))
  (newdashboard data window-id)
  (iup:main-loop))

;; 
;; A single data structure for all the data used in a dashboard for
;; all areas tracked.
;;


(define-record dboard:data
  cfgdat             ;; data from ~/.megatest/<group>.dat
  areas              ;; hash of areaname -> area-rec
  current-window-id  ;; 
  current-tab-id     ;; 
  update-needed      ;; flag to indicate that the tab pointed to by current tab id needs refreshing immediately
  tab-ids            ;; hash of tab-id -> areaname
  )

(define-record dboard:tab
  tree
  matrix    ;; the spreadsheet 
  area-dat  ;; the one-structure (one day dbstruct will be put in here)
  view-path ;; <target/path>/<runname>/...
  view-type ;; standard, etc.

  controls  ;; the controls
  data      ;; all the data kept in sync with db
  filters   ;; user filters 
  run-id    ;; the current run-id
  test-ids  ;; the current test id hash, run-id => test-id
  command   ;; the command from the entry field
  )

;; TO-DO
;;  1. Make "data" hash-table hierarchial store of all displayed data
;;  2. Update synchash to understand "get-runs", "get-tests" etc.
;;  3. Add extraction of filters to synchash calls
;;
;; Mode is 'full or 'incremental for full refresh or incremental refresh
(define (dcommon:run-update data)
  (let* ((current-tab-id  (dboard:data-current-tab-id data))
	 (area-name       (hash-table-ref (dboard:data-tab-ids data) current-tab-id))
	 (tab-dat         (hash-table-ref (dboard:data-areas   data) area-name))
	 (matrix          (dboard:tab-matrix tab-dat))
	 (tree            (dboard:tab-tree   tab-dat))
	 (area-dat        (dboard:tab-area-dat tab-dat))
	 (runpatt         "%")) ;; get from dboard:tab-filters
    (if (dboard:data-update-needed data)
	(let* (;; count and offset => #f so not used
	       ;; the synchash calls modify the "data" hash
	       ;; (get-runs-sig    (conc (client:get-signature) " get-runs"))
	       ;; (get-tests-sig   (conc (client:get-signature) " get-tests"))
	       ;; (get-details-sig (conc (client:get-signature) " get-test-details"))
 
	       ;; test-ids to get and display are indexed on window-id in curr-test-ids hash
	       ;; (test-ids        (hash-table-values (dboard:data-get-curr-test-ids *data*)))
	       ;; run-id is #f in next line to send the query to server 0
	       ;; (run-changes     (synchash:client-get *area-dat* 'db:get-runs get-runs-sig (length keypatts) data #f runname #f #f keypatts))
	       ;; (tests-detail-changes (if (not (null? test-ids))
	       ;;				 (synchash:client-get *area-dat* 'db:get-test-info-by-ids get-details-sig 0  data #f test-ids)
	       ;;				 '()))
 
	       ;; Now can calculate the run-ids
	       ;; (run-hash    (hash-table-ref/default data get-runs-sig #f))
	       ;; (run-ids     (if run-hash (filter number? (hash-table-keys run-hash)) '()))
	       (launch:setup-for-run area-dat)
	       (all-runs-dat   (rmt:get-runs runpatt #f #f '() area-dat)))
	  (print "all-runs-dat: " all-runs-dat)))))

	       ;; (all-test-changes (let ((res (make-hash-table)))
	       ;;  		       (for-each (lambda (run-id)
	       ;;  			            (if (> run-id 0)
	       ;;  				        (hash-table-set! res run-id (synchash:client-get *area-dat* 'db:get-tests-for-run-mindata get-tests-sig 0 data run-id 1 testpatt states statuses #f))))
	       ;;  			                run-ids)
 	       ;;  	                          res))
	       ;; (runs-hash    (hash-table-ref/default data get-runs-sig #f))
	       ;; (header       (hash-table-ref/default runs-hash "header" #f))
	       ;; (run-ids      (sort (filter number? (hash-table-keys runs-hash))
	       ;;  		   (lambda (a b)
	       ;;  		     (let* ((record-a (hash-table-ref runs-hash a))
	       ;;  			    (record-b (hash-table-ref runs-hash b))
	       ;;  			    (time-a   (db:get-value-by-header record-a header "event_time"))
	       ;;  			    (time-b   (db:get-value-by-header record-b header "event_time")))
	       ;;  		       (> time-a time-b)))
	       ;;  		   ))
	       ;; (runid-to-col    (hash-table-ref *cachedata* "runid-to-col"))
	       ;; (testname-to-row (hash-table-ref *cachedata* "testname-to-row")) 
	       ;; (colnum       1)
	       ;; (rownum       0)) ;; rownum = 0 is the header
	       ;; ;; (debug:print 0 "test-ids " test-ids ", tests-detail-changes " tests-detail-changes)
	       ;;     
	       ;; 	 ;; tests related stuff
	       ;; 	 ;; (all-testnames (delete-duplicates (map db:test-get-testname test-changes))))
	       ;; 
	       ;;     ;; Given a run-id and testname/item_path calculate a cell R:C
	       ;; 
	       ;;     ;; NOTE: Also build the test tree browser and look up table
	       ;;     ;;
	       ;;     ;; Each run is unique on its keys and runname or run-id, store in hash on colnum
;;     (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 header key))
;; 					keys))
;; 		       (run-name   (db:get-value-by-header run-record header "runname"))
;; 		       (col-name   (conc (string-intersperse key-vals "\n") "\n" run-name))
;; 		       (run-path   (append key-vals (list run-name))))

(define (rmt:delete-run run-id area-dat)
  (rmt:send-receive 'delete-run run-id (list run-id) area-dat))

(define (rmt:delete-old-deleted-test-records area-dat)
  (rmt:send-receive 'delete-old-deleted-test-records #f '() area-dat))




(define (rmt:get-runs runpatt count offset keypatts area-dat)
  (rmt:send-receive 'get-runs #f (list runpatt count offset keypatts) area-dat))

(define (rmt:get-all-run-ids area-dat)
  (rmt:send-receive 'get-all-run-ids #f '() area-dat))

(define (rmt:get-prev-run-ids run-id area-dat)