* [bug#32396] [PATCH] import: hackage: Support recursive importing.
@ 2018-08-08 10:15 Ricardo Wurmus
2018-08-08 13:29 ` Ricardo Wurmus
0 siblings, 1 reply; 4+ messages in thread
From: Ricardo Wurmus @ 2018-08-08 10:15 UTC (permalink / raw)
To: 32396; +Cc: Ricardo Wurmus
* guix/import/hackage.scm (hackage-recursive-import): New procedure.
(hackage-module->sexp): Return dependencies alongside dependencies.
(hackage->guix-package): Memoize results.
* guix/scripts/import/hackage.scm (%options, guix-import-hackage): Support
recursive importing.
* doc/guix.texi (Invoking guix import): Document option.
---
doc/guix.texi | 5 ++
guix/import/hackage.scm | 124 ++++++++++++++++++--------------
guix/scripts/import/hackage.scm | 24 +++++--
3 files changed, 94 insertions(+), 59 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 080b091b3..d833e12cb 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -6661,6 +6661,11 @@ The value associated with a flag has to be either the symbol
has to conform to the Cabal file format definition. The default value
associated with the keys @code{os}, @code{arch} and @code{impl} is
@samp{linux}, @samp{x86_64} and @samp{ghc}, respectively.
+@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 latest version of the
diff --git a/guix/import/hackage.scm b/guix/import/hackage.scm
index 3b138f8c9..74b497045 100644
--- a/guix/import/hackage.scm
+++ b/guix/import/hackage.scm
@@ -30,15 +30,17 @@
#:use-module ((guix utils) #:select (package-name->name+version
canonical-newline-port))
#:use-module (guix http-client)
- #:use-module ((guix import utils) #:select (factorize-uri))
+ #:use-module ((guix import utils) #:select (factorize-uri recursive-import))
#:use-module (guix import cabal)
#:use-module (guix store)
#:use-module (guix hash)
#:use-module (guix base32)
+ #:use-module (guix memoization)
#:use-module (guix upstream)
#:use-module (guix packages)
#:use-module ((guix utils) #:select (call-with-temporary-output-file))
#:export (hackage->guix-package
+ hackage-recursive-import
%hackage-updater
guix-package->hackage-name
@@ -205,32 +207,34 @@ representation of a Cabal file as produced by 'read-cabal'."
(define source-url
(hackage-source-url name version))
+ (define hackage-dependencies
+ ((compose (cut filter-dependencies <>
+ (cabal-package-name cabal))
+ (cut cabal-dependencies->names <>))
+ cabal))
+
+ (define hackage-native-dependencies
+ ((compose (cut filter-dependencies <>
+ (cabal-package-name cabal))
+ ;; FIXME: Check include-test-dependencies?
+ (lambda (cabal)
+ (append (if include-test-dependencies?
+ (cabal-test-dependencies->names cabal)
+ '())
+ (cabal-custom-setup-dependencies->names cabal))))
+ cabal))
+
(define dependencies
- (let ((names
- (map hackage-name->package-name
- ((compose (cut filter-dependencies <>
- (cabal-package-name cabal))
- (cut cabal-dependencies->names <>))
- cabal))))
- (map (lambda (name)
- (list name (list 'unquote (string->symbol name))))
- names)))
+ (map (lambda (name)
+ (list name (list 'unquote (string->symbol name))))
+ (map hackage-name->package-name
+ hackage-dependencies)))
(define native-dependencies
- (let ((names
- (map hackage-name->package-name
- ((compose (cut filter-dependencies <>
- (cabal-package-name cabal))
- ;; FIXME: Check include-test-dependencies?
- (lambda (cabal)
- (append (if include-test-dependencies?
- (cabal-test-dependencies->names cabal)
- '())
- (cabal-custom-setup-dependencies->names cabal))))
- cabal))))
- (map (lambda (name)
- (list name (list 'unquote (string->symbol name))))
- names)))
+ (map (lambda (name)
+ (list name (list 'unquote (string->symbol name))))
+ (map hackage-name->package-name
+ hackage-native-dependencies)))
(define (maybe-inputs input-type inputs)
(match inputs
@@ -247,31 +251,35 @@ representation of a Cabal file as produced by 'read-cabal'."
(let ((tarball (with-store store
(download-to-store store source-url))))
- `(package
- (name ,(hackage-name->package-name name))
- (version ,version)
- (source (origin
- (method url-fetch)
- (uri (string-append ,@(factorize-uri source-url version)))
- (sha256
- (base32
- ,(if tarball
- (bytevector->nix-base32-string (file-sha256 tarball))
- "failed to download tar archive")))))
- (build-system haskell-build-system)
- ,@(maybe-inputs 'inputs dependencies)
- ,@(maybe-inputs 'native-inputs native-dependencies)
- ,@(maybe-arguments)
- (home-page ,(cabal-package-home-page cabal))
- (synopsis ,(cabal-package-synopsis cabal))
- (description ,(cabal-package-description cabal))
- (license ,(string->license (cabal-package-license cabal))))))
+ (values
+ `(package
+ (name ,(hackage-name->package-name name))
+ (version ,version)
+ (source (origin
+ (method url-fetch)
+ (uri (string-append ,@(factorize-uri source-url version)))
+ (sha256
+ (base32
+ ,(if tarball
+ (bytevector->nix-base32-string (file-sha256 tarball))
+ "failed to download tar archive")))))
+ (build-system haskell-build-system)
+ ,@(maybe-inputs 'inputs dependencies)
+ ,@(maybe-inputs 'native-inputs native-dependencies)
+ ,@(maybe-arguments)
+ (home-page ,(cabal-package-home-page cabal))
+ (synopsis ,(cabal-package-synopsis cabal))
+ (description ,(cabal-package-description cabal))
+ (license ,(string->license (cabal-package-license cabal))))
+ (append hackage-dependencies hackage-native-dependencies))))
-(define* (hackage->guix-package package-name #:key
- (include-test-dependencies? #t)
- (port #f)
- (cabal-environment '()))
- "Fetch the Cabal file for PACKAGE-NAME from hackage.haskell.org, or, if the
+(define hackage->guix-package
+ (memoize
+ (lambda* (package-name #:key
+ (include-test-dependencies? #t)
+ (port #f)
+ (cabal-environment '()))
+ "Fetch the Cabal file for PACKAGE-NAME from hackage.haskell.org, or, if the
called with keyword parameter PORT, from PORT. Return the `package'
S-expression corresponding to that package, or #f on failure.
CABAL-ENVIRONMENT is an alist defining the environment in which the Cabal
@@ -281,13 +289,19 @@ symbol 'true' or 'false'. The value associated with other keys has to conform
to the Cabal file format definition. The default value associated with the
keys \"os\", \"arch\" and \"impl\" is \"linux\", \"x86_64\" and \"ghc\"
respectively."
- (let ((cabal-meta (if port
- (read-cabal (canonical-newline-port port))
- (hackage-fetch package-name))))
- (and=> cabal-meta (compose (cut hackage-module->sexp <>
- #:include-test-dependencies?
- include-test-dependencies?)
- (cut eval-cabal <> cabal-environment)))))
+ (let ((cabal-meta (if port
+ (read-cabal (canonical-newline-port port))
+ (hackage-fetch package-name))))
+ (and=> cabal-meta (compose (cut hackage-module->sexp <>
+ #:include-test-dependencies?
+ include-test-dependencies?)
+ (cut eval-cabal <> cabal-environment)))))))
+
+(define* (hackage-recursive-import package-name)
+ (recursive-import package-name #f
+ #:repo->guix-package (lambda (name repo)
+ (hackage->guix-package name))
+ #:guix-name hackage-name->package-name))
(define (hackage-package? package)
"Return #t if PACKAGE is a Haskell package from Hackage."
diff --git a/guix/scripts/import/hackage.scm b/guix/scripts/import/hackage.scm
index 969f63784..8cf670e85 100644
--- a/guix/scripts/import/hackage.scm
+++ b/guix/scripts/import/hackage.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 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-hackage))
@@ -89,6 +91,9 @@ version.\n"))
(alist-cons 'cabal-environment (read/eval arg)
(alist-delete 'cabal-environment
result))))
+ (option '(#\r "recursive") #f #f
+ (lambda (opt name arg result)
+ (alist-cons 'recursive #t result)))
%standard-import-options))
\f
@@ -136,11 +141,22 @@ from standard input~%")))))
(leave (G_ "too many arguments~%"))))
(match args
((package-name)
- (run-importer package-name opts
- (lambda ()
- (leave (G_ "failed to download cabal file \
+ (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
+ (hackage-recursive-import package-name))))
+ ;; Single import
+ (run-importer package-name opts
+ (lambda ()
+ (leave (G_ "failed to download cabal file \
for package '~a'~%")
- package-name))))
+ package-name)))))
(()
(leave (G_ "too few arguments~%")))
((many ...)
--
2.18.0
^ permalink raw reply related [flat|nested] 4+ messages in thread
* [bug#32396] [PATCH] import: hackage: Support recursive importing.
2018-08-08 10:15 [bug#32396] [PATCH] import: hackage: Support recursive importing Ricardo Wurmus
@ 2018-08-08 13:29 ` Ricardo Wurmus
2018-08-09 22:56 ` Danny Milosavljevic
0 siblings, 1 reply; 4+ messages in thread
From: Ricardo Wurmus @ 2018-08-08 13:29 UTC (permalink / raw)
To: 32396; +Cc: Ricardo Wurmus
* guix/import/hackage.scm (hackage-recursive-import): New procedure.
(hackage-module->sexp): Return dependencies alongside dependencies.
(hackage->guix-package): Memoize results.
* guix/scripts/import/hackage.scm (show-help, %options, guix-import-hackage):
Support recursive importing.
* doc/guix.texi (Invoking guix import): Document option.
---
doc/guix.texi | 5 ++
guix/import/hackage.scm | 124 ++++++++++++++++++--------------
guix/scripts/import/hackage.scm | 37 +++++++---
3 files changed, 102 insertions(+), 64 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 080b091b3..d833e12cb 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -6661,6 +6661,11 @@ The value associated with a flag has to be either the symbol
has to conform to the Cabal file format definition. The default value
associated with the keys @code{os}, @code{arch} and @code{impl} is
@samp{linux}, @samp{x86_64} and @samp{ghc}, respectively.
+@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 latest version of the
diff --git a/guix/import/hackage.scm b/guix/import/hackage.scm
index 3b138f8c9..3c00f680b 100644
--- a/guix/import/hackage.scm
+++ b/guix/import/hackage.scm
@@ -30,15 +30,17 @@
#:use-module ((guix utils) #:select (package-name->name+version
canonical-newline-port))
#:use-module (guix http-client)
- #:use-module ((guix import utils) #:select (factorize-uri))
+ #:use-module ((guix import utils) #:select (factorize-uri recursive-import))
#:use-module (guix import cabal)
#:use-module (guix store)
#:use-module (guix hash)
#:use-module (guix base32)
+ #:use-module (guix memoization)
#:use-module (guix upstream)
#:use-module (guix packages)
#:use-module ((guix utils) #:select (call-with-temporary-output-file))
#:export (hackage->guix-package
+ hackage-recursive-import
%hackage-updater
guix-package->hackage-name
@@ -205,32 +207,34 @@ representation of a Cabal file as produced by 'read-cabal'."
(define source-url
(hackage-source-url name version))
+ (define hackage-dependencies
+ ((compose (cut filter-dependencies <>
+ (cabal-package-name cabal))
+ (cut cabal-dependencies->names <>))
+ cabal))
+
+ (define hackage-native-dependencies
+ ((compose (cut filter-dependencies <>
+ (cabal-package-name cabal))
+ ;; FIXME: Check include-test-dependencies?
+ (lambda (cabal)
+ (append (if include-test-dependencies?
+ (cabal-test-dependencies->names cabal)
+ '())
+ (cabal-custom-setup-dependencies->names cabal))))
+ cabal))
+
(define dependencies
- (let ((names
- (map hackage-name->package-name
- ((compose (cut filter-dependencies <>
- (cabal-package-name cabal))
- (cut cabal-dependencies->names <>))
- cabal))))
- (map (lambda (name)
- (list name (list 'unquote (string->symbol name))))
- names)))
+ (map (lambda (name)
+ (list name (list 'unquote (string->symbol name))))
+ (map hackage-name->package-name
+ hackage-dependencies)))
(define native-dependencies
- (let ((names
- (map hackage-name->package-name
- ((compose (cut filter-dependencies <>
- (cabal-package-name cabal))
- ;; FIXME: Check include-test-dependencies?
- (lambda (cabal)
- (append (if include-test-dependencies?
- (cabal-test-dependencies->names cabal)
- '())
- (cabal-custom-setup-dependencies->names cabal))))
- cabal))))
- (map (lambda (name)
- (list name (list 'unquote (string->symbol name))))
- names)))
+ (map (lambda (name)
+ (list name (list 'unquote (string->symbol name))))
+ (map hackage-name->package-name
+ hackage-native-dependencies)))
(define (maybe-inputs input-type inputs)
(match inputs
@@ -247,31 +251,35 @@ representation of a Cabal file as produced by 'read-cabal'."
(let ((tarball (with-store store
(download-to-store store source-url))))
- `(package
- (name ,(hackage-name->package-name name))
- (version ,version)
- (source (origin
- (method url-fetch)
- (uri (string-append ,@(factorize-uri source-url version)))
- (sha256
- (base32
- ,(if tarball
- (bytevector->nix-base32-string (file-sha256 tarball))
- "failed to download tar archive")))))
- (build-system haskell-build-system)
- ,@(maybe-inputs 'inputs dependencies)
- ,@(maybe-inputs 'native-inputs native-dependencies)
- ,@(maybe-arguments)
- (home-page ,(cabal-package-home-page cabal))
- (synopsis ,(cabal-package-synopsis cabal))
- (description ,(cabal-package-description cabal))
- (license ,(string->license (cabal-package-license cabal))))))
+ (values
+ `(package
+ (name ,(hackage-name->package-name name))
+ (version ,version)
+ (source (origin
+ (method url-fetch)
+ (uri (string-append ,@(factorize-uri source-url version)))
+ (sha256
+ (base32
+ ,(if tarball
+ (bytevector->nix-base32-string (file-sha256 tarball))
+ "failed to download tar archive")))))
+ (build-system haskell-build-system)
+ ,@(maybe-inputs 'inputs dependencies)
+ ,@(maybe-inputs 'native-inputs native-dependencies)
+ ,@(maybe-arguments)
+ (home-page ,(cabal-package-home-page cabal))
+ (synopsis ,(cabal-package-synopsis cabal))
+ (description ,(cabal-package-description cabal))
+ (license ,(string->license (cabal-package-license cabal))))
+ (append hackage-dependencies hackage-native-dependencies))))
-(define* (hackage->guix-package package-name #:key
- (include-test-dependencies? #t)
- (port #f)
- (cabal-environment '()))
- "Fetch the Cabal file for PACKAGE-NAME from hackage.haskell.org, or, if the
+(define hackage->guix-package
+ (memoize
+ (lambda* (package-name #:key
+ (include-test-dependencies? #t)
+ (port #f)
+ (cabal-environment '()))
+ "Fetch the Cabal file for PACKAGE-NAME from hackage.haskell.org, or, if the
called with keyword parameter PORT, from PORT. Return the `package'
S-expression corresponding to that package, or #f on failure.
CABAL-ENVIRONMENT is an alist defining the environment in which the Cabal
@@ -281,13 +289,19 @@ symbol 'true' or 'false'. The value associated with other keys has to conform
to the Cabal file format definition. The default value associated with the
keys \"os\", \"arch\" and \"impl\" is \"linux\", \"x86_64\" and \"ghc\"
respectively."
- (let ((cabal-meta (if port
- (read-cabal (canonical-newline-port port))
- (hackage-fetch package-name))))
- (and=> cabal-meta (compose (cut hackage-module->sexp <>
- #:include-test-dependencies?
- include-test-dependencies?)
- (cut eval-cabal <> cabal-environment)))))
+ (let ((cabal-meta (if port
+ (read-cabal (canonical-newline-port port))
+ (hackage-fetch package-name))))
+ (and=> cabal-meta (compose (cut hackage-module->sexp <>
+ #:include-test-dependencies?
+ include-test-dependencies?)
+ (cut eval-cabal <> cabal-environment)))))))
+
+(define* (hackage-recursive-import package-name . args)
+ (recursive-import package-name #f
+ #:repo->guix-package (lambda (name repo)
+ (apply hackage->guix-package (cons name args)))
+ #:guix-name hackage-name->package-name))
(define (hackage-package? package)
"Return #t if PACKAGE is a Haskell package from Hackage."
diff --git a/guix/scripts/import/hackage.scm b/guix/scripts/import/hackage.scm
index 969f63784..f4aac6107 100644
--- a/guix/scripts/import/hackage.scm
+++ b/guix/scripts/import/hackage.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 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-hackage))
@@ -57,6 +59,8 @@ version.\n"))
(display (G_ "
-h, --help display this help and exit"))
(display (G_ "
+ -r, --recursive import packages recursively"))
+ (display (G_ "
-s, --stdin read from standard input"))
(display (G_ "
-t, --no-test-dependencies don't include test-only dependencies"))
@@ -89,6 +93,9 @@ version.\n"))
(alist-cons 'cabal-environment (read/eval arg)
(alist-delete 'cabal-environment
result))))
+ (option '(#\r "recursive") #f #f
+ (lambda (opt name arg result)
+ (alist-cons 'recursive #t result)))
%standard-import-options))
\f
@@ -107,15 +114,27 @@ version.\n"))
%default-options))
(define (run-importer package-name opts error-fn)
- (let ((sexp (hackage->guix-package
- package-name
- #:include-test-dependencies?
- (assoc-ref opts 'include-test-dependencies?)
- #:port (if (assoc-ref opts 'read-from-stdin?)
- (current-input-port)
- #f)
- #:cabal-environment
- (assoc-ref opts 'cabal-environment))))
+ (let* ((arguments (list
+ package-name
+ #:include-test-dependencies?
+ (assoc-ref opts 'include-test-dependencies?)
+ #:port (if (assoc-ref opts 'read-from-stdin?)
+ (current-input-port)
+ #f)
+ #:cabal-environment
+ (assoc-ref opts 'cabal-environment)))
+ (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 hackage-recursive-import arguments))))
+ ;; Single import
+ (apply hackage->guix-package arguments))))
(unless sexp (error-fn))
sexp))
--
2.18.0
^ permalink raw reply related [flat|nested] 4+ messages in thread
* [bug#32396] [PATCH] import: hackage: Support recursive importing.
2018-08-08 13:29 ` Ricardo Wurmus
@ 2018-08-09 22:56 ` Danny Milosavljevic
2018-08-11 16:54 ` bug#32396: " Ricardo Wurmus
0 siblings, 1 reply; 4+ messages in thread
From: Danny Milosavljevic @ 2018-08-09 22:56 UTC (permalink / raw)
To: Ricardo Wurmus; +Cc: 32396
[-- Attachment #1: Type: text/plain, Size: 7 bytes --]
LGTM!
[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 488 bytes --]
^ permalink raw reply [flat|nested] 4+ messages in thread
* bug#32396: [PATCH] import: hackage: Support recursive importing.
2018-08-09 22:56 ` Danny Milosavljevic
@ 2018-08-11 16:54 ` Ricardo Wurmus
0 siblings, 0 replies; 4+ messages in thread
From: Ricardo Wurmus @ 2018-08-11 16:54 UTC (permalink / raw)
To: Danny Milosavljevic; +Cc: 32396-done
Danny Milosavljevic <dannym@scratchpost.org> writes:
> LGTM!
Thanks. Pushed to the “master” branch with commit
a92859616201dbf0cec36d3c746125d645c88c79.
--
Ricardo
^ permalink raw reply [flat|nested] 4+ messages in thread
end of thread, other threads:[~2018-08-11 16:55 UTC | newest]
Thread overview: 4+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2018-08-08 10:15 [bug#32396] [PATCH] import: hackage: Support recursive importing Ricardo Wurmus
2018-08-08 13:29 ` Ricardo Wurmus
2018-08-09 22:56 ` Danny Milosavljevic
2018-08-11 16:54 ` bug#32396: " Ricardo Wurmus
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.