03/257: build-system: haskell: Add #:cabal-revision argument.

[Ricardo Wurmus]

rekado pushed a commit to branch wip-haskell
in repository guix.

commit ff4bcdffba3bf54cf0aec4f69ef1e901f85c2fd6
Author: Timothy Sample <address@hidden>
Date:   Thu Aug 30 22:08:59 2018 -0400

    build-system: haskell: Add #:cabal-revision argument.
    
    Add a #:cabal-revision argument for specifying which Cabal file revision
    from Hackage should be used.
    
    * guix/build-system/haskell.scm (source-url->revision-url): New function.
    (lower): Accept a cabal-revision keyword argument, convert it to an
    origin record, and add it to the resulting bag's host-inputs.
    (haskell-build): Pass the cabal-revision input to the builder as an
    argument.
    * guix/build/haskell-build-system.scm (patch-cabal-file): New phase.
    (%standard-phases): Add it.
---
 guix/build-system/haskell.scm       | 32 +++++++++++++++++++++++++++++++-
 guix/build/haskell-build-system.scm | 12 ++++++++++++
 2 files changed, 43 insertions(+), 1 deletion(-)

diff --git a/guix/build-system/haskell.scm b/guix/build-system/haskell.scm
index 1cb7346..1ec11c7 100644
--- a/guix/build-system/haskell.scm
+++ b/guix/build-system/haskell.scm
@@ -21,6 +21,7 @@
   #:use-module (guix utils)
   #:use-module (guix packages)
   #:use-module (guix derivations)
+  #:use-module (guix download)
   #:use-module (guix search-paths)
   #:use-module (guix build-system)
   #:use-module (guix build-system gnu)
@@ -48,14 +49,35 @@
   (let ((haskell (resolve-interface '(gnu packages haskell))))
     (module-ref haskell 'ghc)))
 
+(define (source-url->revision-url url revision)
+  "Convert URL (a Hackage source URL) to the URL for the Cabal file at
+version REVISION."
+  (let* ((last-slash (string-rindex url #\/))
+         (next-slash (string-rindex url #\/ 0 last-slash)))
+    (string-append (substring url 0 next-slash)
+                   (substring url last-slash (- (string-length url)
+                                                (string-length ".tar.gz")))
+                   "/revision/" revision ".cabal")))
+
 (define* (lower name
                 #:key source inputs native-inputs outputs system target
                 (haskell (default-haskell))
+                cabal-revision
                 #:allow-other-keys
                 #:rest arguments)
   "Return a bag for NAME."
   (define private-keywords
-    '(#:target #:haskell #:inputs #:native-inputs))
+    '(#:target #:haskell #:cabal-revision #:inputs #:native-inputs))
+
+  (define (cabal-revision->origin cabal-revision)
+    (match cabal-revision
+      ((revision hash)
+       (origin
+         (method url-fetch)
+         (uri (source-url->revision-url (origin-uri source) revision))
+         (sha256 (base32 hash))
+         (file-name (string-append name "-" revision ".cabal"))))
+      (#f #f)))
 
   (and (not target)                               ;XXX: no cross-compilation
        (bag
@@ -64,6 +86,9 @@
          (host-inputs `(,@(if source
                               `(("source" ,source))
                               '())
+                        ,@(match (cabal-revision->origin cabal-revision)
+                            (#f '())
+                            (revision `(("cabal-revision" ,revision))))
                         ,@inputs
 
                         ;; Keep the standard inputs of 'gnu-build-system'.
@@ -103,6 +128,11 @@ provides a 'Setup.hs' file as its build system."
                                    source)
                                   (source
                                    source))
+                      #:cabal-revision ,(match (assoc-ref inputs
+                                                          "cabal-revision")
+                                          (((? derivation? revision))
+                                           (derivation->output-path revision))
+                                          (revision revision))
                       #:configure-flags ,configure-flags
                       #:haddock-flags ,haddock-flags
                       #:system ,system
diff --git a/guix/build/haskell-build-system.scm 
b/guix/build/haskell-build-system.scm
index 26519ce..be4f5b5 100644
--- a/guix/build/haskell-build-system.scm
+++ b/guix/build/haskell-build-system.scm
@@ -27,6 +27,7 @@
   #:use-module (ice-9 regex)
   #:use-module (ice-9 match)
   #:use-module (ice-9 vlist)
+  #:use-module (ice-9 ftw)
   #:export (%standard-phases
             haskell-build))
 
@@ -265,8 +266,19 @@ given Haskell package."
       (run-setuphs "haddock" haddock-flags)
       #t))
 
+(define* (patch-cabal-file #:key cabal-revision #:allow-other-keys)
+  (when cabal-revision
+    ;; Cabal requires there to be a single file with the suffix ".cabal".
+    (match (scandir "." (cut string-suffix? ".cabal" <>))
+      ((original)
+       (format #t "replacing ~s with ~s~%" original cabal-revision)
+       (copy-file cabal-revision original))
+      (_ (error "Could not find a Cabal file to patch."))))
+  #t)
+
 (define %standard-phases
   (modify-phases gnu:%standard-phases
+    (add-after 'unpack 'patch-cabal-file patch-cabal-file)
     (delete 'bootstrap)
     (add-before 'configure 'setup-compiler setup-compiler)
     (add-before 'install 'haddock haddock)