From 54a5fd0791f15108d7c06f0b439e75e049fde249 Mon Sep 17 00:00:00 2001
From: Timothy Sample <samplet@ngyro.com>
Date: Sat, 8 Aug 2020 16:36:35 -0400
Subject: build-system/haskell: Add 'extra-directories' keyword.

See <https://bugs.gnu.org/39309>.

* guix/build-system/haskell.scm (lower): Include the transitive
propagated inputs of 'extra-directories' inputs.
(haskell-build): Add the 'extra-directories' keyword and pass it through
to the builder.
* guix/build/haskell-build-system.scm (configure): Use it to select
which inputs get passed via 'extra-include-dirs' and 'extra-lib-dirs' to
Cabal.
* gnu/packages/haskell-xyz.scm (ghc-alsa-core, ghc-hmatrix,
ghc-hmatrix-gsl, ghc-hslua, ghc-iwlib, ghc-libyaml, ghc-ncurses,
ghc-openglraw, ghc-x11, ghc-x11-xft, ghc-zlib): Set 'extra-directories'.
* gnu/packages/haskell-crypto.scm (ghc-digest, ghc-hsopenssl): Likewise.
---
 guix/build-system/haskell.scm       | 17 ++++++++++++++++-
 guix/build/haskell-build-system.scm | 11 ++++-------
 2 files changed, 20 insertions(+), 8 deletions(-)

(limited to 'guix')

diff --git a/guix/build-system/haskell.scm b/guix/build-system/haskell.scm
index f92fbcd713..8304e3b222 100644
--- a/guix/build-system/haskell.scm
+++ b/guix/build-system/haskell.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
+;;; Copyright © 2020 Timothy Sample <samplet@ngyro.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -26,6 +27,7 @@ (define-module (guix build-system haskell)
   #:use-module (guix build-system)
   #:use-module (guix build-system gnu)
   #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:export (%haskell-build-system-modules
             haskell-build
@@ -100,7 +102,18 @@ (define (cabal-revision->origin cabal-revision)
                     (("out") (cons "static" outputs))
                     (_ outputs)))
          (build haskell-build)
-         (arguments (strip-keyword-arguments private-keywords arguments)))))
+         (arguments
+          (substitute-keyword-arguments
+              (strip-keyword-arguments private-keywords arguments)
+            ((#:extra-directories extra-directories)
+             `(list ,@(append-map
+                       (lambda (name)
+                         (match (assoc name inputs)
+                           ((_ pkg)
+                            (match (package-transitive-propagated-inputs pkg)
+                              (((propagated-names . _) ...)
+                               (cons name propagated-names))))))
+                       extra-directories))))))))
 
 (define* (haskell-build store name inputs
                         #:key source
@@ -110,6 +123,7 @@ (define* (haskell-build store name inputs
                         (test-target "test")
                         (parallel-build? #t)
                         (configure-flags ''())
+                        (extra-directories ''())
                         (phases '(@ (guix build haskell-build-system)
                                     %standard-phases))
                         (outputs '("out" "static"))
@@ -138,6 +152,7 @@ (define builder
                                            (derivation->output-path revision))
                                           (revision revision))
                       #:configure-flags ,configure-flags
+                      #:extra-directories ,extra-directories
                       #:haddock-flags ,haddock-flags
                       #:system ,system
                       #:test-target ,test-target
diff --git a/guix/build/haskell-build-system.scm b/guix/build/haskell-build-system.scm
index d587962b8b..d7789cdef9 100644
--- a/guix/build/haskell-build-system.scm
+++ b/guix/build/haskell-build-system.scm
@@ -73,17 +73,14 @@ (define (run-setuphs command params)
         (error "no Setup.hs nor Setup.lhs found"))))
 
 (define* (configure #:key outputs inputs tests? (configure-flags '())
-                    #:allow-other-keys)
+                    (extra-directories '()) #:allow-other-keys)
   "Configure a given Haskell package."
   (let* ((out (assoc-ref outputs "out"))
          (doc (assoc-ref outputs "doc"))
          (lib (assoc-ref outputs "lib"))
          (bin (assoc-ref outputs "bin"))
          (name-version (strip-store-file-name out))
-         (input-dirs (match inputs
-                       (((_ . dir) ...)
-                        dir)
-                       (_ '())))
+         (extra-dirs (filter-map (cut assoc-ref inputs <>) extra-directories))
          (ghc-path (getenv "GHC_PACKAGE_PATH"))
          (params `(,(string-append "--prefix=" out)
                    ,(string-append "--libdir=" (or lib out) "/lib")
@@ -94,9 +91,9 @@ (define* (configure #:key outputs inputs tests? (configure-flags '())
                    ,(string-append "--package-db=" %tmp-db-dir)
                    "--global"
                    ,@(map (cut string-append "--extra-include-dirs=" <>)
-                          (search-path-as-list '("include") input-dirs))
+                          (search-path-as-list '("include") extra-dirs))
                    ,@(map (cut string-append "--extra-lib-dirs=" <>)
-                          (search-path-as-list '("lib") input-dirs))
+                          (search-path-as-list '("lib") extra-dirs))
                    ,@(if tests?
                          '("--enable-tests")
                          '())
-- 
cgit v1.2.3