[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
04/04: scripts: Add 'build-package'.
From: |
Alex Kost |
Subject: |
04/04: scripts: Add 'build-package'. |
Date: |
Tue, 22 Sep 2015 19:07:35 +0000 |
alezost pushed a commit to branch master
in repository guix.
commit 430505eba33b7bb59fa2d22e0f21ff317cbc320d
Author: Alex Kost <address@hidden>
Date: Thu Jul 23 16:16:41 2015 +0300
scripts: Add 'build-package'.
* guix/scripts/system.scm (maybe-build): Move to ...
* guix/scripts.scm: ...here.
(build-package): New procedure.
Co-authored-by: Ludovic Courtès <address@hidden>
---
guix/scripts.scm | 39 ++++++++++++++++++++++++++++++++++++++-
guix/scripts/system.scm | 13 -------------
2 files changed, 38 insertions(+), 14 deletions(-)
diff --git a/guix/scripts.scm b/guix/scripts.scm
index 6bb3e21..e34d389 100644
--- a/guix/scripts.scm
+++ b/guix/scripts.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <address@hidden>
;;; Copyright © 2014 Deck Pickard <address@hidden>
+;;; Copyright © 2015 Alex Kost <address@hidden>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -20,11 +21,17 @@
(define-module (guix scripts)
#:use-module (guix utils)
#:use-module (guix ui)
+ #:use-module (guix store)
+ #:use-module (guix monads)
+ #:use-module (guix packages)
+ #:use-module (guix derivations)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-37)
#:use-module (ice-9 match)
#:export (args-fold*
- parse-command-line))
+ parse-command-line
+ maybe-build
+ build-package))
;;; Commentary:
;;;
@@ -78,4 +85,34 @@ parameter of 'args-fold'."
;; ARGS take precedence over what the environment variable specifies.
(parse-options-from args seeds))))
+(define* (maybe-build drvs
+ #:key dry-run? use-substitutes?)
+ "Show what will/would be built, and actually build DRVS, unless DRY-RUN? is
+true."
+ (with-monad %store-monad
+ (>>= (show-what-to-build* drvs
+ #:dry-run? dry-run?
+ #:use-substitutes? use-substitutes?)
+ (lambda (_)
+ (if dry-run?
+ (return #f)
+ (built-derivations drvs))))))
+
+(define* (build-package package
+ #:key dry-run? (use-substitutes? #t)
+ #:allow-other-keys
+ #:rest build-options)
+ "Build PACKAGE using BUILD-OPTIONS acceptable by 'set-build-options'.
+Show what and how will/would be built."
+ (mbegin %store-monad
+ (apply set-build-options*
+ #:use-substitutes? use-substitutes?
+ (strip-keyword-arguments '(#:dry-run?) build-options))
+ (mlet %store-monad ((derivation (package->derivation package)))
+ (mbegin %store-monad
+ (maybe-build (list derivation)
+ #:use-substitutes? use-substitutes?
+ #:dry-run? dry-run?)
+ (return (show-derivation-outputs derivation))))))
+
;;; scripts.scm ends here
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 32d4057..5e2d226 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -299,19 +299,6 @@ it atomically, and then run OS's activation script."
((disk-image)
(system-disk-image os #:disk-image-size image-size))))
-(define* (maybe-build drvs
- #:key dry-run? use-substitutes?)
- "Show what will/would be built, and actually build DRVS, unless DRY-RUN? is
-true."
- (with-monad %store-monad
- (>>= (show-what-to-build* drvs
- #:dry-run? dry-run?
- #:use-substitutes? use-substitutes?)
- (lambda (_)
- (if dry-run?
- (return #f)
- (built-derivations drvs))))))
-
(define* (perform-action action os
#:key grub? dry-run?
use-substitutes? device target