Lispln/nonguix
1
0
Fork 0
mirror of https://gitlab.com/nonguix/nonguix.git synced 2024-12-24 07:44:52 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

nonguix: Update binary build system to return a monadic procedure.

Browse source 
Fixes https://gitlab.com/nonguix/nonguix/-/issues/146.

* nonguix/build-system/binary.scm (binary-build): Update it.

Signed-off-by: Jonathan Brielmaier <jonathan.brielmaier@web.de>
This commit is contained in:
Josselin Poiret 2021-11-11 15:14:40 +00:00 committed by Jonathan Brielmaier
parent 01608562fb
commit 7b13acb514
No known key found for this signature in database
GPG key ID: ECFC83988B4E4B9F
1 changed files with 38 additions and 40 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

72
nonguix/build-system/binary.scm
View file

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Julien Lepiller <julien@lepiller.eu> ;;; Copyright © 2019 Julien Lepiller <julien@lepiller.eu>
;;; Copyright © 2021 Josselin Poiret <dev@jpoiret.xyz>
;;; ;;;
;;; This file is not part of GNU Guix. ;;; This file is not part of GNU Guix.
;;; ;;;
@ -19,6 +20,8 @@
(define-module (nonguix build-system binary) (define-module (nonguix build-system binary)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (guix derivations) #:use-module (guix derivations)
#:use-module (guix search-paths) #:use-module (guix search-paths)
#:use-module (guix build-system) #:use-module (guix build-system)
@ -90,8 +93,9 @@
(build binary-build) (build binary-build)
(arguments (strip-keyword-arguments private-keywords arguments))))) (arguments (strip-keyword-arguments private-keywords arguments)))))
(define* (binary-build store name inputs (define* (binary-build name inputs
#:key (guile #f) #:key
guile source
(outputs '("out")) (outputs '("out"))
(patchelf-plan ''()) (patchelf-plan ''())
(install-plan ''(("." "./"))) (install-plan ''(("." "./")))
@ -109,49 +113,43 @@
(imported-modules %binary-build-system-modules) (imported-modules %binary-build-system-modules)
(modules '((nonguix build binary-build-system) (modules '((nonguix build binary-build-system)
(guix build utils) (guix build utils)
(nonguix build utils)))) (nonguix build utils)))
(substitutable? #t)
allowed-references
disallowed-references)
"Build SOURCE using PATCHELF, and with INPUTS. This assumes that SOURCE "Build SOURCE using PATCHELF, and with INPUTS. This assumes that SOURCE
provides its own binaries." provides its own binaries."
(define builder (define builder
`(begin (with-imported-modules imported-modules
(use-modules ,@modules) #~(begin
(binary-build #:source ,(match (assoc-ref inputs "source") (use-modules #$@modules)
(((? derivation? source))
(derivation->output-path source)) #$(with-build-variables inputs outputs
((source) #~(binary-build #:source #+source
source) #:system #$system
(source
source))
#:system ,system
#:outputs %outputs #:outputs %outputs
#:inputs %build-inputs #:inputs %build-inputs
#:patchelf-plan ,patchelf-plan #:patchelf-plan #$patchelf-plan
#:install-plan ,install-plan #:install-plan #$install-plan
#:search-paths ',(map search-path-specification->sexp #:search-paths '#$(map search-path-specification->sexp
search-paths) search-paths)
#:phases ,phases #:phases #$phases
#:out-of-source? ,out-of-source? #:out-of-source? #$out-of-source?
#:validate-runpath? ,validate-runpath? #:validate-runpath? #$validate-runpath?
#:patch-shebangs? ,patch-shebangs? #:patch-shebangs? #$patch-shebangs?
#:strip-binaries? ,strip-binaries? #:strip-binaries? #$strip-binaries?
#:strip-flags ,strip-flags #:strip-flags #$strip-flags
#:strip-directories ,strip-directories))) #:strip-directories #$strip-directories)))))
(define guile-for-build (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
(match guile system #:graft? #f)))
((? package?) (gexp->derivation name builder
(package-derivation store guile system #:graft? #f))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(build-expression->derivation store name builder
#:system system #:system system
#:inputs inputs #:target #f
#:modules imported-modules #:substitutable? substitutable?
#:outputs outputs #:allowed-references allowed-references
#:guile-for-build guile-for-build)) #:disallowed-references disallowed-references
#:guile-for-build guile)))
(define binary-build-system (define binary-build-system
(build-system (build-system