summaryrefslogtreecommitdiff
path: root/guix/build
diff options
context:
space:
mode:
authorEfraim Flashner <efraim@flashner.co.il>2020-09-05 21:56:34 +0300
committerEfraim Flashner <efraim@flashner.co.il>2020-09-05 22:30:04 +0300
commitde3c03a47160dec355d9b19ad5ca210d90c15fd7 (patch)
tree4ca6dc05b5fc9530d812bbb269f1c61ab9efccf3 /guix/build
parentab6fe9d362046231ad6f46eccfd1ea2c9c80b401 (diff)
parentb8477cab7bccc4191ed3dfa3f149aec7917834d8 (diff)
Merge remote-tracking branch 'origin/master' into staging
Diffstat (limited to 'guix/build')
-rw-r--r--guix/build/android-repo.scm75
-rw-r--r--guix/build/download-nar.scm2
-rw-r--r--guix/build/haskell-build-system.scm96
3 files changed, 139 insertions, 34 deletions
diff --git a/guix/build/android-repo.scm b/guix/build/android-repo.scm
new file mode 100644
index 0000000000..db8c4d127b
--- /dev/null
+++ b/guix/build/android-repo.scm
@@ -0,0 +1,75 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014, 2016, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix build android-repo)
+ #:use-module (guix build utils)
+ #:use-module (srfi srfi-34)
+ #:use-module (ice-9 format)
+ #:export (android-repo-fetch))
+
+;;; Commentary:
+;;;
+;;; This is the build-side support code of (guix android-repo-download).
+;;; It allows a multirepository managed by the git-repo tool to be cloned and
+;;; checked out at a specific revision.
+;;;
+;;; Code:
+
+(define* (android-repo-fetch manifest-url manifest-revision directory
+ #:key (git-repo-command "git-repo"))
+ "Fetch packages according to the manifest at MANIFEST-URL with
+MANIFEST-REVISION. MANIFEST-REVISION must be either a revision
+or a branch. Return #t on success, #f otherwise."
+
+ ;; Disable TLS certificate verification. The hash of the checkout is known
+ ;; in advance anyway.
+ (setenv "GIT_SSL_NO_VERIFY" "true")
+
+ (mkdir-p directory)
+
+ (guard (c ((invoke-error? c)
+ (format (current-error-port)
+ "android-repo-fetch: '~a~{ ~a~}' failed with exit code ~a~%"
+ (invoke-error-program c)
+ (invoke-error-arguments c)
+ (or (invoke-error-exit-status c) ;XXX: not quite accurate
+ (invoke-error-stop-signal c)
+ (invoke-error-term-signal c)))
+ (delete-file-recursively directory)
+ #f))
+ (with-directory-excursion directory
+ (invoke git-repo-command "init" "-u" manifest-url "-b" manifest-revision
+ "--depth=1")
+ (invoke git-repo-command "sync" "-c" "--fail-fast" "-v" "-j"
+ (number->string (parallel-job-count)))
+
+ ;; Delete vendor/**/.git, system/**/.git, toolchain/**/.git,
+ ;; .repo/**/.git etc since they contain timestamps.
+ (for-each delete-file-recursively
+ (find-files "." "^\\.git$" #:directories? #t))
+
+ ;; Delete git state directories since they contain timestamps.
+ (for-each delete-file-recursively
+ (find-files ".repo" "^.*\\.git$" #:directories? #t))
+
+ ;; This file contains timestamps.
+ (delete-file ".repo/.repo_fetchtimes.json")
+ #t)))
+
+;;; android-repo.scm ends here
diff --git a/guix/build/download-nar.scm b/guix/build/download-nar.scm
index 377e428341..867f3c10bb 100644
--- a/guix/build/download-nar.scm
+++ b/guix/build/download-nar.scm
@@ -20,7 +20,7 @@
#:use-module (guix build download)
#:use-module (guix build utils)
#:use-module ((guix serialization) #:hide (dump-port*))
- #:use-module (guix zlib)
+ #:autoload (zlib) (call-with-gzip-input-port)
#:use-module (guix progress)
#:use-module (web uri)
#:use-module (srfi srfi-11)
diff --git a/guix/build/haskell-build-system.scm b/guix/build/haskell-build-system.scm
index 91f62138d0..28253ce2f0 100644
--- a/guix/build/haskell-build-system.scm
+++ b/guix/build/haskell-build-system.scm
@@ -2,7 +2,7 @@
;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2015 Paul van der Walt <paul@denknerd.org>
-;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2018, 2020 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2018 Alex Vong <alexvong1995@gmail.com>
;;;
;;; This file is part of GNU Guix.
@@ -73,37 +73,35 @@ and parameters ~s~%"
(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 (append `(,(string-append "--prefix=" out))
- `(,(string-append "--libdir=" (or lib out) "/lib"))
- `(,(string-append "--bindir=" (or bin out) "/bin"))
- `(,(string-append
- "--docdir=" (or doc out)
- "/share/doc/" name-version))
- '("--libsubdir=$compiler/$pkg-$version")
- `(,(string-append "--package-db=" %tmp-db-dir))
- '("--global")
- `(,@(map
- (cut string-append "--extra-include-dirs=" <>)
- (search-path-as-list '("include") input-dirs)))
- `(,@(map
- (cut string-append "--extra-lib-dirs=" <>)
- (search-path-as-list '("lib") input-dirs)))
- (if tests?
- '("--enable-tests")
- '())
- configure-flags)))
+ (params `(,(string-append "--prefix=" out)
+ ,(string-append "--libdir=" (or lib out) "/lib")
+ ,(string-append "--docdir=" (or doc out)
+ "/share/doc/" name-version)
+ "--libsubdir=$compiler/$pkg-$version"
+ ,(string-append "--package-db=" %tmp-db-dir)
+ "--global"
+ ,@(map (cut string-append "--extra-include-dirs=" <>)
+ (search-path-as-list '("include") extra-dirs))
+ ,@(map (cut string-append "--extra-lib-dirs=" <>)
+ (search-path-as-list '("lib") extra-dirs))
+ ,@(if tests?
+ '("--enable-tests")
+ '())
+ ;; Build and link with shared libraries
+ "--enable-shared"
+ "--enable-executable-dynamic"
+ "--ghc-option=-fPIC"
+ ,(string-append "--ghc-option=-optl=-Wl,-rpath=" (or lib out)
+ "/lib/$compiler/$pkg-$version")
+ ,@configure-flags)))
;; Cabal errors if GHC_PACKAGE_PATH is set during 'configure', so unset
;; and restore it.
(unsetenv "GHC_PACKAGE_PATH")
@@ -121,13 +119,27 @@ and parameters ~s~%"
(setenv "GHC_PACKAGE_PATH" ghc-path)
#t))
-(define* (build #:rest empty)
+(define* (build #:key parallel-build? #:allow-other-keys)
"Build a given Haskell package."
- (run-setuphs "build" '()))
+ (run-setuphs "build"
+ (if parallel-build?
+ `(,(string-append "--ghc-option=-j" (number->string (parallel-job-count))))
+ '())))
-(define* (install #:rest empty)
+(define* (install #:key outputs #:allow-other-keys)
"Install a given Haskell package."
- (run-setuphs "copy" '()))
+ (run-setuphs "copy" '())
+ (when (assoc-ref outputs "static")
+ (let ((static (assoc-ref outputs "static"))
+ (lib (or (assoc-ref outputs "lib")
+ (assoc-ref outputs "out"))))
+ (for-each (lambda (static-lib)
+ (let* ((subdir (string-drop static-lib (string-length lib)))
+ (new (string-append static subdir)))
+ (mkdir-p (dirname new))
+ (rename-file static-lib new)))
+ (find-files lib "\\.a$"))))
+ #t)
(define (grep rx port)
"Given a regular-expression RX including a group, read from PORT until the
@@ -227,9 +239,10 @@ given Haskell package."
(loop seen tail))))))
(let* ((out (assoc-ref outputs "out"))
+ (doc (assoc-ref outputs "doc"))
(haskell (assoc-ref inputs "haskell"))
(name-verion (strip-store-file-name haskell))
- (lib (string-append out "/lib"))
+ (lib (string-append (or (assoc-ref outputs "lib") out) "/lib"))
(config-dir (string-append lib
"/" name-verion
"/" name ".conf.d"))
@@ -241,8 +254,25 @@ given Haskell package."
;; The conf file is created only when there is a library to register.
(when (file-exists? config-file)
(mkdir-p config-dir)
- (let* ((config-file-name+id
- (call-with-ascii-input-file config-file (cut grep id-rx <>))))
+ (let ((config-file-name+id
+ (call-with-ascii-input-file config-file (cut grep id-rx <>))))
+
+ ;; 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 "/"