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
|
@ -6699,9 +6699,14 @@ Specific command-line options are:
|
||||||
@itemx -t
|
@itemx -t
|
||||||
Do not include dependencies required only by the test suites.
|
Do not include dependencies required only by the test suites.
|
||||||
@item --lts-version=@var{version}
|
@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
|
@var{version} is the desired LTS release version. If omitted the latest
|
||||||
release is used.
|
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
|
@end table
|
||||||
|
|
||||||
The command below imports metadata for the @code{HTTP} Haskell package
|
The command below imports metadata for the @code{HTTP} Haskell package
|
||||||
|
|
|
@ -44,6 +44,7 @@
|
||||||
%hackage-updater
|
%hackage-updater
|
||||||
|
|
||||||
guix-package->hackage-name
|
guix-package->hackage-name
|
||||||
|
hackage-name->package-name
|
||||||
hackage-fetch
|
hackage-fetch
|
||||||
hackage-source-url
|
hackage-source-url
|
||||||
hackage-cabal-url
|
hackage-cabal-url
|
||||||
|
|
|
@ -1,5 +1,6 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2017 Federico Beffa <beffa@fbengineering.ch>
|
;;; Copyright © 2017 Federico Beffa <beffa@fbengineering.ch>
|
||||||
|
;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
@ -25,10 +26,12 @@
|
||||||
#:use-module (srfi srfi-35)
|
#:use-module (srfi srfi-35)
|
||||||
#:use-module (guix import json)
|
#:use-module (guix import json)
|
||||||
#:use-module (guix import hackage)
|
#:use-module (guix import hackage)
|
||||||
|
#:use-module (guix import utils)
|
||||||
#:use-module (guix memoization)
|
#:use-module (guix memoization)
|
||||||
#:use-module (guix packages)
|
#:use-module (guix packages)
|
||||||
#:use-module (guix upstream)
|
#:use-module (guix upstream)
|
||||||
#:export (stackage->guix-package
|
#:export (stackage->guix-package
|
||||||
|
stackage-recursive-import
|
||||||
%stackage-updater))
|
%stackage-updater))
|
||||||
|
|
||||||
|
|
||||||
|
@ -45,9 +48,9 @@
|
||||||
(_ #f)))
|
(_ #f)))
|
||||||
|
|
||||||
(define (lts-info-packages lts-info)
|
(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
|
(match lts-info
|
||||||
((_ ("packages" pkg ...)) pkg)
|
((("packages" pkg ...) . _) pkg)
|
||||||
(_ '())))
|
(_ '())))
|
||||||
|
|
||||||
(define (leave-with-message fmt . args)
|
(define (leave-with-message fmt . args)
|
||||||
|
@ -85,7 +88,9 @@
|
||||||
(define (hackage-name-version name version)
|
(define (hackage-name-version name version)
|
||||||
(and version (string-append name "@" version)))
|
(and version (string-append name "@" version)))
|
||||||
|
|
||||||
(define* (stackage->guix-package package-name ; upstream name
|
(define stackage->guix-package
|
||||||
|
(memoize
|
||||||
|
(lambda* (package-name ; upstream name
|
||||||
#:key
|
#:key
|
||||||
(include-test-dependencies? #t)
|
(include-test-dependencies? #t)
|
||||||
(lts-version "")
|
(lts-version "")
|
||||||
|
@ -103,7 +108,13 @@ included in the Stackage LTS release."
|
||||||
(hackage->guix-package name-version
|
(hackage->guix-package name-version
|
||||||
#:include-test-dependencies?
|
#:include-test-dependencies?
|
||||||
include-test-dependencies?)
|
include-test-dependencies?)
|
||||||
(leave-with-message "~a: Stackage package not found" package-name))))
|
(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
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2017 Federico Beffa <beffa@fbengineering.ch>
|
;;; Copyright © 2017 Federico Beffa <beffa@fbengineering.ch>
|
||||||
|
;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
@ -26,6 +27,7 @@
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
#:use-module (srfi srfi-11)
|
#:use-module (srfi srfi-11)
|
||||||
#:use-module (srfi srfi-37)
|
#:use-module (srfi srfi-37)
|
||||||
|
#:use-module (srfi srfi-41)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
#:use-module (ice-9 format)
|
#:use-module (ice-9 format)
|
||||||
#:export (guix-import-stackage))
|
#:export (guix-import-stackage))
|
||||||
|
@ -43,11 +45,13 @@
|
||||||
(display (G_ "Usage: guix import stackage PACKAGE-NAME
|
(display (G_ "Usage: guix import stackage PACKAGE-NAME
|
||||||
Import and convert the LTS Stackage package for PACKAGE-NAME.\n"))
|
Import and convert the LTS Stackage package for PACKAGE-NAME.\n"))
|
||||||
(display (G_ "
|
(display (G_ "
|
||||||
-r VERSION, --lts-version=VERSION
|
-l VERSION, --lts-version=VERSION
|
||||||
specify the LTS version to use"))
|
specify the LTS version to use"))
|
||||||
(display (G_ "
|
(display (G_ "
|
||||||
-h, --help display this help and exit"))
|
-h, --help display this help and exit"))
|
||||||
(display (G_ "
|
(display (G_ "
|
||||||
|
-r, --recursive import packages recursively"))
|
||||||
|
(display (G_ "
|
||||||
-t, --no-test-dependencies don't include test-only dependencies"))
|
-t, --no-test-dependencies don't include test-only dependencies"))
|
||||||
(display (G_ "
|
(display (G_ "
|
||||||
-V, --version display version information and exit"))
|
-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-cons 'include-test-dependencies? #f
|
||||||
(alist-delete 'include-test-dependencies?
|
(alist-delete 'include-test-dependencies?
|
||||||
result))))
|
result))))
|
||||||
(option '(#\r "lts-version") #t #f
|
(option '(#\l "lts-version") #t #f
|
||||||
(lambda (opt name arg result)
|
(lambda (opt name arg result)
|
||||||
(alist-cons 'lts-version arg
|
(alist-cons 'lts-version arg
|
||||||
(alist-delete 'lts-version
|
(alist-delete 'lts-version
|
||||||
result))))
|
result))))
|
||||||
|
(option '(#\r "recursive") #f #f
|
||||||
|
(lambda (opt name arg result)
|
||||||
|
(alist-cons 'recursive #t result)))
|
||||||
%standard-import-options))
|
%standard-import-options))
|
||||||
|
|
||||||
|
|
||||||
|
@ -90,6 +97,27 @@ Import and convert the LTS Stackage package for PACKAGE-NAME.\n"))
|
||||||
(alist-cons 'argument arg result))
|
(alist-cons 'argument arg result))
|
||||||
%default-options))
|
%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))
|
(let* ((opts (parse-options))
|
||||||
(args (filter-map (match-lambda
|
(args (filter-map (match-lambda
|
||||||
(('argument . value)
|
(('argument . value)
|
||||||
|
@ -99,15 +127,11 @@ Import and convert the LTS Stackage package for PACKAGE-NAME.\n"))
|
||||||
(match args
|
(match args
|
||||||
((package-name)
|
((package-name)
|
||||||
(with-error-handling
|
(with-error-handling
|
||||||
(let ((sexp (stackage->guix-package
|
(run-importer package-name opts
|
||||||
package-name
|
(lambda ()
|
||||||
#:include-test-dependencies?
|
(leave (G_ "failed to download cabal file \
|
||||||
(assoc-ref opts 'include-test-dependencies?)
|
for package '~a'~%")
|
||||||
#:lts-version (assoc-ref opts 'lts-version))))
|
package-name)))))
|
||||||
(unless sexp
|
|
||||||
(leave (G_ "failed to download cabal file for package '~a'~%")
|
|
||||||
package-name))
|
|
||||||
sexp)))
|
|
||||||
(()
|
(()
|
||||||
(leave (G_ "too few arguments~%")))
|
(leave (G_ "too few arguments~%")))
|
||||||
((many ...)
|
((many ...)
|
||||||
|
|
Loading…
Reference in New Issue