From a68229b9a0f450db622511adfe00ff7307d745d3 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 12 Feb 2023 01:15:51 +0100 Subject: syscalls: 'with-file-lock' removes lock file upon exit. Fixes . Reported by Ricardo Wurmus . * guix/build/syscalls.scm (call-with-file-lock) (call-with-file-lock/no-wait): Add call to 'delete-file' in unwind handler. --- guix/build/syscalls.scm | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) (limited to 'guix/build') diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 0358960ff5..df9b9f6ac7 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014-2022 Ludovic Courtès +;;; Copyright © 2014-2023 Ludovic Courtès ;;; Copyright © 2015 David Thompson ;;; Copyright © 2015 Mark H Weaver ;;; Copyright © 2017 Mathieu Othacehe @@ -1400,7 +1400,8 @@ exception if it's already taken." thunk (lambda () (when port - (unlock-file port)))))) + (unlock-file port) + (delete-file file)))))) (define (call-with-file-lock/no-wait file thunk handler) (let ((port #f)) @@ -1428,7 +1429,8 @@ exception if it's already taken." thunk (lambda () (when port - (unlock-file port)))))) + (unlock-file port) + (delete-file file)))))) (define-syntax-rule (with-file-lock file exp ...) "Wait to acquire a lock on FILE and evaluate EXP in that context." -- cgit v1.2.3 From dbd4d2d0707b486f1e2c8659e94e1d3b15e4351e Mon Sep 17 00:00:00 2001 From: Pierre Langlois Date: Fri, 25 Nov 2022 01:57:21 +0000 Subject: build-system: Add tree-sitter-build-system. * guix/build-system/tree-sitter.scm: New module. * guix/build/tree-sitter-build-system.scm: Likewise. * Makefile.am (MODULES): Add them. * doc/guix.texi: Document it. Signed-off-by: Andrew Tropin --- Makefile.am | 2 + doc/guix.texi | 21 +++- guix/build-system/tree-sitter.scm | 195 ++++++++++++++++++++++++++++++++ guix/build/tree-sitter-build-system.scm | 153 +++++++++++++++++++++++++ 4 files changed, 370 insertions(+), 1 deletion(-) create mode 100644 guix/build-system/tree-sitter.scm create mode 100644 guix/build/tree-sitter-build-system.scm (limited to 'guix/build') diff --git a/Makefile.am b/Makefile.am index a4b6f03b3a..5ce6cc84f4 100644 --- a/Makefile.am +++ b/Makefile.am @@ -178,6 +178,7 @@ MODULES = \ guix/build-system/ruby.scm \ guix/build-system/scons.scm \ guix/build-system/texlive.scm \ + guix/build-system/tree-sitter.scm \ guix/build-system/trivial.scm \ guix/ftp-client.scm \ guix/http-client.scm \ @@ -234,6 +235,7 @@ MODULES = \ guix/build/ruby-build-system.scm \ guix/build/scons-build-system.scm \ guix/build/texlive-build-system.scm \ + guix/build/tree-sitter-build-system.scm \ guix/build/waf-build-system.scm \ guix/build/haskell-build-system.scm \ guix/build/julia-build-system.scm \ diff --git a/doc/guix.texi b/doc/guix.texi index 6c7c918eb0..44e2165a82 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -79,7 +79,7 @@ Copyright @copyright{} 2020 Jack Hill@* Copyright @copyright{} 2020 Naga Malleswari@* Copyright @copyright{} 2020, 2021 Brice Waegeneire@* Copyright @copyright{} 2020 R Veera Kumar@* -Copyright @copyright{} 2020, 2021 Pierre Langlois@* +Copyright @copyright{} 2020, 2021, 2022 Pierre Langlois@* Copyright @copyright{} 2020 pinoaffe@* Copyright @copyright{} 2020 André Batista@* Copyright @copyright{} 2020, 2021 Alexandru-Sergiu Marton@* @@ -9756,6 +9756,25 @@ be specified with the @code{#:node} parameter which defaults to @code{node}. @end defvar +@defvr {Scheme Variable} tree-sitter-build-system + +This variable is exported by @code{(guix build-system tree-sitter)}. It +implements procedures to compile grammars for the +@url{https://tree-sitter.github.io/tree-sitter/, Tree-sitter} parsing +library. It essentially runs @code{tree-sitter generate} to translate +@code{grammar.js} grammars to JSON and then to C. Which it then +compiles to native code. + +Tree-sitter packages may support multiple grammars, so this build system +supports a @code{#:grammar-directories} keyword to specify a list of +locations where a @code{grammar.js} file may be found. + +Grammars sometimes depend on each other, such as C++ depending on C and +TypeScript depending on JavaScript. You may use inputs to declare such +dependencies. + +@end defvr + Lastly, for packages that do not need anything as sophisticated, a ``trivial'' build system is provided. It is trivial in the sense that it provides basically no support: it does not pull any implicit inputs, diff --git a/guix/build-system/tree-sitter.scm b/guix/build-system/tree-sitter.scm new file mode 100644 index 0000000000..21c4eb35b2 --- /dev/null +++ b/guix/build-system/tree-sitter.scm @@ -0,0 +1,195 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2022 Pierre Langlois +;;; +;;; 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 . + +(define-module (guix build-system tree-sitter) + #:use-module (guix store) + #:use-module (guix utils) + #:use-module (guix packages) + #:use-module (guix gexp) + #:use-module (guix monads) + #:use-module (guix search-paths) + #:use-module (guix build-system) + #:use-module (guix build-system gnu) + #:use-module (guix build-system node) + #:use-module (ice-9 match) + #:export (%tree-sitter-build-system-modules + tree-sitter-build + tree-sitter-build-system)) + +(define %tree-sitter-build-system-modules + ;; Build-side modules imported by default. + `((guix build tree-sitter-build-system) + ,@%node-build-system-modules)) + +(define* (lower name + #:key source inputs native-inputs outputs system target + #:allow-other-keys + #:rest arguments) + "Return a bag for NAME from the given arguments." + (define private-keywords + `(#:inputs #:native-inputs #:outputs ,@(if target + '() + '(#:target)))) + (define node + (module-ref (resolve-interface '(gnu packages node)) + 'node-lts)) + (define tree-sitter + (module-ref (resolve-interface '(gnu packages tree-sitter)) + 'tree-sitter)) + (define tree-sitter-cli + (module-ref (resolve-interface '(gnu packages tree-sitter)) + 'tree-sitter-cli)) + ;; Grammars depend on each other via JS modules, which we package into a + ;; dedicated js output. + (define grammar-inputs + (map (match-lambda + ((name package) + `(,name ,package "js"))) + inputs)) + (bag + (name name) + (system system) (target target) + (build-inputs `(,@(if source + `(("source" ,source)) + '()) + ("node" ,node) + ("tree-sitter-cli" ,tree-sitter-cli) + ,@native-inputs + ,@(if target '() grammar-inputs) + ;; Keep the standard inputs of 'gnu-build-system'. + ,@(if target + (standard-cross-packages target 'host) + '()) + ,@(standard-packages))) + (host-inputs `(("tree-sitter" ,tree-sitter) + ,@(if target grammar-inputs '()))) + ;; Keep the standard inputs of 'gnu-buid-system'. + (target-inputs (if target + (standard-cross-packages target 'target) + '())) + ;; XXX: this is a hack to get around issue #41569. + (outputs (match outputs + (("out") (cons "js" outputs)) + (_ outputs))) + (build (if target tree-sitter-cross-build tree-sitter-build)) + (arguments (strip-keyword-arguments private-keywords arguments)))) + +(define* (tree-sitter-build name inputs + #:key + source + (phases '%standard-phases) + (grammar-directories '(".")) + (tests? #t) + (outputs '("out" "js")) + (search-paths '()) + (system (%current-system)) + (guile #f) + (imported-modules %tree-sitter-build-system-modules) + (modules '((guix build utils) + (guix build tree-sitter-build-system)))) + (define builder + (with-imported-modules imported-modules + #~(begin + (use-modules #$@(sexp->gexp modules)) + (tree-sitter-build #:name #$name + #:source #+source + #:system #$system + #:phases #$phases + #:tests? #$tests? + #:grammar-directories '#$grammar-directories + #:outputs #$(outputs->gexp outputs) + #:search-paths + '#$(sexp->gexp + (map search-path-specification->sexp + search-paths)) + #:inputs #$(input-tuples->gexp inputs))))) + + (mlet %store-monad ((guile (package->derivation (or guile (default-guile)) + system #:graft? #f))) + (gexp->derivation name builder + #:system system + #:guile-for-build guile))) + +(define* (tree-sitter-cross-build name + #:key + target + build-inputs target-inputs host-inputs + guile source + (phases '%standard-phases) + (grammar-directories '(".")) + (tests? #t) + (outputs '("out" "js")) + (search-paths '()) + (native-search-paths '()) + (system (%current-system)) + (build (nix-system->gnu-triplet system)) + (imported-modules + %tree-sitter-build-system-modules) + (modules + '((guix build utils) + (guix build tree-sitter-build-system)))) + (define builder + (with-imported-modules imported-modules + #~(begin + (use-modules #$@(sexp->gexp modules)) + + (define %build-host-inputs + #+(input-tuples->gexp build-inputs)) + + (define %build-target-inputs + (append #$(input-tuples->gexp host-inputs) + #+(input-tuples->gexp target-inputs))) + + (define %build-inputs + (append %build-host-inputs %build-target-inputs)) + + (tree-sitter-build #:name #$name + #:source #+source + #:system #$system + #:build #$build + #:target #$target + #:phases #$phases + #:tests? #$tests? + #:grammar-directories '#$grammar-directories + #:outputs #$(outputs->gexp outputs) + #:inputs %build-target-inputs + #:native-inputs %build-host-inputs + #:search-paths ' + #$(sexp->gexp + (map search-path-specification->sexp + search-paths)) + #:native-search-paths + '#$(sexp->gexp + (map + search-path-specification->sexp + native-search-paths)))))) + + (mlet %store-monad ((guile (package->derivation (or guile (default-guile)) + system #:graft? #f))) + (gexp->derivation name builder + #:system system + #:target target + #:guile-for-build guile))) + +(define tree-sitter-build-system + (build-system + (name 'tree-sitter) + (description "The Tree-sitter grammar build system") + (lower lower))) + +;;; tree-sitter.scm ends here diff --git a/guix/build/tree-sitter-build-system.scm b/guix/build/tree-sitter-build-system.scm new file mode 100644 index 0000000000..4106728bdf --- /dev/null +++ b/guix/build/tree-sitter-build-system.scm @@ -0,0 +1,153 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2022 Pierre Langlois +;;; +;;; 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 . + +(define-module (guix build tree-sitter-build-system) + #:use-module ((guix build node-build-system) #:prefix node:) + #:use-module (guix build json) + #:use-module (guix build utils) + #:use-module (ice-9 match) + #:use-module (ice-9 regex) + #:use-module (srfi srfi-1) + #:export (%standard-phases + tree-sitter-build)) + +;; Commentary: +;; +;; Build procedures for tree-sitter grammar packages. This is the +;; builder-side code, which builds on top of the node build-system. +;; +;; Tree-sitter grammars are written in JavaScript and compiled to a native +;; shared object. The `tree-sitter generate' command invokes `node' in order +;; to evaluate the grammar.js into a grammar.json file, which is then +;; translated into C code. We then compile the C code ourselves. Packages +;; also sometimes add extra manually written C/C++ code. +;; +;; In order to support grammars depending on each other, such as C and C++, +;; JavaScript and TypeScript, this build-system installs the source of the +;; node module in a dedicated "js" output. +;; +;; Code: + +(define* (patch-dependencies #:key inputs #:allow-other-keys) + "Rewrite dependencies in 'package.json'. We remove all runtime dependencies +and replace development dependencies with tree-sitter grammar node modules." + + (define (rewrite package.json) + (map (match-lambda + (("dependencies" @ . _) + '("dependencies" @)) + (("devDependencies" @ . _) + `("devDependencies" @ + ,@(filter-map (match-lambda + ((key . directory) + (let ((node-module + (string-append directory + "/lib/node_modules/" + key))) + (and (directory-exists? node-module) + `(,key . ,node-module))))) + (alist-delete "node" inputs)))) + (other other)) + package.json)) + + (node:with-atomic-json-file-replacement "package.json" + (match-lambda + (('@ . package.json) + (cons '@ (rewrite package.json)))))) + +;; FIXME: The node build-system's configure phase does not support +;; cross-compiling so we re-define it. +(define* (configure #:key native-inputs inputs #:allow-other-keys) + (invoke (search-input-file (or native-inputs inputs) "/bin/npm") + "--offline" "--ignore-scripts" "install")) + +(define* (build #:key grammar-directories #:allow-other-keys) + (for-each (lambda (dir) + (with-directory-excursion dir + ;; Avoid generating binding code for other languages, we do + ;; not support this use-case yet and it relies on running + ;; `node-gyp' to build native addons. + (invoke "tree-sitter" "generate" "--no-bindings"))) + grammar-directories)) + +(define* (check #:key grammar-directories tests? #:allow-other-keys) + (when tests? + (for-each (lambda (dir) + (with-directory-excursion dir + (invoke "tree-sitter" "test"))) + grammar-directories))) + +(define* (install #:key target grammar-directories outputs #:allow-other-keys) + (let ((lib (string-append (assoc-ref outputs "out") + "/lib/tree-sitter"))) + (mkdir-p lib) + (define (compile-language dir) + (with-directory-excursion dir + (let ((lang (assoc-ref (call-with-input-file "src/grammar.json" + read-json) + "name")) + (source-file (lambda (path) + (if (file-exists? path) + path + #f)))) + (apply invoke + `(,(if target + (string-append target "-g++") + "g++") + "-shared" + "-fPIC" + "-fno-exceptions" + "-O2" + "-g" + "-o" ,(string-append lib "/libtree-sitter-" lang ".so") + ;; An additional `scanner.{c,cc}' file is sometimes + ;; provided. + ,@(cond + ((source-file "src/scanner.c") + => (lambda (file) (list "-xc" "-std=c99" file))) + ((source-file "src/scanner.cc") + => (lambda (file) (list file))) + (else '())) + "-xc" "src/parser.c"))))) + (for-each compile-language grammar-directories))) + +(define* (install-js #:key native-inputs inputs outputs #:allow-other-keys) + (invoke (search-input-file (or native-inputs inputs) "/bin/npm") + "--prefix" (assoc-ref outputs "js") + "--global" + "--offline" + "--loglevel" "info" + "--production" + ;; Skip scripts to prevent building bindings via GYP. + "--ignore-scripts" + "install" "../package.tgz")) + +(define %standard-phases + (modify-phases node:%standard-phases + (replace 'patch-dependencies patch-dependencies) + (replace 'configure configure) + (replace 'build build) + (replace 'check check) + (replace 'install install) + (add-after 'install 'install-js install-js))) + +(define* (tree-sitter-build #:key inputs (phases %standard-phases) + #:allow-other-keys #:rest args) + (apply node:node-build #:inputs inputs #:phases phases args)) + +;;; tree-sitter-build-system.scm ends here -- cgit v1.2.3 From 29d5fb76193b787c4f825af513effb7793301f0c Mon Sep 17 00:00:00 2001 From: zimoun Date: Wed, 6 Apr 2022 21:19:07 +0200 Subject: build: haskell-build-system: Remove trailing #t. * guix/build/haskell-build-system.scm (configure, install, setup-compiler, make-ghc-package-database, install-transitive-deps, check, haddock, patch-cabal-file, generate-setuphs): Delete trailing #t. Signed-off-by: Lars-Dominik Braun --- guix/build/haskell-build-system.scm | 25 +++++++++---------------- 1 file changed, 9 insertions(+), 16 deletions(-) (limited to 'guix/build') diff --git a/guix/build/haskell-build-system.scm b/guix/build/haskell-build-system.scm index ef6cb316ee..e2e5904dce 100644 --- a/guix/build/haskell-build-system.scm +++ b/guix/build/haskell-build-system.scm @@ -5,6 +5,7 @@ ;;; Copyright © 2018, 2020 Ricardo Wurmus ;;; Copyright © 2018 Alex Vong ;;; Copyright © 2021 John Kehayias +;;; Copyright © 2022 Simon Tournier ;;; ;;; This file is part of GNU Guix. ;;; @@ -118,8 +119,7 @@ and parameters ~s~%" (setenv "CONFIG_SHELL" "sh")) (run-setuphs "configure" params) - (setenv "GHC_PACKAGE_PATH" ghc-path) - #t)) + (setenv "GHC_PACKAGE_PATH" ghc-path))) (define* (build #:key parallel-build? #:allow-other-keys) "Build a given Haskell package." @@ -140,8 +140,7 @@ and parameters ~s~%" (new (string-append static subdir))) (mkdir-p (dirname new)) (rename-file static-lib new))) - (find-files lib "\\.a$")))) - #t) + (find-files lib "\\.a$"))))) (define* (setup-compiler #:key system inputs outputs #:allow-other-keys) "Setup the compiler environment." @@ -175,8 +174,7 @@ and parameters ~s~%" conf-files) (invoke "ghc-pkg" (string-append "--package-db=" %tmp-db-dir) - "recache") - #t)) + "recache"))) (define* (register #:key name system inputs outputs #:allow-other-keys) "Generate the compiler registration and binary package database files for a @@ -273,21 +271,18 @@ given Haskell package." config-file-name+id ".conf")) (invoke "ghc-pkg" (string-append "--package-db=" config-dir) - "recache"))) - #t)) + "recache"))))) (define* (check #:key tests? test-target #:allow-other-keys) "Run the test suite of a given Haskell package." (if tests? (run-setuphs test-target '()) - (format #t "test suite not run~%")) - #t) + (format #t "test suite not run~%"))) (define* (haddock #:key outputs haddock? haddock-flags #:allow-other-keys) "Generate the Haddock documentation of a given Haskell package." (when haddock? - (run-setuphs "haddock" haddock-flags)) - #t) + (run-setuphs "haddock" haddock-flags))) (define* (patch-cabal-file #:key cabal-revision #:allow-other-keys) (when cabal-revision @@ -296,8 +291,7 @@ given Haskell package." ((original) (format #t "replacing ~s with ~s~%" original cabal-revision) (copy-file cabal-revision original)) - (_ (error "Could not find a Cabal file to patch.")))) - #t) + (_ (error "Could not find a Cabal file to patch."))))) (define* (generate-setuphs #:rest empty) "Generate a default Setup.hs if needed." @@ -307,8 +301,7 @@ given Haskell package." (with-output-to-file "Setup.hs" (lambda () (format #t "import Distribution.Simple~%") - (format #t "main = defaultMain~%")))) - #t) + (format #t "main = defaultMain~%"))))) (define %standard-phases (modify-phases gnu:%standard-phases -- cgit v1.2.3 From 3455a004ec78a8c8a579b74da8039fbcd36cea73 Mon Sep 17 00:00:00 2001 From: Philip Munksgaard Date: Wed, 6 Apr 2022 21:19:08 +0200 Subject: build: haskell-build-system: Support multiple libraries. Fixes . 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 . Signed-off-by: Lars-Dominik Braun --- guix/build/haskell-build-system.scm | 87 +++++++++++++++++++++---------------- 1 file changed, 49 insertions(+), 38 deletions(-) (limited to 'guix/build') diff --git a/guix/build/haskell-build-system.scm b/guix/build/haskell-build-system.scm index e2e5904dce..fb4aba28ea 100644 --- a/guix/build/haskell-build-system.scm +++ b/guix/build/haskell-build-system.scm @@ -6,6 +6,7 @@ ;;; Copyright © 2018 Alex Vong ;;; Copyright © 2021 John Kehayias ;;; Copyright © 2022 Simon Tournier +;;; Copyright © 2022 Philip Munksgaard ;;; ;;; This file is part of GNU Guix. ;;; @@ -215,13 +216,50 @@ given Haskell package." (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 @@ given Haskell package." (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 @@ 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* ((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." -- cgit v1.2.3 From 39c97cf3d03e2a5f7929654ecf92e92ab03bb953 Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Fri, 6 Jan 2023 12:46:26 +0100 Subject: build: haskell-build-system: Process all transitive dependencies. A bug caused install-transitive-deps to stop looping if a dependency file already existed in the target directory. For Haskell packages with multiple libraries (like attoparsec) this resulted in missing dependencies and error messages like this: The following packages are broken because other packages they depend on are missing. These broken packages must be rebuilt before they can be used. installed package attoparsec-0.14.4 is broken due to missing package scientific-0.3.7.0-9XG3zUjXOw970JFcruv0cZ See . * guix/build/haskell-build-system.scm (register): Unconditionally loop over all tails. --- guix/build/haskell-build-system.scm | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) (limited to 'guix/build') diff --git a/guix/build/haskell-build-system.scm b/guix/build/haskell-build-system.scm index fb4aba28ea..72e12ba746 100644 --- a/guix/build/haskell-build-system.scm +++ b/guix/build/haskell-build-system.scm @@ -214,14 +214,16 @@ given Haskell package." (() #t) ;done ((id . tail) (if (not (vhash-assoc id seen)) - (let ((dep-conf (string-append src "/" id ".conf")) - (dep-conf* (string-append dest "/" id ".conf"))) - (unless (file-exists? dep-conf*) - (unless (file-exists? dep-conf) + (let* ((dep-conf (string-append src "/" id ".conf")) + (dep-conf* (string-append dest "/" id ".conf")) + (dep-conf-exists? (file-exists? dep-conf)) + (dep-conf*-exists? (file-exists? dep-conf*)) + (next-tail (append lst (if dep-conf-exists? (conf-depends dep-conf) '())))) + (unless dep-conf*-exists? + (unless dep-conf-exists? (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) next-tail)) (loop seen tail)))))) (define (install-config-file conf-file dest output:doc output:lib) -- cgit v1.2.3 From 9262c14d73b4b216bb9c1f76fb6b3a9709da1de3 Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Fri, 20 Jan 2023 16:57:27 +0100 Subject: build: haskell-build-system: Remove unused linker flags. They were inserted as-is, without expandind variables into binaries. * guix/build/haskell-build-system.scm (configure): Remove --ghc-option. --- guix/build/haskell-build-system.scm | 2 -- 1 file changed, 2 deletions(-) (limited to 'guix/build') diff --git a/guix/build/haskell-build-system.scm b/guix/build/haskell-build-system.scm index 72e12ba746..759d3c5d17 100644 --- a/guix/build/haskell-build-system.scm +++ b/guix/build/haskell-build-system.scm @@ -103,8 +103,6 @@ and parameters ~s~%" "--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. -- cgit v1.2.3 From 4bb40b098d81e70ebaf86250cb0162bb285ef6ca Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Sun, 29 Jan 2023 18:43:05 +0100 Subject: build-system: haskell: Drop default "static" output. * guix/build-system/haskell.scm (lower): Pass outputs to lowered bag. * guix/build/haskell-build-system.scm (install): Remove static library moving code. * gnu/packages/haskell-check.scm (ghc-hunit): Remove "static" output. * gnu/packages/haskell-crypto.scm (ghc-crypto-api-tests): Likewise. * gnu/packages/haskell-xyz.scm (ghc-case-insensitive): Likewise. (ghc-cmdargs): Likewise. (ghc-conduit): Likewise. (ghc-fgl): Likewise. (ghc-haskell-src-exts): Likewise. (ghc-lib-parser): Likewise. (ghc-mono-traversable): Likewise. (ghc-parallel): Likewise. (ghc-paths): Likewise. (ghc-profunctors): Likewise. (ghc-tf-random): Likewise. (ghc-vector): Likewise. --- gnu/packages/haskell-check.scm | 2 +- gnu/packages/haskell-crypto.scm | 1 - gnu/packages/haskell-xyz.scm | 24 ++++++++++++------------ guix/build-system/haskell.scm | 5 +---- guix/build/haskell-build-system.scm | 12 +----------- 5 files changed, 15 insertions(+), 29 deletions(-) (limited to 'guix/build') diff --git a/gnu/packages/haskell-check.scm b/gnu/packages/haskell-check.scm index 6b7fe878e2..23727fc0b8 100644 --- a/gnu/packages/haskell-check.scm +++ b/gnu/packages/haskell-check.scm @@ -629,7 +629,7 @@ using Template Haskell") (package (name "ghc-hunit") (version "1.6.2.0") - (outputs '("out" "static" "doc")) + (outputs '("out" "doc")) (source (origin (method url-fetch) diff --git a/gnu/packages/haskell-crypto.scm b/gnu/packages/haskell-crypto.scm index 0046e0481a..42e2a15709 100644 --- a/gnu/packages/haskell-crypto.scm +++ b/gnu/packages/haskell-crypto.scm @@ -141,7 +141,6 @@ algorithm (ex: padding) is within scope of this package.") "0w3j43jdrlj28jryp18hc6q84nkl2yf4vs1hhgrsk7gb9kfyqjpl")))) (build-system haskell-build-system) (properties '((upstream-name . "crypto-api-tests"))) - (outputs '("out" "static" "doc")) (inputs (list ghc-test-framework-quickcheck2 ghc-crypto-api ghc-cereal diff --git a/gnu/packages/haskell-xyz.scm b/gnu/packages/haskell-xyz.scm index 03d670fa92..475db5c275 100644 --- a/gnu/packages/haskell-xyz.scm +++ b/gnu/packages/haskell-xyz.scm @@ -1395,7 +1395,7 @@ call stacks with different versions of the compiler.") (package (name "ghc-case-insensitive") (version "1.2.1.0") - (outputs '("out" "static" "doc")) + (outputs '("out" "doc")) (source (origin (method url-fetch) @@ -1993,7 +1993,7 @@ of the C library.") "0xfabq187n1vqrnnm4ciprpl0dcjq97rksyjnpcniwva9rffmn7p")))) (build-system haskell-build-system) (properties '((upstream-name . "cmdargs"))) - (outputs '("out" "static" "doc")) + (outputs '("out" "doc")) (home-page "http://community.haskell.org/~ndm/cmdargs/") (synopsis "Command line argument processing") @@ -2171,7 +2171,7 @@ concurrent threads. Can be used for progress displays etc.") "18izjgff4pmrknc8py06yvg3g6x27nx0rzmlwjxcflwm5v4szpw4")))) (build-system haskell-build-system) (properties '((upstream-name . "conduit"))) - (outputs '("out" "static" "doc")) + (outputs '("out" "doc")) (inputs (list ghc-exceptions ghc-lifted-base @@ -3855,7 +3855,7 @@ consuming feeds in both RSS (Really Simple Syndication) and Atom format.") (package (name "ghc-fgl") (version "5.7.0.3") - (outputs '("out" "static" "doc")) + (outputs '("out" "doc")) (source (origin (method url-fetch) @@ -4958,7 +4958,7 @@ package are to parse or generate Haskell 98 code.") "01bcrxs9af4yqpclw43aijmsd1g19qhyzb47blz7vzwz2r3k11b7")))) (build-system haskell-build-system) (properties '((upstream-name . "haskell-src-exts"))) - (outputs '("out" "static" "doc")) + (outputs '("out" "doc")) (inputs (list cpphs ghc-happy ghc-pretty-show)) (native-inputs @@ -6349,7 +6349,7 @@ Music Player Daemon.") "1xh8rm5lwbh96g4v34whkcbb1yjsyvx3rwwycj30lrglhqk7f4c4")))) (build-system haskell-build-system) (properties '((upstream-name . "ghc-lib-parser"))) - (outputs '("out" "static" "doc")) ; documentation is 39M + (outputs '("out" "doc")) ; documentation is 39M (native-inputs (list ghc-alex ghc-happy)) (home-page "https://github.com/digital-asset/ghc-lib") (synopsis "The GHC API, decoupled from GHC versions") @@ -7314,7 +7314,7 @@ the @code{mtl-tf} package.") "1dvlp7r7r1lc3fxkwaz68f1nffg83240q8a989x24x1x67rj1clq")))) (build-system haskell-build-system) (properties '((upstream-name . "mono-traversable"))) - (outputs '("out" "static" "doc")) + (outputs '("out" "doc")) (inputs (list ghc-unordered-containers ghc-hashable ghc-vector ghc-vector-algorithms ghc-split)) (native-inputs (list ghc-hspec ghc-hunit ghc-quickcheck ghc-foldl)) @@ -8320,7 +8320,7 @@ building up, manipulating and serialising @code{Pandoc} structures.") (package (name "ghc-parallel") (version "3.2.2.0") - (outputs '("out" "static" "doc")) + (outputs '("out" "doc")) (source (origin (method url-fetch) @@ -8480,7 +8480,7 @@ files/directories, and more.") (package (name "ghc-paths") (version "0.1.0.12") - (outputs '("out" "static" "doc")) + (outputs '("out" "doc")) (source (origin (method url-fetch) @@ -9118,7 +9118,7 @@ API.") "0an9v003ivxmjid0s51qznbjhd5fsa1dkcfsrhxllnjja1xmv5b5")))) (build-system haskell-build-system) (properties '((upstream-name . "profunctors"))) - (outputs '("out" "static" "doc")) + (outputs '("out" "doc")) (inputs (list ghc-base-orphans ghc-bifunctors @@ -11894,7 +11894,7 @@ string metrics efficiently.") (package (name "ghc-tf-random") (version "0.5") - (outputs '("out" "static" "doc")) + (outputs '("out" "doc")) (source (origin (method url-fetch) @@ -13163,7 +13163,7 @@ representing a store for a single element.") (package (name "ghc-vector") (version "0.12.3.1") - (outputs '("out" "static" "doc")) + (outputs '("out" "doc")) (source (origin (method url-fetch) diff --git a/guix/build-system/haskell.scm b/guix/build-system/haskell.scm index dc83512d30..a37b3a938c 100644 --- a/guix/build-system/haskell.scm +++ b/guix/build-system/haskell.scm @@ -109,10 +109,7 @@ version REVISION." ,@(standard-packages))) (build-inputs `(("haskell" ,haskell) ,@native-inputs)) - ;; XXX: this is a hack to get around issue #41569. - (outputs (match outputs - (("out") (cons "static" outputs)) - (_ outputs))) + (outputs outputs) (build haskell-build) (arguments (substitute-keyword-arguments diff --git a/guix/build/haskell-build-system.scm b/guix/build/haskell-build-system.scm index 759d3c5d17..d77f55da19 100644 --- a/guix/build/haskell-build-system.scm +++ b/guix/build/haskell-build-system.scm @@ -129,17 +129,7 @@ and parameters ~s~%" (define* (install #:key outputs #:allow-other-keys) "Install a given Haskell package." - (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$"))))) + (run-setuphs "copy" '())) (define* (setup-compiler #:key system inputs outputs #:allow-other-keys) "Setup the compiler environment." -- cgit v1.2.3 From dc3e22f4d5d7aa94fef9e380a3d2c0d71143ced9 Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Sun, 29 Jan 2023 18:50:10 +0100 Subject: build: haskell-build-system: Build static executables by default. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This is the only way to get reasonably small binaries that don’t pull in a ton of ghc-* packages. * guix/build/haskell-build-system.scm (configure): Explicitly add --enable-static and --disable-executable-dynamic, as well as -split-sections to configure flags. --- guix/build/haskell-build-system.scm | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) (limited to 'guix/build') diff --git a/guix/build/haskell-build-system.scm b/guix/build/haskell-build-system.scm index d77f55da19..0e94cf59a5 100644 --- a/guix/build/haskell-build-system.scm +++ b/guix/build/haskell-build-system.scm @@ -99,10 +99,14 @@ and parameters ~s~%" ,@(if tests? '("--enable-tests") '()) - ;; Build and link with shared libraries + ;; Build static and shared libraries. "--enable-shared" - "--enable-executable-dynamic" + "--enable-static" + ;; Link executables statically by default. + "--disable-executable-dynamic" "--ghc-option=-fPIC" + ;; Ensure static libraries can be used with -Wl,--gc-sections for size. + "--ghc-option=-split-sections" ,@configure-flags))) ;; Cabal errors if GHC_PACKAGE_PATH is set during 'configure', so unset ;; and restore it. -- cgit v1.2.3