Subject: Re: [bug#36048] [PATCH] guix: import: hackage: handle hackage revisions
From: Timothy Sample <[email-masked]>
To: Robert Vollmert <[email-masked]>
Cc: [email-masked]
Date: Thu, 13 Jun 2019 22:28:20 -0400
List-Id: <debbugs-submit.debbugs.gnu.org>

Hi Robert,

Robert Vollmert <[email-masked]> writes:

> Hackage packages can have metadata revision (cabal-file only)
> that aren't reflected in the source archive. haskell-build-system
> has support for this, but previously `guix import hackage` would
> create a definition based on the new cabal file but building using
> the old cabal file.
>
> Compare https://debbugs.gnu.org/cgi/bugreport.cgi?bug=35750.
>
> * guix/import/cabal.scm: Parse `x-revision:` property.
> * guix/import/hackage.scm: Compute hash of cabal file, and write
> cabal-revision build system arguments.
> * guix/tests/hackage.scm: Test import of cabal revision.
> ---
>  guix/import/cabal.scm   |  7 +++--
>  guix/import/hackage.scm | 69 ++++++++++++++++++++++++++++-------------
>  tests/hackage.scm       | 45 +++++++++++++++++++++++++++
>  3 files changed, 98 insertions(+), 23 deletions(-)
>
> 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 @@
>              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 @@ If #f use the function 'port-filename' to obtain it."
>  ;; information of the Cabal file, but only the ones we currently are
>  ;; interested in.
>  (define-record-type <cabal-package>
> -  (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 @@ See the manual for limitations.")))))))
>    (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 @@ See the manual for limitations.")))))))
>             (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..b739b61157 100644
> --- a/guix/import/hackage.scm
> +++ b/guix/import/hackage.scm
> @@ -117,19 +117,34 @@ version is returned."
>            (#f name)
>            (m (match:substring m 1)))))))
>  
> +(define (read-cabal-and-hash port)
> +  "Given an input PORT, read a cabal file and its base32 hash from it,
> +and return both 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 base32 hash. If the version part
> +is omitted from the package name, then fetch the latest version. Return #f
> +on failure."
> +  (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 @@ package being processed and is used to filter references to itself."
>                                     (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 @@ representation of a Cabal file as produced by 'read-cabal'."
>                     (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,13 +319,15 @@ 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-values (((cabal hash)
> +                (if port
> +                    (read-cabal-and-hash port)
> +                    (hackage-fetch-and-hash package-name))))
> +    (and=> cabal (compose (cut hackage-module->sexp <>
> +                               hash
> +                               #:include-test-dependencies?
> +                               include-test-dependencies?)
> +                          (cut eval-cabal <> cabal-environment)))))
>  
>  (define hackage->guix-package/m                   ;memoized variant
>    (memoize hackage->guix-package))
> 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 @@ executable cabal
>  (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"))

Applied as ca45da9fc9b1eee399ce4344b18cbb129daeca4c!

I did make a few changes.  Most notably, I tried importing a package and
it didn’t work!  It turns out that “http-fetch” returns two values, so I
told “let-values” to ignore the second one.  Other than that, I made a
few changes to the commit message and docstrings, and kept “cabal-meta”
and “cabal-hash” from before (instead of “cabal” and “hash”).

Thanks for the patch!

-- Tim