hydra: 'evaluate' now validates job alists.
* build-aux/hydra/evaluate.scm (assert-valid-job): New procedure. <top level>: Use it.
This commit is contained in:
		
							parent
							
								
									9270298f75
								
							
						
					
					
						commit
						4c9243b688
					
				
					 1 changed files with 14 additions and 1 deletions
				
			
		| 
						 | 
					@ -49,6 +49,17 @@ values."
 | 
				
			||||||
                 (/ (time-nanosecond time) 1e9)))
 | 
					                 (/ (time-nanosecond time) 1e9)))
 | 
				
			||||||
      (apply values results))))
 | 
					      (apply values results))))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					(define (assert-valid-job job thing)
 | 
				
			||||||
 | 
					  "Raise an error if THING is not an alist with a valid 'derivation' entry.
 | 
				
			||||||
 | 
					Otherwise return THING."
 | 
				
			||||||
 | 
					  (unless (and (list? thing)
 | 
				
			||||||
 | 
					               (and=> (assoc-ref thing 'derivation)
 | 
				
			||||||
 | 
					                      (lambda (value)
 | 
				
			||||||
 | 
					                        (and (string? value)
 | 
				
			||||||
 | 
					                             (string-suffix? ".drv" value)))))
 | 
				
			||||||
 | 
					    (error "job did not produce a valid alist" job thing))
 | 
				
			||||||
 | 
					  thing)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					
 | 
				
			||||||
;; Without further ado...
 | 
					;; Without further ado...
 | 
				
			||||||
(match (command-line)
 | 
					(match (command-line)
 | 
				
			||||||
| 
						 | 
					@ -83,7 +94,9 @@ values."
 | 
				
			||||||
           (map (lambda (job thunk)
 | 
					           (map (lambda (job thunk)
 | 
				
			||||||
                  (format (current-error-port) "evaluating '~a'... " job)
 | 
					                  (format (current-error-port) "evaluating '~a'... " job)
 | 
				
			||||||
                  (force-output (current-error-port))
 | 
					                  (force-output (current-error-port))
 | 
				
			||||||
                  (cons job (call-with-time-display thunk)))
 | 
					                  (cons job
 | 
				
			||||||
 | 
					                        (assert-valid-job job
 | 
				
			||||||
 | 
					                                          (call-with-time-display thunk))))
 | 
				
			||||||
                names thunks)))
 | 
					                names thunks)))
 | 
				
			||||||
        port))))
 | 
					        port))))
 | 
				
			||||||
  ((command _ ...)
 | 
					  ((command _ ...)
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Reference in a new issue