1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192 |
- (use-modules (guix store)
- (guix config)
- (guix utils)
- ((guix packages) #:select (%hydra-supported-systems))
- (guix derivations)
- (guix monads)
- ((guix licenses) #:prefix license:)
- (srfi srfi-1)
- (ice-9 match))
- (setvbuf (current-error-port) 'line)
- (set-current-output-port (current-error-port))
- (define* (build-job store source version system)
- "Return a Hydra job a list building the modular Guix derivation from SOURCE
- for SYSTEM. Use VERSION as the version identifier."
- (lambda ()
- (define build
- (primitive-load (string-append source "/build-aux/build-self.scm")))
- (let ((drv (run-with-store store
- (build source #:version version #:system system
- #:pull-version 1
- #:guile-version "2.2"))))
- `((derivation . ,(derivation-file-name drv))
- (log . ,(log-file store (derivation-file-name drv)))
- (outputs . ,(filter-map (lambda (res)
- (match res
- ((name . path)
- `(,name . ,path))))
- (derivation->output-paths drv)))
- (nix-name . ,(derivation-name drv))
- (system . ,(derivation-system drv))
- (description . "Modular Guix")
- (long-description
- . "This is the modular Guix package as produced by 'guix pull'.")
- (license . ,license:gpl3+)
- (home-page . ,%guix-home-page-url)
- (maintainers . (,%guix-bug-report-address))))))
- (define (hydra-jobs store arguments)
- "Return Hydra jobs."
- (define systems
- (match (assoc-ref arguments 'systems)
- (#f %hydra-supported-systems)
- ((lst ...) lst)
- ((? string? str) (call-with-input-string str read))))
- (define guix-checkout
- (or (assq-ref arguments 'guix)
- (assq-ref arguments 'guix-modular)))
- (define version
- (or (assq-ref guix-checkout 'revision)
- "0.unknown"))
- (let ((file (assq-ref guix-checkout 'file-name)))
- (format (current-error-port) "using checkout ~s (~s; arguments: ~s)~%"
- guix-checkout file arguments)
- (map (lambda (system)
- (let ((name (string->symbol
- (string-append "guix." system))))
- `(,name
- . ,(build-job store file version system))))
- systems)))
|