From 430505eba33b7bb59fa2d22e0f21ff317cbc320d Mon Sep 17 00:00:00 2001
From: Alex Kost <alezost@gmail.com>
Date: Thu, 23 Jul 2015 16:16:41 +0300
Subject: scripts: Add 'build-package'.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

* 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>
---
 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 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
-- 
cgit v1.2.3