import: stackage: Support recursive importing.
* guix/import/hackage.scm (hackage-name->package-name): Export procedure. * guix/import/stackage.scm (lts-info-packages-lts-info): Fix match expression. (stackage-recursive-import): New procedure. (stackage->guix-package): Memoize results. * guix/scripts/import/stackage.scm (show-help, %options, guix-import-stackage): Support recursive importing. * doc/guix.texi (Invoking guix import): Document option.
This commit is contained in:
		
							parent
							
								
									b5d1286f2d
								
							
						
					
					
						commit
						a3ece51a29
					
				
					 4 changed files with 70 additions and 29 deletions
				
			
		|  | @ -6699,9 +6699,14 @@ Specific command-line options are: | |||
| @itemx -t | ||||
| Do not include dependencies required only by the test suites. | ||||
| @item --lts-version=@var{version} | ||||
| @itemx -r @var{version} | ||||
| @itemx -l @var{version} | ||||
| @var{version} is the desired LTS release version.  If omitted the latest | ||||
| release is used. | ||||
| @item --recursive | ||||
| @itemx -r | ||||
| Traverse the dependency graph of the given upstream package recursively | ||||
| and generate package expressions for all those packages that are not yet | ||||
| in Guix. | ||||
| @end table | ||||
| 
 | ||||
| The command below imports metadata for the @code{HTTP} Haskell package | ||||
|  |  | |||
|  | @ -44,6 +44,7 @@ | |||
|             %hackage-updater | ||||
| 
 | ||||
|             guix-package->hackage-name | ||||
|             hackage-name->package-name | ||||
|             hackage-fetch | ||||
|             hackage-source-url | ||||
|             hackage-cabal-url | ||||
|  |  | |||
|  | @ -1,5 +1,6 @@ | |||
| ;;; GNU Guix --- Functional package management for GNU | ||||
| ;;; Copyright © 2017 Federico Beffa <beffa@fbengineering.ch> | ||||
| ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net> | ||||
| ;;; | ||||
| ;;; This file is part of GNU Guix. | ||||
| ;;; | ||||
|  | @ -25,10 +26,12 @@ | |||
|   #:use-module (srfi srfi-35) | ||||
|   #:use-module (guix import json) | ||||
|   #:use-module (guix import hackage) | ||||
|   #:use-module (guix import utils) | ||||
|   #:use-module (guix memoization) | ||||
|   #:use-module (guix packages) | ||||
|   #:use-module (guix upstream) | ||||
|   #:export (stackage->guix-package | ||||
|             stackage-recursive-import | ||||
|             %stackage-updater)) | ||||
| 
 | ||||
