~ruther/guix-local

430505eba33b7bb59fa2d22e0f21ff317cbc320d — Alex Kost 10 years ago f80a7a6
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>
2 files changed, 38 insertions(+), 14 deletions(-)

M guix/scripts.scm
M guix/scripts/system.scm
M guix/scripts.scm => guix/scripts.scm +38 -1
@@ 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

M guix/scripts/system.scm => guix/scripts/system.scm +0 -13
@@ 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