;; installed manifest but not in a package directory), ‘id’ parameter is
;; still "name-version" string. So ‘id’ package parameter in the code
;; below is either an object-address number or a full-name string.
-;;
-;; Important: as object addresses live only during guile session, elisp
-;; part should take care about updating information after "Guix REPL" is
-;; restarted (TODO!)
;; To speed-up the process of getting information, the following
;; auxiliary variables are used:
(ice-9 vlist)
(ice-9 match)
(srfi srfi-1)
+ (srfi srfi-2)
(srfi srfi-11)
(srfi srfi-19)
(srfi srfi-26)
(guix)
+ (guix git-download)
(guix packages)
(guix profiles)
(guix licenses)
(guix utils)
(guix ui)
(guix scripts package)
+ (guix scripts pull)
(gnu packages))
(define-syntax-rule (first-or-false lst)
(manifest-entry-version entry)
(manifest-entry-output entry)))
+(define (manifest-entry->package-specification entry)
+ (call-with-values
+ (lambda () (manifest-entry->name+version+output entry))
+ make-package-specification))
+
+(define (manifest-entries->package-specifications entries)
+ (map manifest-entry->package-specification entries))
+
+(define (generation-package-specifications profile number)
+ "Return a list of package specifications for generation NUMBER."
+ (let ((manifest (profile-manifest
+ (generation-file-name profile number))))
+ (manifest-entries->package-specifications
+ (manifest-entries manifest))))
+
+(define (generation-package-specifications+paths profile number)
+ "Return a list of package specifications and paths for generation NUMBER.
+Each element of the list is a list of the package specification and its path."
+ (let ((manifest (profile-manifest
+ (generation-file-name profile number))))
+ (map (lambda (entry)
+ (list (manifest-entry->package-specification entry)
+ (manifest-entry-item entry)))
+ (manifest-entries manifest))))
+
+(define (generation-difference profile number1 number2)
+ "Return a list of package specifications for outputs installed in generation
+NUMBER1 and not installed in generation NUMBER2."
+ (let ((specs1 (generation-package-specifications profile number1))
+ (specs2 (generation-package-specifications profile number2)))
+ (lset-difference string=? specs1 specs2)))
+
(define (manifest-entries->hash-table entries)
"Return a hash table of name keys and lists of matching manifest ENTRIES."
(let ((table (make-hash-table (length entries))))
(license-name license)))
(list-maybe (package-license package))))
+(define (package-source-names package)
+ "Return a list of source names (URLs) of the PACKAGE."
+ (let ((source (package-source package)))
+ (and (origin? source)
+ (filter-map (lambda (uri)
+ (cond ((string? uri)
+ uri)
+ ((git-reference? uri)
+ (git-reference-url uri))
+ (else "Unknown source type")))
+ (list-maybe (origin-uri source))))))
+
(define (package-unique? package)
"Return #t if PACKAGE is a single package with such name/version."
(null? (cdr (packages-by-name (package-name package)
(name . ,package-name)
(version . ,package-version)
(license . ,package-license-names)
+ (source . ,package-source-names)
(synopsis . ,package-synopsis)
(description . ,package-description)
(home-url . ,package-home-page)
'()
(list (obsolete-package-sexp
name version entries))))
- (map sexp-by-package packages))))))
+ (map sexp-by-package packages))))
+ (_ '())))
->sexps)
(append-map (cut sexps-by-manifest-entry <>)
entries))
(append-map (cut sexps-by-package <> output)
- packages))))))
+ packages))))
+ (_ '())))
->sexps)
(generation-file-name profile (car search-vals))
profile))
(manifest (profile-manifest profile))
- (patterns (apply (patterns-maker entry-type search-type)
- manifest search-vals))
+ (patterns (if (and (eq? entry-type 'output)
+ (eq? search-type 'generation-diff))
+ (match search-vals
+ ((g1 g2)
+ (map specification->output-pattern
+ (generation-difference profile g1 g2)))
+ (_ '()))
+ (apply (patterns-maker entry-type search-type)
+ manifest search-vals)))
(->sexps ((pattern-transformer entry-type) manifest params)))
(append-map ->sexps patterns)))
(define (generation-param-alist profile)
"Return an alist of generation parameters and procedures for PROFILE."
- (list
- (cons 'id identity)
- (cons 'number identity)
- (cons 'prev-number (cut previous-generation-number profile <>))
- (cons 'path (cut generation-file-name profile <>))
- (cons 'time (lambda (gen)
- (time-second (generation-time profile gen))))))
+ (let ((current (generation-number profile)))
+ `((id . ,identity)
+ (number . ,identity)
+ (prev-number . ,(cut previous-generation-number profile <>))
+ (current . ,(cut = current <>))
+ (path . ,(cut generation-file-name profile <>))
+ (time . ,(lambda (gen)
+ (time-second (generation-time profile gen)))))))
(define (matching-generations profile predicate)
"Return a list of PROFILE generations matching PREDICATE."
"Find PROFILE's generations matching SEARCH-TYPE and SEARCH-VALS."
(case search-type
((id)
- (matching-generations profile (cut memq <> (car search-vals))))
+ (matching-generations profile (cut memq <> search-vals)))
((last)
(last-generations profile (car search-vals)))
((all)
(last-generations profile +inf.0))
+ ((time)
+ (match search-vals
+ ((from to)
+ (matching-generations
+ profile
+ (lambda (gen)
+ (let ((time (time-second (generation-time profile gen))))
+ (< from time to)))))
+ (_ '())))
(else (search-type-error "generation" search-type))))
(define (generation-sexps profile params search-type search-vals)
'installed', 'obsolete', 'generation'.
- If ENTRY-TYPE is 'generation':
- 'id', 'last', 'all'.
+ 'id', 'last', 'all', 'time'.
PARAMS is a list of parameters for receiving. If it is an empty list,
get information with all available parameters, which are:
(new-manifest (manifest-perform-transaction
manifest transaction)))
(unless (and (null? install) (null? remove))
- (let* ((store (open-connection))
- (derivation (run-with-store
- store (profile-derivation new-manifest)))
- (derivations (list derivation))
- (new-profile (derivation->output-path derivation)))
+ (with-store store
+ (let* ((derivation (run-with-store store
+ (profile-derivation new-manifest)))
+ (derivations (list derivation))
+ (new-profile (derivation->output-path derivation)))
+ (set-build-options store
+ #:print-build-trace #f
+ #:use-substitutes? use-substitutes?)
+ (show-manifest-transaction store manifest transaction
+ #:dry-run? dry-run?)
+ (show-what-to-build store derivations
+ #:use-substitutes? use-substitutes?
+ #:dry-run? dry-run?)
+ (unless dry-run?
+ (let ((name (generation-file-name
+ profile
+ (+ 1 (generation-number profile)))))
+ (and (build-derivations store derivations)
+ (let* ((entries (manifest-entries new-manifest))
+ (count (length entries)))
+ (switch-symlinks name new-profile)
+ (switch-symlinks profile name)
+ (format #t (N_ "~a package in profile~%"
+ "~a packages in profile~%"
+ count)
+ count))))))))))
+
+(define (delete-generations* profile generations)
+ "Delete GENERATIONS from PROFILE.
+GENERATIONS is a list of generation numbers."
+ (with-store store
+ (delete-generations store profile generations)))
+
+(define (package-source-derivation->store-path derivation)
+ "Return a store path of the package source DERIVATION."
+ (match (derivation-outputs derivation)
+ ;; Source derivation is always (("out" . derivation)).
+ (((_ . output-drv))
+ (derivation-output-path output-drv))
+ (_ #f)))
+
+(define (package-source-path package-id)
+ "Return a store file path to a source of a package PACKAGE-ID."
+ (and-let* ((package (package-by-id package-id))
+ (source (package-source package)))
+ (with-store store
+ (package-source-derivation->store-path
+ (package-source-derivation store source)))))
+
+(define* (package-source-build-derivation package-id #:key dry-run?
+ (use-substitutes? #t))
+ "Build source derivation of a package PACKAGE-ID."
+ (and-let* ((package (package-by-id package-id))
+ (source (package-source package)))
+ (with-store store
+ (let* ((derivation (package-source-derivation store source))
+ (derivations (list derivation)))
(set-build-options store
+ #:print-build-trace #f
#:use-substitutes? use-substitutes?)
- (manifest-show-transaction store manifest transaction
- #:dry-run? dry-run?)
(show-what-to-build store derivations
#:use-substitutes? use-substitutes?
#:dry-run? dry-run?)
(unless dry-run?
- (let ((name (generation-file-name
- profile
- (+ 1 (generation-number profile)))))
- (and (build-derivations store derivations)
- (let* ((entries (manifest-entries new-manifest))
- (count (length entries)))
- (switch-symlinks name new-profile)
- (switch-symlinks profile name)
- (format #t (N_ "~a package in profile~%"
- "~a packages in profile~%"
- count)
- count)))))))))
+ (build-derivations store derivations))
+ (format #t "The source store path: ~a~%"
+ (package-source-derivation->store-path derivation))))))
HCoop / jackhill / guix / guix.git / blobdiff