|  | ||||
|  | @ -45,9 +48,9 @@ | |||
|     (_ #f))) | ||||
| 
 | ||||
| (define (lts-info-packages lts-info) | ||||
|   "Retruns the alist of packages contained in LTS-INFO." | ||||
|   "Returns the alist of packages contained in LTS-INFO." | ||||
|   (match lts-info | ||||
|     ((_ ("packages" pkg ...)) pkg) | ||||
|     ((("packages" pkg ...) . _) pkg) | ||||
|     (_ '()))) | ||||
| 
 | ||||
| (define (leave-with-message fmt . args) | ||||
|  | @ -85,25 +88,33 @@ | |||
| (define (hackage-name-version name version) | ||||
|   (and version (string-append  name "@" version))) | ||||
| 
 | ||||
| (define* (stackage->guix-package package-name ; upstream name | ||||
|                                  #:key | ||||
|                                  (include-test-dependencies? #t) | ||||
|                                  (lts-version "") | ||||
|                                  (packages-info | ||||
|                                   (lts-info-packages | ||||
|                                    (stackage-lts-info-fetch lts-version)))) | ||||
|   "Fetch Cabal file for PACKAGE-NAME from hackage.haskell.org.  The retrieved | ||||
| (define stackage->guix-package | ||||
|   (memoize | ||||
|    (lambda* (package-name ; upstream name | ||||
|              #:key | ||||
|              (include-test-dependencies? #t) | ||||
|              (lts-version "") | ||||
|              (packages-info | ||||
|               (lts-info-packages | ||||
|                (stackage-lts-info-fetch lts-version)))) | ||||
|      "Fetch Cabal file for PACKAGE-NAME from hackage.haskell.org.  The retrieved | ||||
| vesion corresponds to the version of PACKAGE-NAME specified in the LTS-VERSION | ||||
| release at stackage.org.  Return the `package' S-expression corresponding to | ||||
| that package, or #f on failure.  PACKAGES-INFO is the alist with the packages | ||||
| included in the Stackage LTS release." | ||||
|   (let* ((version (lts-package-version packages-info package-name)) | ||||
|          (name-version (hackage-name-version package-name version))) | ||||
|     (if name-version | ||||
|         (hackage->guix-package name-version | ||||
|                                #:include-test-dependencies? | ||||
|                                include-test-dependencies?) | ||||
|         (leave-with-message "~a: Stackage package not found" package-name)))) | ||||
|      (let* ((version (lts-package-version packages-info package-name)) | ||||
|             (name-version (hackage-name-version package-name version))) | ||||
|        (if name-version | ||||
|            (hackage->guix-package name-version | ||||
|                                   #:include-test-dependencies? | ||||
|                                   include-test-dependencies?) | ||||
|            (leave-with-message "~a: Stackage package not found" package-name)))))) | ||||
| 
 | ||||
| (define (stackage-recursive-import package-name . args) | ||||
|   (recursive-import package-name #f | ||||
|                     #:repo->guix-package (lambda (name repo) | ||||
|                                            (apply stackage->guix-package (cons name args))) | ||||
|                     #:guix-name hackage-name->package-name)) | ||||
| 
 | ||||
|  | ||||
| ;;; | ||||
|  |  | |||
|  | @ -1,5 +1,6 @@ | |||
| ;;; GNU Guix --- Functional package management for GNU | ||||
| ;;; Copyright © 2017 Federico Beffa <beffa@fbengineering.ch> | ||||
| ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net> | ||||
| ;;; | ||||
| ;;; This file is part of GNU Guix. | ||||
| ;;; | ||||
|  | @ -26,6 +27,7 @@ | |||
|   #:use-module (srfi srfi-1) | ||||
|   #:use-module (srfi srfi-11) | ||||
|   #:use-module (srfi srfi-37) | ||||
|   #:use-module (srfi srfi-41) | ||||
|   #:use-module (ice-9 match) | ||||
|   #:use-module (ice-9 format) | ||||
|   #:export (guix-import-stackage)) | ||||
|  | @ -43,11 +45,13 @@ | |||
|   (display (G_ "Usage: guix import stackage PACKAGE-NAME | ||||
| Import and convert the LTS Stackage package for PACKAGE-NAME.\n")) | ||||
|   (display (G_ " | ||||
|   -r VERSION, --lts-version=VERSION | ||||
|   -l VERSION, --lts-version=VERSION | ||||
|                                specify the LTS version to use")) | ||||
|   (display (G_ " | ||||
|   -h, --help                   display this help and exit")) | ||||
|   (display (G_ " | ||||
|   -r, --recursive              import packages recursively")) | ||||
|   (display (G_ " | ||||
|   -t, --no-test-dependencies   don't include test-only dependencies")) | ||||
|   (display (G_ " | ||||
|   -V, --version                display version information and exit")) | ||||
|  | @ -68,11 +72,14 @@ Import and convert the LTS Stackage package for PACKAGE-NAME.\n")) | |||
|                    (alist-cons 'include-test-dependencies? #f | ||||
|                                (alist-delete 'include-test-dependencies? | ||||
|                                              result)))) | ||||
|          (option '(#\r "lts-version") #t #f | ||||
|          (option '(#\l "lts-version") #t #f | ||||
|                  (lambda (opt name arg result) | ||||
|                    (alist-cons 'lts-version arg | ||||
|                                (alist-delete 'lts-version | ||||
|                                              result)))) | ||||
|          (option '(#\r "recursive") #f #f | ||||
|                  (lambda (opt name arg result) | ||||
|                    (alist-cons 'recursive #t result))) | ||||
|          %standard-import-options)) | ||||
| 
 | ||||
|  | ||||
|  | @ -90,6 +97,27 @@ Import and convert the LTS Stackage package for PACKAGE-NAME.\n")) | |||
|                   (alist-cons 'argument arg result)) | ||||
|                 %default-options)) | ||||
| 
 | ||||
|   (define (run-importer package-name opts error-fn) | ||||
|     (let* ((arguments (list | ||||
|                        package-name | ||||
|                        #:include-test-dependencies? | ||||
|                        (assoc-ref opts 'include-test-dependencies?) | ||||
|                        #:lts-version (assoc-ref opts 'lts-version))) | ||||
|            (sexp (if (assoc-ref opts 'recursive) | ||||
|                      ;; Recursive import | ||||
|                      (map (match-lambda | ||||
|                             ((and ('package ('name name) . rest) pkg) | ||||
|                              `(define-public ,(string->symbol name) | ||||
|                                 ,pkg)) | ||||
|                             (_ #f)) | ||||
|                           (reverse | ||||
|                            (stream->list | ||||
|                             (apply stackage-recursive-import arguments)))) | ||||
|                      ;; Single import | ||||
|                      (apply stackage->guix-package arguments)))) | ||||
|       (unless sexp (error-fn)) | ||||
|       sexp)) | ||||
| 
 | ||||
|   (let* ((opts (parse-options)) | ||||
|          (args (filter-map (match-lambda | ||||
|                             (('argument . value) | ||||
|  | @ -99,15 +127,11 @@ Import and convert the LTS Stackage package for PACKAGE-NAME.\n")) | |||
|     (match args | ||||
|       ((package-name) | ||||
|        (with-error-handling | ||||
|         (let ((sexp (stackage->guix-package | ||||
|                      package-name | ||||
|                      #:include-test-dependencies? | ||||
|                      (assoc-ref opts 'include-test-dependencies?) | ||||
|                      #:lts-version (assoc-ref opts 'lts-version)))) | ||||
|           (unless sexp | ||||
|             (leave (G_ "failed to download cabal file for package '~a'~%") | ||||
|                    package-name)) | ||||
|           sexp))) | ||||
|          (run-importer package-name opts | ||||
|                        (lambda () | ||||
|                          (leave (G_ "failed to download cabal file \ | ||||
| for package '~a'~%") | ||||
|                                 package-name))))) | ||||
|       (() | ||||
|        (leave (G_ "too few arguments~%"))) | ||||
|       ((many ...) | ||||
|  |  | |||
		Reference in a new issue