diff --git a/guix/import/cabal.scm b/guix/import/cabal.scm index 1a87be0b00..7dfe771e41 100644 --- a/guix/import/cabal.scm +++ b/guix/import/cabal.scm @@ -40,6 +40,7 @@ (define-module (guix import cabal) cabal-package? cabal-package-name cabal-package-version + cabal-package-revision cabal-package-license cabal-package-home-page cabal-package-source-repository @@ -638,13 +639,14 @@ (define* (read-cabal #:optional (port (current-input-port)) ;; information of the Cabal file, but only the ones we currently are ;; interested in. (define-record-type - (make-cabal-package name version license home-page source-repository + (make-cabal-package name version revision license home-page source-repository synopsis description executables lib test-suites flags eval-environment custom-setup) cabal-package? (name cabal-package-name) (version cabal-package-version) + (revision cabal-package-revision) (license cabal-package-license) (home-page cabal-package-home-page) (source-repository cabal-package-source-repository) @@ -838,6 +840,7 @@ (define (eval sexp) (define (cabal-evaluated-sexp->package evaluated-sexp) (let* ((name (lookup-join evaluated-sexp "name")) (version (lookup-join evaluated-sexp "version")) + (revision (lookup-join evaluated-sexp "x-revision")) (license (lookup-join evaluated-sexp "license")) (home-page (lookup-join evaluated-sexp "homepage")) (home-page-or-hackage @@ -856,7 +859,7 @@ (define (cabal-evaluated-sexp->package evaluated-sexp) (custom-setup (match (make-cabal-section evaluated-sexp 'custom-setup) ((x) x) (_ #f)))) - (make-cabal-package name version license home-page-or-hackage + (make-cabal-package name version revision license home-page-or-hackage source-repository synopsis description executables lib test-suites flags eval-environment custom-setup))) diff --git a/guix/import/hackage.scm b/guix/import/hackage.scm index 366256b40d..6f426af900 100644 --- a/guix/import/hackage.scm +++ b/guix/import/hackage.scm @@ -117,19 +117,34 @@ (define guix-package->hackage-name (#f name) (m (match:substring m 1))))))) +(define (read-cabal-and-hash port) + "Read a Cabal file from PORT and return it and its hash in nix-base32 +format as two values." + (let-values (((port get-hash) (open-sha256-input-port port))) + (values (read-cabal (canonical-newline-port port)) + (bytevector->nix-base32-string (get-hash))))) + +(define (hackage-fetch-and-hash name-version) + "Fetch the latest Cabal revision for the package NAME-VERSION, and return +two values: the parsed Cabal file and its hash in nix-base32 format. If the +version part is omitted from the package name, then fetch the latest +version. On failure, both return values will be #f." + (guard (c ((and (http-get-error? c) + (= 404 (http-get-error-code c))) + (values #f #f))) ;"expected" if package is unknown + (let*-values (((name version) (package-name->name+version name-version)) + ((url) (hackage-cabal-url name version)) + ((port _) (http-fetch url)) + ((cabal hash) (read-cabal-and-hash port))) + (close-port port) + (values cabal hash)))) + (define (hackage-fetch name-version) "Return the Cabal file for the package NAME-VERSION, or #f on failure. If the version part is omitted from the package name, then return the latest version." - (guard (c ((and (http-get-error? c) - (= 404 (http-get-error-code c))) - #f)) ;"expected" if package is unknown - (let-values (((name version) (package-name->name+version name-version))) - (let* ((url (hackage-cabal-url name version)) - (port (http-fetch url)) - (result (read-cabal (canonical-newline-port port)))) - (close-port port) - result)))) + (let-values (((cabal hash) (hackage-fetch-and-hash name-version))) + cabal)) (define string->license ;; List of valid values from @@ -198,15 +213,20 @@ (define (filter-dependencies dependencies own-name) (cons own-name ghc-standard-libraries)))) dependencies)) -(define* (hackage-module->sexp cabal #:key (include-test-dependencies? #t)) +(define* (hackage-module->sexp cabal cabal-hash + #:key (include-test-dependencies? #t)) "Return the `package' S-expression for a Cabal package. CABAL is the -representation of a Cabal file as produced by 'read-cabal'." +representation of a Cabal file as produced by 'read-cabal'. CABAL-HASH is +the hash of the Cabal file." (define name (cabal-package-name cabal)) (define version (cabal-package-version cabal)) + + (define revision + (cabal-package-revision cabal)) (define source-url (hackage-source-url name version)) @@ -252,9 +272,14 @@ (define (maybe-inputs input-type inputs) (list 'quasiquote inputs)))))) (define (maybe-arguments) - (if (not include-test-dependencies?) - '((arguments `(#:tests? #f))) - '())) + (match (append (if (not include-test-dependencies?) + '(#:tests? #f) + '()) + (if (not (string-null? revision)) + `(#:cabal-revision (,revision ,cabal-hash)) + '())) + (() '()) + (args `((arguments (,'quasiquote ,args)))))) (let ((tarball (with-store store (download-to-store store source-url)))) @@ -294,10 +319,11 @@ (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 <> + (let-values (((cabal-meta cabal-hash) + (if port + (read-cabal-and-hash port) + (hackage-fetch-and-hash package-name)))) + (and=> cabal-meta (compose (cut hackage-module->sexp <> cabal-hash #:include-test-dependencies? include-test-dependencies?) (cut eval-cabal <> cabal-environment))))) diff --git a/tests/hackage.scm b/tests/hackage.scm index 38a5825af7..14176b2cf9 100644 --- a/tests/hackage.scm +++ b/tests/hackage.scm @@ -274,6 +274,51 @@ (define test-cabal-multiline-braced (test-assert "hackage->guix-package test multiline desc (braced)" (eval-test-with-cabal test-cabal-multiline-braced match-ghc-foo)) +;; Check Hackage Cabal revisions. +(define test-cabal-revision + "name: foo +version: 1.0.0 +x-revision: 2 +homepage: http://test.org +synopsis: synopsis +description: description +license: BSD3 +executable cabal + build-depends: + HTTP >= 4000.2.5 && < 4000.3, + mtl >= 2.0 && < 3 +") + +(define-package-matcher match-ghc-foo-revision + ('package + ('name "ghc-foo") + ('version "1.0.0") + ('source + ('origin + ('method 'url-fetch) + ('uri ('string-append + "https://hackage.haskell.org/package/foo/foo-" + 'version + ".tar.gz")) + ('sha256 + ('base32 + (? string? hash))))) + ('build-system 'haskell-build-system) + ('inputs + ('quasiquote + (("ghc-http" ('unquote 'ghc-http))))) + ('arguments + ('quasiquote + ('#:cabal-revision + ("2" "0xxd88fb659f0krljidbvvmkh9ppjnx83j0nqzx8whcg4n5qbyng")))) + ('home-page "http://test.org") + ('synopsis (? string?)) + ('description (? string?)) + ('license 'bsd-3))) + +(test-assert "hackage->guix-package test cabal revision" + (eval-test-with-cabal test-cabal-revision match-ghc-foo-revision)) + (test-assert "read-cabal test 1" (match (call-with-input-string test-read-cabal-1 read-cabal) ((("name" ("test-me"))