ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-25 05:48:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

import: hackage: Support recursive importing.

Browse source 
* 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.
This commit is contained in:
Ricardo Wurmus 2018-08-08 15:29:18 +02:00 committed by Ricardo Wurmus
parent 424fd76828
commit a928596162
No known key found for this signature in database
GPG key ID: 197A5888235FACAC
3 changed files with 102 additions and 64 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
doc/guix.texi
View file

@ -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

124
guix/import/hackage.scm
View file

@ -30,15 +30,17 @@ (define-module (guix import hackage)
#: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 @@ (define version
(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 @@ (define (maybe-arguments)
(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 @@ (define* (hackage->guix-package package-name #:key
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."

37
guix/scripts/import/hackage.scm
View file

@ -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 @@ (define-module (guix scripts import hackage)
#: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 @@ (define (show-help)
(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 @@ (define %options
(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))
@ -107,15 +114,27 @@ (define (parse-options)
%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))