~abcdw/rde-devel

This thread contains a patchset. You're looking at the original emails, but you may wish to use the patch review UI. Review patch
2 2

[PATCH] guix: scripts: home: Add ‘import’ command.

Details
Message ID
<1f502d7420a2890a6533cc4f102b0013c9bf810b.1624010105.git.public@yoctocell.xyz>
DKIM signature
pass
Download raw message
Patch: +185 -8
* guix/scripts/home.scm (show-help): Add ‘import’ command.
(process-command): Likewise.
(manifest->code, home-environment-template, import-manifest): New
procedures.
---
 guix/scripts/home.scm | 193 ++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 185 insertions(+), 8 deletions(-)

diff --git a/guix/scripts/home.scm b/guix/scripts/home.scm
index 11b3d6c..8bebab0 100644
--- a/guix/scripts/home.scm
+++ b/guix/scripts/home.scm
@@ -1,6 +1,7 @@
(define-module (guix scripts home)
  #:use-module (gnu packages admin)
  #:use-module (gnu services)
  #:use-module (gnu packages)
  #:use-module (gnu home)
  #:use-module (gnu home-services)
  #:use-module (guix channels)
@@ -9,7 +10,7 @@
  #:use-module (guix ui)
  #:use-module (guix grafts)
  #:use-module (guix packages)
  #:use-module (guix profiles)
  #:use-module ((guix profiles) #:hide (manifest->code))
  #:use-module (guix store)
  #:use-module (guix utils)
  #:use-module (guix scripts)
@@ -57,6 +58,8 @@ Some ACTIONS support additional ARGS.\n"))
   delete-generations delete old home environment generations\n"))
  (display (G_ "\
   build              build the home environment without installing anything\n"))
  (display (G_ "\
   import             print a home environment file for a profile"))

  ;; (show-build-options-help)
  (newline)
@@ -200,13 +203,24 @@ resulting from command-line parsing."
argument list and OPTS is the option alist."
  (define-syntax-rule (with-store* store exp ...)
    (with-store store
		(set-build-options-from-command-line store opts)
		exp ...))
      (set-build-options-from-command-line store opts)
      exp ...))
  (case command
    ;; The following commands do not need to use the store, and they do not need
    ;; an operating home environment file.
    ((search)
     (apply search args))
    ((import)
     (let* ((profiles (delete-duplicates
                      (match (filter-map (match-lambda
                                           (('profile . p) p)
                                           (_              #f))
                                         opts)
                        (() (list %current-profile))
                        (lst (reverse lst)))))
           (manifest (concatenate-manifests
                      (map profile-manifest profiles))))
       (import-manifest manifest (current-output-port))))
    ((describe)
     (match (generation-number %guix-home)
       (0
@@ -224,21 +238,21 @@ argument list and OPTS is the option alist."
                      ((pattern) pattern)
                      (x (leave (G_ "wrong number of arguments~%"))))))
       (with-store* store
		    (switch-to-home-environment-generation store pattern))))
                    (switch-to-home-environment-generation store pattern))))
    ((roll-back)
     (let ((pattern (match args
                      (() "")
                      (x (leave (G_ "wrong number of arguments~%"))))))
       (with-store* store
		    (roll-back-home-environment store))))
                    (roll-back-home-environment store))))
    ((delete-generations)
     (let ((pattern (match args
                      (() #f)
                      ((pattern) pattern)
                      (x (leave (G_ "wrong number of arguments~%"))))))
       (with-store*
	store
	(delete-matching-generations store %guix-home pattern))))
        store
        (delete-matching-generations store %guix-home pattern))))
    (else (process-action command args opts))))

(define-command (guix-home . args)
@@ -255,7 +269,8 @@ argument list and OPTS is the option alist."
	      extension-graph shepherd-graph
	      list-generations describe
	      delete-generations roll-back
	      switch-generation search)
	      switch-generation search
              import)
             (alist-cons 'action action result))
            (else (leave (G_ "~a: unknown action~%") action))))))

@@ -463,3 +478,165 @@ SPEC.  STORE is an open connection to the store."
STORE is an open connection to the store."
  (switch-to-home-environment-generation store "-1"))



