[bug#51655] [PATCH] build-system: haskell: Add ‘package-with-explicit-haskell’ procedure.

[Xinglu Chen]

* guix/packages.scm (package-with-explicit-compiler): New procedure;
factorized from ‘package-with-explicit-python’.
* guix/build-system/python.scm (package-with-explicit-python): Use
‘package-with-explicit-compiler’.
* guix/build-system/haskell.scm (package-with-explicit-haskell): New procedure.
* doc/guix.texi (Defining Package Variants): Document it.
---
 doc/guix.texi                 | 37 ++++++++++++++++++
 guix/build-system/haskell.scm |  8 ++++
 guix/build-system/python.scm  | 71 +++++++----------------------------
 guix/packages.scm             | 55 +++++++++++++++++++++++++++
 4 files changed, 113 insertions(+), 58 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index ea1973f02c..95fa5ab103 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -7717,6 +7717,43 @@
 applied to implicit inputs as well.
 @end deffn
 
+@deffn {Scheme Procedure} package-with-explicit-compiler @var{compiler} @
+@var{keyword} @var{build-system} @var{old-prefix} @var{new-prefix} @
+[#:variant-property #f]
+Return a procedure of one argument, @var{p}.  The procedure creates a
+package with the same fields as @var{p}, which is assumed to use
+@var{build-system}, such that it is compiled with @var{compiler}
+instead.  @var{keyword} is a symbol whose name is the name of the
+keyword for explicitly specifying a compiler, e.g., @code{python} for
+@code{python-build-system}.  The inputs are changed recursively
+accordingly.  If the name of @var{p} starts with @var{old-prefix}, this
+is replaced by @var{new-prefix}; otherwise, @var{new-prefix} is
+prepended to the name.
+
+When @var{variant-property} is present, it is used as a key to search
+for pre-defined variants of this transformation recorded in the
+@code{properties} field of packages.  The property value must be the
+promise of a package.  This is a convenient way for package writers to
+force the transformation to use pre-defined variants.
+
+You can for example define a procedure which given a Haskell package,
+builds it and all of its recursive dependencies with GHC 8.8.
+
+@lisp
+(use-modules (guix build-system haskell))
+
+(define (default-haskell-8.8)
+  ;; Lazily resolve the binding to avoid a circular dependency.
+  (let ((haskell (resolve-interface '(gnu packages haskell))))
+    (module-ref haskell 'ghc-8.8)))
+
+(define package-with-haskell-8.8
+  (package-with-explicit-haskell (delay (default-haskell-8.8))
+                                 "ghc-" "ghc-8.8-"
+                                 #:variant-property 'ghc-8.8-variant))
+@end lisp                                 
+@end deffn
+
 
 @node Build Systems
 @section Build Systems
diff --git a/guix/build-system/haskell.scm b/guix/build-system/haskell.scm
index 18a584f782..8656e5f318 100644
--- a/guix/build-system/haskell.scm
+++ b/guix/build-system/haskell.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
 ;;; Copyright © 2020 Timothy Sample <samplet@ngyro.com>
 ;;; Copyright © 2020 Simon Tournier <zimon.toutoune@gmail.com>
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -31,6 +32,7 @@ (define-module (guix build-system haskell)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:export (%haskell-build-system-modules
+            package-with-explicit-haskell
             haskell-build
             haskell-build-system))
 
@@ -190,4 +192,10 @@ (define haskell-build-system
     (description "The standard Haskell build system")
     (lower lower)))
 
+(define* (package-with-explicit-haskell haskell old-prefix new-prefix
+                                        #:key variant-property)
+  (package-with-explicit-compiler haskell 'haskell haskell-build-system
+                                  old-prefix new-prefix
+                                  #:variant-property variant-property))
+
 ;;; haskell.scm ends here
diff --git a/guix/build-system/python.scm b/guix/build-system/python.scm
index 80895162f8..3d8b437d11 100644
--- a/guix/build-system/python.scm
+++ b/guix/build-system/python.scm
@@ -70,64 +70,6 @@ (define (default-python2)
   (let ((python (resolve-interface '(gnu packages python))))
     (module-ref python 'python-2)))
 
-(define* (package-with-explicit-python python old-prefix new-prefix
-                                       #:key variant-property)
-  "Return a procedure of one argument, P.  The procedure creates a package with
-the same fields as P, which is assumed to use PYTHON-BUILD-SYSTEM, such that
-it is compiled with PYTHON instead.  The inputs are changed recursively
-accordingly.  If the name of P starts with OLD-PREFIX, this is replaced by
-NEW-PREFIX; otherwise, NEW-PREFIX is prepended to the name.
-
-When VARIANT-PROPERTY is present, it is used as a key to search for
-pre-defined variants of this transformation recorded in the 'properties' field
-of packages.  The property value must be the promise of a package.  This is a
-convenient way for package writers to force the transformation to use
-pre-defined variants."
-  (define package-variant
-    (if variant-property
-        (lambda (package)
-          (assq-ref (package-properties package)
-                    variant-property))
-        (const #f)))
-
-  (define (transform p)
-    (cond
-     ;; If VARIANT-PROPERTY is present, use that.
-     ((package-variant p)
-      => force)
-
-     ;; Otherwise build the new package object graph.
-     ((eq? (package-build-system p) python-build-system)
-      (package/inherit p
-        (location (package-location p))
-        (name (let ((name (package-name p)))
-                (string-append new-prefix
-                               (if (string-prefix? old-prefix name)
-                                   (substring name
-                                              (string-length old-prefix))
-                                   name))))
-        (arguments
-         (let ((python (if (promise? python)
-                           (force python)
-                           python)))
-           (ensure-keyword-arguments (package-arguments p)
-                                     `(#:python ,python))))))
-     (else p)))
-
-  (define (cut? p)
-    (or (not (eq? (package-build-system p) python-build-system))
-        (package-variant p)))
-
-  (package-mapping transform cut?))
-
-(define package-with-python2
-  ;; Note: delay call to 'default-python2' until after the 'arguments' field
-  ;; of packages is accessed to avoid a circular dependency when evaluating
-  ;; the top-level of (gnu packages python).
-  (package-with-explicit-python (delay (default-python2))
-                                "python-" "python2-"
-                                #:variant-property 'python2-variant))
-
 (define (strip-python2-variant p)
   "Remove the 'python2-variant' property from P."
   (package/inherit p
@@ -220,4 +162,17 @@ (define python-build-system
     (description "The standard Python build system")
     (lower lower)))
 
+(define* (package-with-explicit-python python old-prefix new-prefix
+                                       #:key variant-property)
+  (package-with-explicit-compiler python 'python python-build-system
+                                  old-prefix new-prefix
+                                  #:variant-property variant-property))
+(define package-with-python2
+  ;; Note: delay call to 'default-python2' until after the 'arguments' field
+  ;; of packages is accessed to avoid a circular dependency when evaluating
+  ;; the top-level of (gnu packages python).
+  (package-with-explicit-python (delay (default-python2))
+                                  "python-" "python2-"
+                                  #:variant-property 'python2-variant))
+
 ;;; python.scm ends here
diff --git a/guix/packages.scm b/guix/packages.scm
index 4b6098bb8d..81c5701886 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -130,6 +130,7 @@ (define-module (guix packages)
             package-with-extra-patches
             package-with-c-toolchain
             package/inherit
+            package-with-explicit-compiler
 
             transitive-input-references
 
@@ -951,6 +952,60 @@ (define (package-with-c-toolchain package toolchain)
     (package/inherit package
       (build-system (build-system-with-c-toolchain bs toolchain)))))
 
+(define* (package-with-explicit-compiler compiler keyword build-system
+                                         old-prefix new-prefix
+                                         #:key variant-property)
+  "Return a procedure of one argument, P.  The procedure creates a package with
+the same fields as P, which is assumed to use BUILD-SYSTEM, such that it is
+compiled with COMPILER instead.  KEYWORD is a symbol whose name is the name of
+the keyword for explicitly specifying a compiler, e.g., 'python' for
+'python-build-system'.  The inputs are changed recursively accordingly.  If
+the name of P starts with OLD-PREFIX, this is replaced by NEW-PREFIX;
+otherwise, NEW-PREFIX is prepended to the name.
+
+When VARIANT-PROPERTY is present, it is used as a key to search for
+pre-defined variants of this transformation recorded in the 'properties' field
+of packages.  The property value must be the promise of a package.  This is a
+convenient way for package writers to force the transformation to use
+pre-defined variants."
+  (define package-variant
+    (if variant-property
+        (lambda (package)
+          (assq-ref (package-properties package)
+                    variant-property))
+        (const #f)))
+
+  (define (transform p)
+    (cond
+     ;; If VARIANT-PROPERTY is present, use that.
+     ((package-variant p)
+      => force)
+
+     ;; Otherwise build the new package object graph.
+     ((eq? (package-build-system p) build-system)
+      (package/inherit p
+        (location (package-location p))
+        (name (let ((name (package-name p)))
+                (string-append new-prefix
+                               (if (string-prefix? old-prefix name)
+                                   (substring name
+                                              (string-length old-prefix))
+                                   name))))
+        (arguments
+         (let ((compiler (if (promise? compiler)
+                             (force compiler)
+                             compiler)))
+           (ensure-keyword-arguments (package-arguments p)
+                                     `(,(symbol->keyword keyword)
+                                       ,compiler))))))
+     (else p)))
+
+  (define (cut? p)
+    (or (not (eq? (package-build-system p) build-system))
+        (package-variant p)))
+
+  (package-mapping transform cut?))
+
 (define (transitive-inputs inputs)
   "Return the closure of INPUTS when considering the 'propagated-inputs'
 edges.  Omit duplicate inputs, except for those already present in INPUTS

base-commit: 1ffc0a6be3c1613b2d99ceea098174d1f11f6f3f
-- 
2.33.0