amaharaneko/guix-mirrors
1
1
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2025-10-02 02:15:12 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

guix package: Add `--install-from-expression'.

Browse source 
* guix/scripts/package.scm (read/eval-package-expression): New
  procedure.
  (show-help): Add `-e'.
  (%options): Likewise.
  (guix-package)[process-actions]: Handle ('install . p) pairs, where P
  is a package.
* tests/guix-package.sh: Add `boot_make_drv'.  Use `-i $boot_make_drv'
  once, and then use `-e $boot_make'.
* doc/guix.texi (Invoking guix package): Document `-e'.
This commit is contained in:
Ludovic Courtès 2013-03-01 21:12:32 +01:00
parent 431a35518f
commit 5d4b411f8a
3 changed files with 67 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

44
guix/scripts/package.scm
View file

@ -266,6 +266,26 @@ matching packages."
(assoc-ref (derivation-outputs drv) sub-drv))))
`(,name ,out))))))
(define (read/eval-package-expression str)
"Read and evaluate STR and return the package it refers to, or exit an
error."
(let ((exp (catch #t
(lambda ()
(call-with-input-string str read))
(lambda args
(leave (_ "failed to read expression ~s: ~s~%")
str args)))))
(let ((p (catch #t
(lambda ()
(eval exp the-scm-module))
(lambda args
(leave (_ "failed to evaluate expression `~a': ~s~%")
exp args)))))
(if (package? p)
p
(leave (_ "expression `~s' does not evaluate to a package~%")
exp)))))
;;;
;;; Command-line options.
@ -281,6 +301,9 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
(display (_ "
-i, --install=PACKAGE install PACKAGE"))
(display (_ "
-e, --install-from-expression=EXP
install the package EXP evaluates to"))
(display (_ "
-r, --remove=PACKAGE remove PACKAGE"))
(display (_ "
-u, --upgrade=REGEXP upgrade all the installed packages matching REGEXP"))
@ -325,6 +348,10 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
(option '(#\i "install") #t #f
(lambda (opt name arg result)
(alist-cons 'install arg result)))
(option '(#\e "install-from-expression") #t #f
(lambda (opt name arg result)
(alist-cons 'install (read/eval-package-expression arg)
result)))
(option '(#\r "remove") #t #f
(lambda (opt name arg result)
(alist-cons 'remove arg result)))
@ -490,6 +517,19 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
(delete-duplicates (map input->name+path deps) same?))
(define (package->tuple p)
(let ((path (package-derivation (%store) p))
(deps (package-transitive-propagated-inputs p)))
`(,(package-name p)
,(package-version p)
;; When given a package via `-e', install the first of its
;; outputs (XXX).
,(car (package-outputs p))
,path
,(canonicalize-deps deps))))
;; First roll back if asked to.
(if (and (assoc-ref opts 'roll-back?) (not dry-run?))
(begin
@ -515,6 +555,8 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
(install (append
upgrade
(filter-map (match-lambda
(('install . (? package? p))
#f)
(('install . (? store-path?))
#f)
(('install . package)
@ -530,6 +572,8 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
install))
(install* (append
(filter-map (match-lambda
(('install . (? package? p))
(package->tuple p))
(('install . (? store-path? path))
(let-values (((name version)
(package-name->name+version