;;;
;;; Import.
;;;

;; Based on `manifest->code' from (guix profiles)
(define* (manifest->code manifest
                         #:key
                         (entry-package-version (const ""))
                         (home-environment? #f))
  "Return an sexp representing code to build an approximate version of
MANIFEST; the code is wrapped in a top-level 'begin' form.  If
HOME-ENVIRONMENT? is #t, return an <home-environment> definition.
Call ENTRY-PACKAGE-VERSION to determine the version number to use in
the spec for a given entry; it can be set to 'manifest-entry-version'
for fully-specified version numbers, or to some other procedure to
disambiguate versions for packages for which several versions are
available."
  (define (entry-transformations entry)
    ;; Return the transformations that apply to ENTRY.
    (assoc-ref (manifest-entry-properties entry) 'transformations))

  (define transformation-procedures
    ;; List of transformation options/procedure name pairs.
    (let loop ((entries (manifest-entries manifest))
               (counter 1)
               (result  '()))
      (match entries
        (() result)
        ((entry . tail)
         (match (entry-transformations entry)
           (#f
            (loop tail counter result))
           (options
            (if (assoc-ref result options)
                (loop tail counter result)
                (loop tail (+ 1 counter)
                      (alist-cons options
                                  (string->symbol
                                   (format #f "transform~a" counter))
                                  result)))))))))

  (define (qualified-name entry)
    ;; Return the name of ENTRY possibly with "@" followed by a version.
    (match (entry-package-version entry)
      (""      (manifest-entry-name entry))
      (version (string-append (manifest-entry-name entry)
                              "@" version))))

  (if (null? transformation-procedures)
      (let ((specs (map (lambda (entry)
                          (match (manifest-entry-output entry)
                            ("out"  (qualified-name entry))
                            (output (string-append (qualified-name entry)
                                                   ":" output))))
                        (manifest-entries manifest))))
        (if home-environment?
            `(begin
               (use-modules (gnu home)
                            (gnu packages))
               ,(home-environment-template #:specs specs))
            `(begin
               (use-modules (gnu packages))
               
               (specifications->manifest
                (list ,@specs)))))
      (let* ((transform (lambda (options exp)
                         (if (not options)
                             exp
                             (let ((proc (assoc-ref transformation-procedures
                                                    options)))
                               `(,proc ,exp)))))
            (packages (map (lambda (entry)
                                   (define options
                                     (entry-transformations entry))

                                   (define name
                                     (qualified-name entry))

                                   (match (manifest-entry-output entry)
                                     ("out"
                                      (transform options
                                                 `(specification->package ,name)))
                                     (output
                                      `(list ,(transform
                                               options
                                               `(specification->package ,name))
                                             ,output))))
                           (manifest-entries manifest)))
            (transformations (map (match-lambda
                         ((options . name)
                          `(define ,name
                             (options->transformation ',options))))
                       transformation-procedures)))
        (if home-environment?
            `(begin
               (use-modules (guix transformations)
                            (gnu home)
                            (gnu packages))

               ,@transformations

               ,(home-environment-template #:packages packages))
            `(begin
               (use-modules (guix transformations)
                            (gnu packages))

                ,@transformations

                (packages->manifest
                 (list ,@packages)))))))

(define* (home-environment-template #:key (packages #f) (specs #f))
  "Return an S-exp containing a <home-environment> declaration
containing PACKAGES, or SPECS (package specifications)."
  `(home-environment
     (home-directory ,(getenv "HOME"))
     (packages
      ,@(if packages
            `((list ,@packages))
            `((map specification->package
               (list ,@specs)))))))

;; TODO: Read ~/ and generate service configurations
(define* (import-manifest manifest
                             #:optional (port (current-output-port)))
  "Write to PORT a <home-environment> corresponding to MANIFEST."
  (define (version-spec entry)
    (let ((name (manifest-entry-name entry)))
      (match (map package-version (find-packages-by-name name))
        ((_)
         ;; A single version of NAME is available, so do not specify the
         ;; version number, even if the available version doesn't match ENTRY.
         "")
        (versions
         ;; If ENTRY uses the latest version, don't specify any version.
         ;; Otherwise return the shortest unique version prefix.  Note that
         ;; this is based on the currently available packages, which could
         ;; differ from the packages available in the revision that was used
         ;; to build MANIFEST.
         (let ((current (manifest-entry-version entry)))
           (if (every (cut version>? current <>)
                      (delete current versions))
               ""
               (version-unique-prefix (manifest-entry-version entry)
                                      versions)))))))

  (match (manifest->code manifest
                         #:entry-package-version version-spec
                         #:home-environment? #t)
    (('begin exp ...)
     (format port (G_ "\
;; This \"home-environment\" file can be passed to 'guix home reconfigure'
;; to reproduce the content of your profile.  This is \"symbolic\": it only
;; specifies package names.  To reproduce the exact same profile, you also
;; need to capture the channels being used, as returned by \"guix describe\".
;; See the \"Replicating Guix\" section in the manual.\n"))
     (for-each (lambda (exp)
                 (newline port)
                 (pretty-print exp port))
               exp))))

base-commit: 6d40090ef287a4523fee32d4350b4dcd5fe90f0b
-- 
2.32.0
Details
Message ID
<8735tabg8e.fsf@trop.in>
In-Reply-To
<1f502d7420a2890a6533cc4f102b0013c9bf810b.1624010105.git.public@yoctocell.xyz> (view parent)
DKIM signature
missing
Download raw message
Xinglu Chen <public@yoctocell.xyz> writes:

> * guix/scripts/home.scm (show-help): Add ‘import’ command.
> (process-command): Likewise.
> (manifest->code, home-environment-template, import-manifest): New
> procedures.
> ---
>  guix/scripts/home.scm | 193 ++++++++++++++++++++++++++++++++++++++++--
>  1 file changed, 185 insertions(+), 8 deletions(-)
>
> diff --git a/guix/scripts/home.scm b/guix/scripts/home.scm
> index 11b3d6c..8bebab0 100644
> --- a/guix/scripts/home.scm
> +++ b/guix/scripts/home.scm
> @@ -1,6 +1,7 @@
>  (define-module (guix scripts home)
>    #:use-module (gnu packages admin)
>    #:use-module (gnu services)
> +  #:use-module (gnu packages)
>    #:use-module (gnu home)
>    #:use-module (gnu home-services)
>    #:use-module (guix channels)
> @@ -9,7 +10,7 @@
>    #:use-module (guix ui)
>    #:use-module (guix grafts)
>    #:use-module (guix packages)
> -  #:use-module (guix profiles)
> +  #:use-module ((guix profiles) #:hide (manifest->code))
>    #:use-module (guix store)
>    #:use-module (guix utils)
>    #:use-module (guix scripts)
> @@ -57,6 +58,8 @@ Some ACTIONS support additional ARGS.\n"))
>     delete-generations delete old home environment generations\n"))
>    (display (G_ "\
>     build              build the home environment without installing anything\n"))
> +  (display (G_ "\
> +   import             print a home environment file for a profile"))
>  
>    ;; (show-build-options-help)
>    (newline)
> @@ -200,13 +203,24 @@ resulting from command-line parsing."
>  argument list and OPTS is the option alist."
>    (define-syntax-rule (with-store* store exp ...)
>      (with-store store
> -		(set-build-options-from-command-line store opts)
> -		exp ...))
> +      (set-build-options-from-command-line store opts)
> +      exp ...))
>    (case command
>      ;; The following commands do not need to use the store, and they do not need
>      ;; an operating home environment file.
>      ((search)
>       (apply search args))
> +    ((import)
> +     (let* ((profiles (delete-duplicates
> +                      (match (filter-map (match-lambda
> +                                           (('profile . p) p)
> +                                           (_              #f))
> +                                         opts)
> +                        (() (list %current-profile))
> +                        (lst (reverse lst)))))
> +           (manifest (concatenate-manifests
> +                      (map profile-manifest profiles))))
> +       (import-manifest manifest (current-output-port))))
>      ((describe)
>       (match (generation-number %guix-home)
>         (0
> @@ -224,21 +238,21 @@ argument list and OPTS is the option alist."
>                        ((pattern) pattern)
>                        (x (leave (G_ "wrong number of arguments~%"))))))
>         (with-store* store
> -		    (switch-to-home-environment-generation store pattern))))
> +                    (switch-to-home-environment-generation store pattern))))
>      ((roll-back)
>       (let ((pattern (match args
>                        (() "")
>                        (x (leave (G_ "wrong number of arguments~%"))))))
>         (with-store* store
> -		    (roll-back-home-environment store))))
> +                    (roll-back-home-environment store))))
>      ((delete-generations)
>       (let ((pattern (match args
>                        (() #f)
>                        ((pattern) pattern)
>                        (x (leave (G_ "wrong number of arguments~%"))))))
>         (with-store*
> -	store
> -	(delete-matching-generations store %guix-home pattern))))
> +        store
> +        (delete-matching-generations store %guix-home pattern))))
>      (else (process-action command args opts))))
>  
>  (define-command (guix-home . args)
> @@ -255,7 +269,8 @@ argument list and OPTS is the option alist."
>  	      extension-graph shepherd-graph
>  	      list-generations describe
>  	      delete-generations roll-back
> -	      switch-generation search)
> +	      switch-generation search
> +              import)
>               (alist-cons 'action action result))
>              (else (leave (G_ "~a: unknown action~%") action))))))
>  
> @@ -463,3 +478,165 @@ SPEC.  STORE is an open connection to the store."
>  STORE is an open connection to the store."
>    (switch-to-home-environment-generation store "-1"))
>  
> +
> +
> +;;;
> +;;; Import.
> +;;;
> +
> +;; Based on `manifest->code' from (guix profiles)
> +(define* (manifest->code manifest
> +                         #:key
> +                         (entry-package-version (const ""))
> +                         (home-environment? #f))
> +  "Return an sexp representing code to build an approximate version of
> +MANIFEST; the code is wrapped in a top-level 'begin' form.  If
> +HOME-ENVIRONMENT? is #t, return an <home-environment> definition.
> +Call ENTRY-PACKAGE-VERSION to determine the version number to use in
> +the spec for a given entry; it can be set to 'manifest-entry-version'
> +for fully-specified version numbers, or to some other procedure to
> +disambiguate versions for packages for which several versions are
> +available."
> +  (define (entry-transformations entry)
> +    ;; Return the transformations that apply to ENTRY.
> +    (assoc-ref (manifest-entry-properties entry) 'transformations))
> +
> +  (define transformation-procedures
> +    ;; List of transformation options/procedure name pairs.
> +    (let loop ((entries (manifest-entries manifest))
> +               (counter 1)
> +               (result  '()))
> +      (match entries
> +        (() result)
> +        ((entry . tail)
> +         (match (entry-transformations entry)
> +           (#f
> +            (loop tail counter result))
> +           (options
> +            (if (assoc-ref result options)
> +                (loop tail counter result)
> +                (loop tail (+ 1 counter)
> +                      (alist-cons options
> +                                  (string->symbol
> +                                   (format #f "transform~a" counter))
> +                                  result)))))))))
> +
> +  (define (qualified-name entry)
> +    ;; Return the name of ENTRY possibly with "@" followed by a version.
> +    (match (entry-package-version entry)
> +      (""      (manifest-entry-name entry))
> +      (version (string-append (manifest-entry-name entry)
> +                              "@" version))))
> +
> +  (if (null? transformation-procedures)
> +      (let ((specs (map (lambda (entry)
> +                          (match (manifest-entry-output entry)
> +                            ("out"  (qualified-name entry))
> +                            (output (string-append (qualified-name entry)
> +                                                   ":" output))))
> +                        (manifest-entries manifest))))
> +        (if home-environment?
> +            `(begin
> +               (use-modules (gnu home)
> +                            (gnu packages))
> +               ,(home-environment-template #:specs specs))
> +            `(begin
> +               (use-modules (gnu packages))
> +               
> +               (specifications->manifest
> +                (list ,@specs)))))
> +      (let* ((transform (lambda (options exp)
> +                         (if (not options)
> +                             exp
> +                             (let ((proc (assoc-ref transformation-procedures
> +                                                    options)))
> +                               `(,proc ,exp)))))
> +            (packages (map (lambda (entry)
> +                                   (define options
> +                                     (entry-transformations entry))
> +
> +                                   (define name
> +                                     (qualified-name entry))
> +
> +                                   (match (manifest-entry-output entry)
> +                                     ("out"
> +                                      (transform options
> +                                                 `(specification->package ,name)))
> +                                     (output
> +                                      `(list ,(transform
> +                                               options
> +                                               `(specification->package ,name))
> +                                             ,output))))
> +                           (manifest-entries manifest)))
> +            (transformations (map (match-lambda
> +                         ((options . name)
> +                          `(define ,name
> +                             (options->transformation ',options))))
> +                       transformation-procedures)))
> +        (if home-environment?
> +            `(begin
> +               (use-modules (guix transformations)
> +                            (gnu home)
> +                            (gnu packages))
> +
> +               ,@transformations
> +
> +               ,(home-environment-template #:packages packages))
> +            `(begin
> +               (use-modules (guix transformations)
> +                            (gnu packages))
> +
> +                ,@transformations
> +
> +                (packages->manifest
> +                 (list ,@packages)))))))
> +
> +(define* (home-environment-template #:key (packages #f) (specs #f))
> +  "Return an S-exp containing a <home-environment> declaration
> +containing PACKAGES, or SPECS (package specifications)."
> +  `(home-environment
> +     (home-directory ,(getenv "HOME"))
> +     (packages
> +      ,@(if packages
> +            `((list ,@packages))
> +            `((map specification->package
> +               (list ,@specs)))))))
> +
> +;; TODO: Read ~/ and generate service configurations
> +(define* (import-manifest manifest
> +                             #:optional (port (current-output-port)))
> +  "Write to PORT a <home-environment> corresponding to MANIFEST."
> +  (define (version-spec entry)
> +    (let ((name (manifest-entry-name entry)))
> +      (match (map package-version (find-packages-by-name name))
> +        ((_)
> +         ;; A single version of NAME is available, so do not specify the
> +         ;; version number, even if the available version doesn't match ENTRY.
> +         "")
> +        (versions
> +         ;; If ENTRY uses the latest version, don't specify any version.
> +         ;; Otherwise return the shortest unique version prefix.  Note that
> +         ;; this is based on the currently available packages, which could
> +         ;; differ from the packages available in the revision that was used
> +         ;; to build MANIFEST.
> +         (let ((current (manifest-entry-version entry)))
> +           (if (every (cut version>? current <>)
> +                      (delete current versions))
> +               ""
> +               (version-unique-prefix (manifest-entry-version entry)
> +                                      versions)))))))
> +
> +  (match (manifest->code manifest
> +                         #:entry-package-version version-spec
> +                         #:home-environment? #t)
> +    (('begin exp ...)
> +     (format port (G_ "\
> +;; This \"home-environment\" file can be passed to 'guix home reconfigure'
> +;; to reproduce the content of your profile.  This is \"symbolic\": it only
> +;; specifies package names.  To reproduce the exact same profile, you also
> +;; need to capture the channels being used, as returned by \"guix describe\".
> +;; See the \"Replicating Guix\" section in the manual.\n"))
> +     (for-each (lambda (exp)
> +                 (newline port)
> +                 (pretty-print exp port))
> +               exp))))
>
> base-commit: 6d40090ef287a4523fee32d4350b4dcd5fe90f0b

LGTM, applied, adjusted few minor things.

Thank you for new action!)
Details
Message ID
<87im26s4h1.fsf@yoctocell.xyz>
In-Reply-To
<8735tabg8e.fsf@trop.in> (view parent)
DKIM signature
pass
Download raw message
On Tue, Jun 22 2021, Andrew Tropin wrote:

> LGTM, applied, adjusted few minor things.
>
> Thank you for new action!)

You’re welcome :)
Reply to thread Export thread (mbox)