123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106 |
- (use-modules (guix channels)
- (guix derivations)
- (guix git-download)
- (guix inferior)
- (guix packages)
- (guix store)
- (guix ui)
- ((guix ui) #:select (build-notifier))
- (ice-9 match)
- (ice-9 threads))
- (define %top-srcdir
- (and=> (assq-ref (current-source-location) 'filename)
- (lambda (file)
- (canonicalize-path
- (string-append (dirname file) "/../..")))))
- (match (command-line)
- ((command directory)
- (let ((real-build-things build-things))
- (with-store store
-
- (set-build-options store
- #:use-substitutes? #f
- #:substitute-urls '())
-
-
-
- (with-build-handler (build-notifier #:use-substitutes? #f)
-
-
- (let ((source (add-to-store store "guix-source" #t
- "sha256" %top-srcdir
- #:select? (git-predicate %top-srcdir))))
- (define instances
- (list (checkout->channel-instance source)))
- (define channels
- (map channel-instance-channel instances))
- (define derivation
-
- (run-with-store store
- (channel-instances->derivation instances)))
-
-
- (show-what-to-build store (list derivation))
- (build-derivations store (list derivation))
-
-
-
-
- (n-par-for-each
- (/ (current-processor-count) 2)
- (lambda (system)
- (with-store store
- (let ((inferior
- (open-inferior (derivation->output-path derivation)))
- (channels (map channel-instance->sexp instances)))
- (inferior-eval '(use-modules (gnu ci)) inferior)
- (let ((jobs
- (inferior-eval-with-store
- inferior store
- `(lambda (store)
- (cuirass-jobs store
- '((subset . all)
- (systems . ,(list system))
- (channels . ,channels))))))
- (file
- (string-append directory "/jobs-" system ".scm")))
- (call-with-output-file file
- (lambda (port)
- (write jobs port)))))))
- %cuirass-supported-systems))))))
- (x
- (format (current-error-port) "Wrong command: ~a~%." x)
- (exit 1)))
|