From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:4830:134:3::10]:58070) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1fnLVe-0005Dq-BC for guix-patches@gnu.org; Wed, 08 Aug 2018 06:16:13 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1fnLVb-0001Gp-0A for guix-patches@gnu.org; Wed, 08 Aug 2018 06:16:06 -0400 Received: from debbugs.gnu.org ([208.118.235.43]:39205) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1fnLVa-0001Gf-RR for guix-patches@gnu.org; Wed, 08 Aug 2018 06:16:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1fnLVa-0002OG-J3 for guix-patches@gnu.org; Wed, 08 Aug 2018 06:16:02 -0400 Subject: [bug#32396] [PATCH] import: hackage: Support recursive importing. Resent-Message-ID: Received: from eggs.gnu.org ([2001:4830:134:3::10]:57837) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1fnLUy-00054k-FG for guix-patches@gnu.org; Wed, 08 Aug 2018 06:15:26 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1fnLUv-0000vd-4A for guix-patches@gnu.org; Wed, 08 Aug 2018 06:15:24 -0400 Received: from pegasus.bbbm.mdc-berlin.de ([141.80.25.20]:57588) by eggs.gnu.org with esmtps (TLS1.0:DHE_RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1fnLUt-0000uN-Pi for guix-patches@gnu.org; Wed, 08 Aug 2018 06:15:20 -0400 Received: from localhost (localhost [127.0.0.1]) by pegasus.bbbm.mdc-berlin.de (Postfix) with ESMTP id A500F9CBD1F for ; Wed, 8 Aug 2018 12:15:17 +0200 (CEST) Received: from pegasus.bbbm.mdc-berlin.de ([127.0.0.1]) by localhost (pegasus.bbbm.mdc-berlin.de [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id ehVHiEMh5YPc for ; Wed, 8 Aug 2018 12:15:12 +0200 (CEST) Received: from SW-IT-P-CAS2.mdc-berlin.net (puck.citx.mdc-berlin.de [141.80.36.101]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-SHA384 (256/256 bits)) (No client certificate requested) by pegasus.bbbm.mdc-berlin.de (Postfix) with ESMTPS for ; Wed, 8 Aug 2018 12:15:12 +0200 (CEST) From: Ricardo Wurmus Date: Wed, 8 Aug 2018 12:15:10 +0200 Message-ID: <20180808101510.12136-1-ricardo.wurmus@mdc-berlin.de> MIME-Version: 1.0 Content-Type: text/plain; charset="UTF-8" Content-Transfer-Encoding: quoted-printable List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+kyle=kyleam.com@gnu.org Sender: "Guix-patches" To: 32396@debbugs.gnu.org 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): Suppor= t 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 =20 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-im= port)) #: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 =20 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)) =20 + (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))) =20 (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->na= mes 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))) =20 (define (maybe-inputs input-type inputs) (match inputs @@ -247,31 +251,35 @@ representation of a Cabal file as produced by 'read= -cabal'." =20 (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 tarb= all)) - "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 versio= n))) + (sha256 + (base32 + ,(if tarball + (bytevector->nix-base32-string (file-sha256 tar= ball)) + "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)))) =20 -(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, i= f 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 Caba= l @@ -281,13 +289,19 @@ symbol 'true' or 'false'. The value associated wit= h 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=3D> cabal-meta (compose (cut hackage-module->sexp <> - #:include-test-dependencies?=20 - include-test-dependencies?) - (cut eval-cabal <> cabal-environment))))) + (let ((cabal-meta (if port + (read-cabal (canonical-newline-port port)) + (hackage-fetch package-name)))) + (and=3D> 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)) =20 (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/hackag= e.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 =C2=A9 2015 Federico Beffa +;;; Copyright =C2=A9 2018 Ricardo Wurmus ;;; ;;; 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)) =20 =0C @@ -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 ...) --=20 2.18.0