From 959dc9de2d4aa39b7490b4c90e28820edf0d00f9 Mon Sep 17 00:00:00 2001
From: itd <itd@net.in.tum.de>
Date: Fri, 23 Sep 2022 10:58:09 +0200
Subject: [PATCH] WIP update haskell-build-system for newer attoparsec
---
guix/build/haskell-build-system.scm | 86 +++++++++++++++++------------
1 file changed, 51 insertions(+), 35 deletions(-)
@@ -219,7 +219,10 @@ (define* (register #:key name system inputs outputs #:allow-other-keys)
(dep-conf* (string-append dest "/" id ".conf")))
(when (not (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?
+ ;; Different libraries of same package may share
+ ;; dependencies. Hence, file may exist already.
+ (when (not (file-exists? 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))))))
@@ -234,46 +237,59 @@ (define* (register #:key name system inputs outputs #:allow-other-keys)
"/ghc-" version
"/" name ".conf.d"))
(id-rx (make-regexp "^id:[ \n\t]+([^ \t\n]+)$" regexp/newline))
- (config-file (string-append out "/" name ".conf"))
+ (maybe-config-file (string-append out "/" name ".conf"))
(params
- (list (string-append "--gen-pkg-config=" config-file))))
+ (list (string-append "--gen-pkg-config=" maybe-config-file))))
(run-setuphs "register" params)
;; The conf file is created only when there is a library to register.
- (when (file-exists? config-file)
+ (when (file-exists? maybe-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)))
+ ;; If more that one library is defined, they share conf file as
+ ;; parent directory.
+ (let* ((config-files (if (file-is-directory? maybe-config-file)
+ (find-files maybe-config-file)
+ (list maybe-config-file))))
+ (map
+ (lambda (config-file)
+ (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)))
+ (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")))
+ ;; 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)
+ ;; Make current conf file available for possible
+ ;; subsequent conf files.
+ (copy-file config-file
+ (string-append %tmp-db-dir "/"
+ config-file-name+id ".conf"))
+ (rename-file config-file
+ (string-append config-dir "/"
+ config-file-name+id ".conf"))
+ (invoke "ghc-pkg"
+ (string-append "--package-db=" config-dir)
+ "recache")))
+ config-files)))
#t))
(define* (check #:key tests? test-target #:allow-other-keys)
base-commit: a57c4eff6bbdcff79294fa15ecb95ab2b3c55bb4
--
2.37.3