From 4c0597a95ae3cd111ef12d675edf501c559458ba Mon Sep 17 00:00:00 2001 From: Petter Date: Sun, 11 Dec 2016 01:10:09 +0100 Subject: [PATCH] gnu: Add Go build system. * guix/build-system/go.scm: New file * guix/build/go-build-system.scm: New file. --- guix/build-system/go.scm | 193 +++++++++++++++++++++++++++++++++++++++++ guix/build/go-build-system.scm | 186 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 379 insertions(+) create mode 100644 guix/build-system/go.scm create mode 100644 guix/build/go-build-system.scm diff --git a/guix/build-system/go.scm b/guix/build-system/go.scm new file mode 100644 index 0000000..f336f20 --- /dev/null +++ b/guix/build-system/go.scm @@ -0,0 +1,193 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2016 Petter +;;; +;;; 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 go) + #:use-module (guix store) + #:use-module (guix utils) + #:use-module (guix combinators) + #:use-module (guix derivations) + #:use-module (guix search-paths) + #:use-module (guix build-system) + #:use-module (guix packages) + #:use-module (gnu packages base) + #:use-module (gnu packages golang) + #:use-module (srfi srfi-1) + #:use-module (ice-9 match) + #:export (%go-build-system-modules + go-build + go-build-system + sourcestuff + standard-packages)) + +;; Commentary: +;; +;; Standard build procedure for packages using the GNU Build System or +;; something compatible ("./configure && make && make install"). +;; +;; Code: + +(define %go-build-system-modules + ;; Build-side modules imported and used by default. + '((guix build go-build-system) + (guix build utils) + (guix build gremlin) + (guix elf))) + +(define %default-modules + ;; Modules in scope in the build-side environment. + '((guix build go-build-system) + (guix build utils))) + +(define* (lower name + #:key source inputs native-inputs outputs target + (implicit-inputs? #t) (implicit-cross-inputs? #t) + (strip-binaries? #t) system + #:allow-other-keys + #:rest arguments) + "Return a bag for NAME from the given arguments." + (define private-keywords + `(#:source #:inputs #:native-inputs #:outputs + #:implicit-inputs? #:implicit-cross-inputs? + ,@(if target '() '(#:target)))) + + (bag + (name name) + (system system) (target target) + (build-inputs `(,@(if source + `(("source" ,source))) + ("go" ,go) + ,@native-inputs)) + (host-inputs inputs) + + (build (if target gnu-cross-build go-build)) + (arguments (strip-keyword-arguments private-keywords arguments)))) + +(define* (go-build store name input-drvs + #:key (guile #f) + (outputs '("out")) + (search-paths '()) + (configure-flags ''()) + (make-flags ''()) + (out-of-source? #f) + (tests? #t) + (import-path "") + (unpack-path "") + (test-target "check") + (parallel-build? #t) + (parallel-tests? #t) + (phases '%standard-phases) + (locale "en_US.utf8") + (system (%current-system)) + (build (nix-system->gnu-triplet system)) + (imported-modules %go-build-system-modules) + (modules %default-modules) + (substitutable? #t) + allowed-references + disallowed-references) + "Return a derivation called NAME that builds from tarball SOURCE, with +input derivation INPUTS, using the usual procedure of the GNU Build +System. The builder is run with GUILE, or with the distro's final Guile +package if GUILE is #f or omitted. + +The builder is run in a context where MODULES are used; IMPORTED-MODULES +specifies modules not provided by Guile itself that must be imported in +the builder's environment, from the host. Note that we distinguish +between both, because for Guile's own modules like (ice-9 foo), we want +to use GUILE's own version of it, rather than import the user's one, +which could lead to gratuitous input divergence. + +SUBSTITUTABLE? determines whether users may be able to use substitutes of the +returned derivations, or whether they should always build it locally. + +ALLOWED-REFERENCES can be either #f, or a list of packages that the outputs +are allowed to refer to. Likewise for DISALLOWED-REFERENCES, which lists +packages that must not be referenced." + (define canonicalize-reference + (match-lambda + ((? package? p) + (derivation->output-path (package-derivation store p system + #:graft? #f))) + (((? package? p) output) + (derivation->output-path (package-derivation store p system + #:graft? #f) + output)) + ((? string? output) + output))) + + (define builder + `(begin + (use-modules ,@modules) + (go-build #:source ,(match (assoc-ref input-drvs "source") + (((? derivation? source)) + (derivation->output-path source)) + ((source) + source) + (source + source)) + #:import-path ,import-path + #:unpack-path ,unpack-path + #:system ,system + #:build ,build + #:outputs %outputs + #:inputs %build-inputs + #:search-paths ',(map search-path-specification->sexp + search-paths) + #:phases ,phases + #:locale ,locale + #:configure-flags ,configure-flags + #:make-flags ,make-flags + #:out-of-source? ,out-of-source? + #:tests? ,tests? + #:test-target ,test-target + #:parallel-build? ,parallel-build? + #:parallel-tests? ,parallel-tests?))) + + (define guile-for-build + (match guile + ((? package?) + (package-derivation store guile system #:graft? #f)) + (#f ; the default + (let* ((distro (resolve-interface '(gnu packages commencement))) + (guile (module-ref distro 'guile-final))) + (package-derivation store guile system + #:graft? #f))))) + + (build-expression->derivation store name builder + #:system system + #:inputs input-drvs + #:outputs outputs + #:modules imported-modules + #:substitutable? substitutable? + + #:allowed-references + (and allowed-references + (map canonicalize-reference + allowed-references)) + #:disallowed-references + (and disallowed-references + (map canonicalize-reference + disallowed-references)) + #:guile-for-build guile-for-build)) + + +(define go-build-system + (build-system + (name 'go) + (description + "The GO Build System") + (lower lower))) diff --git a/guix/build/go-build-system.scm b/guix/build/go-build-system.scm new file mode 100644 index 0000000..5a94b60 --- /dev/null +++ b/guix/build/go-build-system.scm @@ -0,0 +1,186 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2016 Petter +;;; +;;; 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 go-build-system) + #:use-module (guix build utils) + #:use-module (guix build gremlin) + #:use-module (guix elf) + #:use-module (ice-9 ftw) + #:use-module (ice-9 match) + #:use-module (ice-9 regex) + #:use-module (ice-9 format) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-19) + #:use-module (srfi srfi-26) + #:use-module (rnrs io ports) + #:export (%standard-phases + go-build)) + +;; Commentary: +;; +;; Standard build procedure for packages using the GNU Build System or +;; something compatible ("./configure && make && make install"). This is the +;; builder-side code. +;; +;; Code: + +(define* (set-SOURCE-DATE-EPOCH #:rest _) + "Set the 'SOURCE_DATE_EPOCH' environment variable. This is used by tools +that incorporate timestamps as a way to tell them to use a fixed timestamp. +See https://reproducible-builds.org/specs/source-date-epoch/." + (setenv "SOURCE_DATE_EPOCH" "1") + #t) + +(define* (set-paths #:key target inputs native-inputs + #:allow-other-keys) + + (define input-directories + (match inputs + (((_ . dir) ...) + dir))) + + (define native-input-directories + (match native-inputs + (((_ . dir) ...) + dir) + (#f + '()))) + + (set-path-environment-variable "PATH" '("bin" "sbin") + (append native-input-directories + (if target + '() + input-directories))) + + #t) + +(define* (install-locale #:key + (locale "en_US.utf8") + (locale-category LC_ALL) + #:allow-other-keys) + "Try to install LOCALE; emit a warning if that fails. The main goal is to +use a UTF-8 locale so that Guile correctly interprets UTF-8 file names. + +This phase must typically happen after 'set-paths' so that $LOCPATH has a +chance to be set." + (catch 'system-error + (lambda () + (setlocale locale-category locale) + + ;; While we're at it, pass it to sub-processes. + (setenv (locale-category->string locale-category) locale) + + (format (current-error-port) "using '~a' locale for category ~s~%" + locale (locale-category->string locale-category)) + #t) + (lambda args + ;; This is known to fail for instance in early bootstrap where locales + ;; are not available. + (format (current-error-port) + "warning: failed to install '~a' locale: ~a~%" + locale (strerror (system-error-errno args))) + #t))) + +(define* (unpack #:key source import-path unpack-path #:allow-other-keys) + "Unpack SOURCE in the working directory, and change directory within the +source. When SOURCE is a directory, copy it in a sub-directory of the current +working directory." + (if (string-null? import-path) + ((display "WARNING: import-path is unset\n"))) + (if (string-null? unpack-path) + (set! unpack-path import-path)) + (mkdir-p "bin") + (mkdir-p "pkg") + (let ((src (string-append "src/" unpack-path))) + (mkdir-p src) + (copy-recursively source src))) + +(define* (delete-files #:key import-path #:allow-other-keys) #t) + +(define* (set-gopath #:key import-path #:allow-other-keys) + (setenv "GOPATH" (getcwd))) + +(define* (symlinking #:key inputs #:allow-other-keys) + (for-each (lambda (input) + (let ((imppath (car input)) + (storepath (cdr input))) + (if (and (not (string=? imppath "go")) + (not (string=? imppath "source"))) + (begin + (mkdir-p (string-append + "src/" + (string-take imppath + (string-rindex imppath #\/)))) + (let ((from (string-append storepath "/src/" imppath)) + (to (string-append "src/" imppath))) + (if (file-exists? to) (delete-file-recursively to)) + (symlink (string-append + storepath "/src/" imppath) + (string-append + "src/" imppath))))))) + inputs)) + +(define* (build #:key import-path #:allow-other-keys) + (system* "go" "install" import-path)) + +(define* (install #:key inputs outputs #:allow-other-keys) + (copy-recursively "bin" (string-append (assoc-ref outputs "out") "/bin")) + (copy-recursively "pkg" (string-append (assoc-ref outputs "out") "/pkg")) + (copy-recursively "src" (string-append (assoc-ref outputs "out") "/src"))) + +(define %standard-phases + ;; Standard build phases, as a list of symbol/procedure pairs. + (let-syntax ((phases (syntax-rules () + ((_ p ...) `((p . ,p) ...))))) + (phases set-SOURCE-DATE-EPOCH set-paths install-locale unpack + delete-files set-gopath symlinking build install + ))) + +(define* (go-build #:key (source #f) (outputs #f) (inputs #f) + (phases %standard-phases) + #:allow-other-keys + #:rest args) + "Build from SOURCE to OUTPUTS, using INPUTS, and by running all of PHASES +in order. Return #t if all the PHASES succeeded, #f otherwise." + (define (elapsed-time end start) + (let ((diff (time-difference end start))) + (+ (time-second diff) + (/ (time-nanosecond diff) 1e9)))) + + (setvbuf (current-output-port) _IOLBF) + (setvbuf (current-error-port) _IOLBF) + + ;; Encoding/decoding errors shouldn't be silent. + (fluid-set! %default-port-conversion-strategy 'error) + + ;; The trick is to #:allow-other-keys everywhere, so that each procedure in + ;; PHASES can pick the keyword arguments it's interested in. + (every (match-lambda + ((name . proc) + (let ((start (current-time time-monotonic))) + (format #t "starting phase `~a'~%" name) + (let ((result (apply proc args)) + (end (current-time time-monotonic))) + (format #t "phase `~a' ~:[failed~;succeeded~] after ~,1f seconds~%" + name result + (elapsed-time end start)) + + ;; Dump the environment variables as a shell script, for handy debugging. + (system "export > $NIX_BUILD_TOP/environment-variables") + result)))) + phases)) -- 2.10.1