feat: Add cross profile package support Supports cross profile with the default target packages from gnu-build-system. Accepts inputs, native-inputs or inputs-from where the inputs are taken out of the package. What remains is to think of a way to support arbitrary build system, possibly via bags. As a first proof of concept, the build system could be matched and packages hardcoded for each of them... then the inputs can be taken when inputs-from is used, or one could make a list of build systems to include in a new field.
1 files changed, 176 insertions(+), 0 deletions(-) A modules/cross-shells/cross-profile.scm
A modules/cross-shells/cross-profile.scm => modules/cross-shells/cross-profile.scm +176 -0
@@ 0,0 1,176 @@ (define-module (cross-shells cross-profile) #:use-module (srfi srfi-1) #:use-module (cross-shells cross-packages) #:use-module (guix gexp) #:use-module (guix packages) #:use-module (guix records) #:use-module (guix search-paths) #:use-module (gnu packages commencement) #:use-module (guix build-system gnu) #:use-module (guix build-system trivial) #:export (make-cross-profile cross-profile cross-profile? cross-profile-name cross-profile-host-system cross-profile-target-system cross-profile-native-inputs cross-profile-inputs cross-profile-inputs-from %cross-profile-default-base-native-inputs %cross-profile-default-base-inputs make-cross-profile-package collect-cross-profile-native-inputs collect-cross-profile-target-inputs collect-cross-profile-search-paths)) ;; TODO: allow procedure in native-inputs and inputs ;; takes system and target (define (%cross-profile-default-base-native-inputs system target) (append (standard-packages system) (standard-cross-packages target 'host))) (define (%cross-profile-default-base-inputs system target) (list)) (define (%cross-profile-default-base-target-inputs system target) (standard-cross-packages target 'target)) (define-record-type* <cross-profile> cross-profile make-cross-profile cross-profile? (name cross-profile-name (default "default")) (host-system cross-profile-host-system (default (%current-system))) (target-system cross-profile-target-system) ;; The default native inputs and inputs. Those are ;; taken out of the gnu-build-system. (base-native-inputs cross-profile-base-native-inputs (default %cross-profile-default-base-native-inputs)) (base-target-inputs cross-profile-base-target-inputs (default %cross-profile-default-base-target-inputs)) (base-inputs cross-profile-base-inputs (default %cross-profile-default-base-inputs)) ;; The inputs that are runnable on the host system (native-inputs cross-profile-native-inputs (default '())) ;; The packages to get for the target system, like libraries. (inputs cross-profile-inputs (default '())) ;; The packages to get for the target system, like libraries. (target-inputs cross-profile-target-inputs (default '())) ;; Take inputs/native-inputs from the given packages. (inputs-from cross-profile-inputs-from (default '()))) (define transitive-inputs (@@ (guix packages) transitive-inputs)) (define (collect-cross-profile-target-inputs cross-profile) ;; Get all inputs (merged inputs and inputs-from inputs) ;; Also collect propagated inputs. Make sure only unique packages. ;; NOTE look how profiles work (match-record cross-profile <cross-profile> (target-inputs base-target-inputs host-system target-system) (map (lambda (input) (car (cdr input))) (transitive-inputs (append (base-target-inputs host-system target-system) target-inputs))))) (define (collect-cross-profile-inputs cross-profile) ;; Get all inputs (merged inputs and inputs-from inputs) ;; Also collect propagated inputs. Make sure only unique packages. ;; NOTE look how profiles work (match-record cross-profile <cross-profile> (inputs inputs-from base-inputs host-system target-system) (map (lambda (input) (if (package? input) input (car (cdr input)))) (transitive-inputs (append (base-inputs host-system target-system) (apply append (map package-inputs inputs-from)) inputs))))) (define (collect-cross-profile-native-inputs cross-profile) ;; Get all nativeinputs (merged native-inputs and inputs-from native-inputs) (match-record cross-profile <cross-profile> (native-inputs inputs-from base-native-inputs host-system target-system) (map (lambda (input) (car (cdr input))) (transitive-inputs (append (base-native-inputs host-system target-system) (apply append (map package-native-inputs inputs-from)) native-inputs))))) (define (collect-cross-profile-search-paths cross-profile) (match-record cross-profile <cross-profile> (name target-system) (apply append (append (append (map package-native-search-paths (collect-cross-profile-native-inputs cross-profile))) (append (map (lambda (package) (map (lambda (search-path) (search-path-specification (inherit search-path) (files (map (lambda (file) (string-append "cross/" target-system "/" name "/" file)) (search-path-specification-files search-path))))) (package-search-paths package))) (append (collect-cross-profile-target-inputs cross-profile) (collect-cross-profile-inputs cross-profile)))))))) ;; output is a package. ;; but this package is sort of like a profile. ;; it will have all files under cross/{target}. ;; it will put all accumulated search-paths to native-search-paths ;; Takes a cross-profile, and outputs a package that represents the cross profile (define (make-cross-profile-package cross-profile) (match-record cross-profile <cross-profile> (name host-system target-system native-inputs inputs inputs-from) (let ((cross-profile-name name)) (package (name (string-append "cross-profile-" name)) (source #f) (version "0") (build-system trivial-build-system) (native-search-paths ;; collect search paths of all inputs (collect-cross-profile-search-paths cross-profile)) (arguments (list #:modules '((guix build utils) (guix build union)) #:builder #~(begin (use-modules (guix build utils) (guix build union)) (let ((inputs-paths (list #$@(collect-cross-profile-target-inputs cross-profile) #$@(map (lambda (package) (cross-package-job (package package) (target target-system) (system host-system))) (collect-cross-profile-inputs cross-profile)))) (cross-profile-path (string-append #$output "/cross/" #$target-system "/" #$cross-profile-name)) (native-inputs-paths (list #$@(collect-cross-profile-native-inputs cross-profile)))) (union-build #$output native-inputs-paths) (mkdir-p (dirname cross-profile-path)) (union-build cross-profile-path inputs-paths))))) (synopsis "A cross profile package") (description "A cross profile package") (home-page #f) (license #f)))))