From 84b68a1a3faf6609a0e1922bafe7987d908e5694 Mon Sep 17 00:00:00 2001
From: Federico Beffa <address@hidden>
Date: Wed, 8 Feb 2017 18:57:13 +0100
Subject: [PATCH 2/2] build: Add new '--with-compiler' option.

* guix/scripts/build.scm (package-name-prefix, transform-package-compiler):
  New procedures.  (%transformations, %transformation-options,
  show-transformation-options-help): Add new option '--with-compiler'.
---
 guix/scripts/build.scm | 59 +++++++++++++++++++++++++++++++++++++++++++++++---
 1 file changed, 56 insertions(+), 3 deletions(-)

diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 68402fda1..1bc69b179 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <address@hidden>
 ;;; Copyright © 2013 Mark H Weaver <address@hidden>
+;;; Copyright © 2017 Federico Beffa <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -29,6 +30,8 @@
   #:use-module ((guix utils) #:hide (package-name->name+version))
   #:use-module ((guix build utils) #:select (package-name->name+version))
 
+  #:use-module (guix build-system)
+  #:use-module (guix build-system utils)
   #:use-module (guix monads)
   #:use-module (guix gexp)
   #:autoload   (guix http-client) (http-fetch http-get-error?)
@@ -231,6 +234,50 @@ current 'gnutls' package, after which version 3.5.4 is grafted onto them."
           (rewrite obj)
           obj))))
 
+;; XXX: Can we use a more robust method?
+(define* (package-name-prefix package #:optional (default ""))
+  "Return the package name prefix used by convention by PACKAGE."
+  (let ((name (package-name package))
+        (bs (package-build-system package)))
+    (case (build-system-name bs)
+      ((haskell) "ghc-")
+      ((python)
+       (if (string-prefix? "python2-" name)
+           "python2-"
+           "python-"))
+      ((emacs perl r ruby)
+       (let ((prefix (string-append (symbol->string bs) "-")))
+         (if (string-prefix? prefix name)
+             prefix
+             default)))
+      (else default))))
+
+(define (transform-package-compiler compiler-spec)
+    "Return a procedure that, when passed a package, replaces the default
+compiler used to build it by COMPILER-SPEC.  The package inputs are changed
+recursively accordingly.  Currently only packages built using one of the
+following build-systems are supported: haskell, python. emacs, perl, r or
+ruby."
+  (define (new-prefix old-prefix compiler)
+    (let ((name (package-name compiler))
+          (version (package-version compiler)))
+      (string-append old-prefix "with" name version "-")))
+
+  (let* ((compiler (match compiler-spec
+                     ((spec) (specification->package spec))
+                     (_ (leave (_ "Wrong compiler specification: ~A~%"))))))
+    (lambda (store obj)
+      (match obj
+        ((? package? p)
+         (let* ((bs-name (build-system-name (package-build-system p)))
+                (prefix (package-name-prefix p)))
+           ((package-with-explicit-compiler compiler bs-name
+                                            prefix
+                                            (new-prefix prefix compiler))
+            p)))
+        (_
+         obj)))))
+
 (define %transformations
   ;; Transformations that can be applied to things to build.  The car is the
   ;; key used in the option alist, and the cdr is the transformation
@@ -238,7 +285,8 @@ current 'gnutls' package, after which version 3.5.4 is grafted onto them."
   ;; things to build.
   `((with-source . ,transform-package-source)
     (with-input  . ,transform-package-inputs)
-    (with-graft  . ,transform-package-inputs/graft)))
+    (with-graft  . ,transform-package-inputs/graft)
+    (with-compiler . ,transform-package-compiler)))
 
 (define %transformation-options
   ;; The command-line interface to the above transformations.
@@ -252,7 +300,9 @@ current 'gnutls' package, after which version 3.5.4 is grafted onto them."
           (option '("with-input") #t #f
                   (parser 'with-input))
           (option '("with-graft") #t #f
-                  (parser 'with-graft)))))
+                  (parser 'with-graft))
+          (option '("with-compiler") #t #f
+                  (parser 'with-compiler)))))
 
 (define (show-transformation-options-help)
   (display (_ "
@@ -263,7 +313,10 @@ current 'gnutls' package, after which version 3.5.4 is grafted onto them."
                          replace dependency PACKAGE by REPLACEMENT"))
   (display (_ "
       --with-graft=PACKAGE=REPLACEMENT
-                         graft REPLACEMENT on packages that refer to PACKAGE")))
+                         graft REPLACEMENT on packages that refer to PACKAGE"))
+  (display (_ "
+      --with-compiler=COMPILER
+                         use the specified compiler when building the package")))
 
 
 (define (options->transformation opts)
-- 
2.11.0