aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAlex Kost <alezost@gmail.com>2015-07-23 16:16:41 +0300
committerAlex Kost <alezost@gmail.com>2015-09-22 22:05:10 +0300
commit430505eba33b7bb59fa2d22e0f21ff317cbc320d (patch)
tree72eb41378e7d2265f2bd4f7be1dbb1d86f3f1fe6
parentf80a7a6c58539bfdc73a45677fb414e0cae0faef (diff)
downloadguix-430505eba33b7bb59fa2d22e0f21ff317cbc320d.tar
guix-430505eba33b7bb59fa2d22e0f21ff317cbc320d.tar.gz
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 <ludo@gnu.org>
-rw-r--r--guix/scripts.scm39
-rw-r--r--guix/scripts/system.scm13
2 files changed, 38 insertions, 14 deletions
diff --git a/guix/scripts.scm b/guix/scripts.scm
index 6bb3e2169e..e34d38904c 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 <ludo@gnu.org>
;;; Copyright © 2014 Deck Pickard <deck.r.pickard@gmail.com>
+;;; Copyright © 2015 Alex Kost <alezost@gmail.com>
;;;
;;; 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 32d40576ff..5e2d226dfe 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