ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-26 14:28:15 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

build: haskell-build-system: Support multiple libraries.

Browse source 
Fixes <https://bugs.gnu.org/53655>.

The patch handles correctly the multiple registration of some package using
their own internal sub-libraries.  It allows to call 'install-transitive-deps'
multiple times and deals with packages requiring a multiple registration.

* guix/build/haskell-build-system.scm (register)[install-transitive-deps]:
Guard also the destination direction.
[install-config-file]: New procedure.

Co-Authored-by: zimoun <zimon.toutoune@gmail.com>.
Signed-off-by: Lars-Dominik Braun <lars@6xq.net>
This commit is contained in:
Philip Munksgaard 2022-04-06 21:19:08 +02:00 committed by Lars-Dominik Braun
parent 29d5fb7619
commit 3455a004ec
No known key found for this signature in database
GPG key ID: F663943E08D8092A
1 changed files with 49 additions and 38 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

87
guix/build/haskell-build-system.scm
View file

@ -6,6 +6,7 @@
;;; Copyright © 2018 Alex Vong <alexvong1995@gmail.com>
;;; Copyright © 2021 John Kehayias <john.kehayias@protonmail.com>
;;; Copyright © 2022 Simon Tournier <zimon.toutoune@gmail.com>
;;; Copyright © 2022 Philip Munksgaard <philip@munksgaard.me>
;;;
;;; This file is part of GNU Guix.
;;;
@ -215,13 +216,50 @@ (define (install-transitive-deps conf-file src dest)
(if (not (vhash-assoc id seen))
(let ((dep-conf (string-append src "/" id ".conf"))
(dep-conf* (string-append dest "/" id ".conf")))
(when (not (file-exists? dep-conf))
(unless (file-exists? dep-conf*)
(unless (file-exists? dep-conf)
(error (format #f "File ~a does not exist. This usually means the dependency ~a is missing. Was checking conf-file ~a." dep-conf id conf-file)))
(copy-file dep-conf dep-conf*) ;XXX: maybe symlink instead?
(loop (vhash-cons id #t seen)
(append lst (conf-depends dep-conf))))
(copy-file dep-conf dep-conf*) ;XXX: maybe symlink instead?
(loop (vhash-cons id #t seen)
(append lst (conf-depends dep-conf)))))
(loop seen tail))))))
(define (install-config-file conf-file dest output:doc output:lib)
;; Copy CONF-FILE to DEST removing reference to OUTPUT:DOC from
;; OUTPUT:LIB and using install-transitive-deps.
(let* ((contents (call-with-input-file conf-file read-string))
(id-rx (make-regexp "^id:[ \n\t]+([^ \t\n]+)$" regexp/newline))
(config-file-name+id
(match:substring (first (list-matches id-rx contents)) 1)))
(when (or
(and
(string? config-file-name+id)
(string-null? config-file-name+id))
(not config-file-name+id))
(error (format #f "The package id for ~a is empty. This is a bug." conf-file)))
;; Remove reference to "doc" output from "lib" (or "out") by rewriting the
;; "haddock-interfaces" field and removing the optional "haddock-html"
;; field in the generated .conf file.
(when output:doc
(substitute* conf-file
(("^haddock-html: .*") "\n")
(((format #f "^haddock-interfaces: ~a" output:doc))
(string-append "haddock-interfaces: " output:lib)))
;; Move the referenced file to the "lib" (or "out") output.
(match (find-files output:doc "\\.haddock$")
((haddock-file . rest)
(let* ((subdir (string-drop haddock-file (string-length output:doc)))
(new (string-append output:lib subdir)))
(mkdir-p (dirname new))
(rename-file haddock-file new)))
(_ #f)))
(install-transitive-deps conf-file %tmp-db-dir dest)
(rename-file conf-file
(string-append dest "/"
config-file-name+id ".conf"))))
(let* ((out (assoc-ref outputs "out"))
(doc (assoc-ref outputs "doc"))
(haskell (assoc-ref inputs "haskell"))
@ -231,7 +269,6 @@ (define (install-transitive-deps conf-file src dest)
(config-dir (string-append lib
"/ghc-" version
"/" name ".conf.d"))
(id-rx (make-regexp "^id:[ \n\t]+([^ \t\n]+)$" regexp/newline))
(config-file (string-append out "/" name ".conf"))
(params
(list (string-append "--gen-pkg-config=" config-file))))
@ -239,39 +276,13 @@ (define (install-transitive-deps conf-file src dest)
;; The conf file is created only when there is a library to register.
(when (file-exists? config-file)
(mkdir-p config-dir)
(let* ((contents (call-with-input-file config-file read-string))
(config-file-name+id (match:substring (first (list-matches id-rx contents)) 1)))
(when (or
(and
(string? config-file-name+id)
(string-null? config-file-name+id))
(not config-file-name+id))
(error (format #f "The package id for ~a is empty. This is a bug." config-file)))
;; Remove reference to "doc" output from "lib" (or "out") by rewriting the
;; "haddock-interfaces" field and removing the optional "haddock-html"
;; field in the generated .conf file.
(when doc
(substitute* config-file
(("^haddock-html: .*") "\n")
(((format #f "^haddock-interfaces: ~a" doc))
(string-append "haddock-interfaces: " lib)))
;; Move the referenced file to the "lib" (or "out") output.
(match (find-files doc "\\.haddock$")
((haddock-file . rest)
(let* ((subdir (string-drop haddock-file (string-length doc)))
(new (string-append lib subdir)))
(mkdir-p (dirname new))
(rename-file haddock-file new)))
(_ #f)))
(install-transitive-deps config-file %tmp-db-dir config-dir)
(rename-file config-file
(string-append config-dir "/"
config-file-name+id ".conf"))
(invoke "ghc-pkg"
(string-append "--package-db=" config-dir)
"recache")))))
(if (file-is-directory? config-file)
(for-each (cut install-config-file <> config-dir doc lib)
(find-files config-file))
(install-config-file config-file config-dir doc lib))
(invoke "ghc-pkg"
(string-append "--package-db=" config-dir)
"recache"))))
(define* (check #:key tests? test-target #:allow-other-keys)
"Run the test suite of a given Haskell package."