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

gnu: Add dub-build-system.

Browse source 
* guix/build-system/dub.scm: New file.
* guix/build/dub-build-system.scm: New file.
* Makefile.am (MODULES): Add them.
* doc/guix.texi: Add section for dub-build-system.
This commit is contained in:
Danny Milosavljevic 2017-02-06 16:45:08 +01:00
parent 5533071407
commit 65e862d1a2
No known key found for this signature in database
GPG key ID: E71A35542C30BAA5
4 changed files with 284 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
Makefile.am
View file

@ -64,6 +64,7 @@ MODULES = \
guix/build-system/ant.scm \
guix/build-system/cargo.scm \
guix/build-system/cmake.scm \
guix/build-system/dub.scm \
guix/build-system/emacs.scm \
guix/build-system/asdf.scm \
guix/build-system/glib-or-gtk.scm \
@ -88,6 +89,7 @@ MODULES = \
guix/build/download.scm \
guix/build/cargo-build-system.scm \
guix/build/cmake-build-system.scm \
guix/build/dub-build-system.scm \
guix/build/emacs-build-system.scm \
guix/build/asdf-build-system.scm \
guix/build/git.scm \

10
doc/guix.texi
View file

@ -3438,6 +3438,16 @@ Which Haskell compiler is used can be specified with the @code{#:haskell}
parameter which defaults to @code{ghc}.
@end defvr
@defvr {Scheme Variable} dub-build-system
This variable is exported by @code{(guix build-system dub)}. It
implements the Dub build procedure used by D packages, which
involves running @code{dub build} and @code{dub run}.
Installation is done by copying the files manually.
Which D compiler is used can be specified with the @code{#:ldc}
parameter which defaults to @code{ldc}.
@end defvr
@defvr {Scheme Variable} emacs-build-system
This variable is exported by @code{(guix build-system emacs)}. It
implements an installation procedure similar to the packaging system

147
guix/build-system/dub.scm Normal file
View file

@ -0,0 +1,147 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2016 David Craven <david@craven.ch>
;;; Copyright © 2016 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-system dub)
#:use-module (guix search-paths)
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix derivations)
#:use-module (guix packages)
#:use-module (guix build-system)
#:use-module (guix build-system gnu)
#:use-module (ice-9 match)
#:use-module (srfi srfi-26)
#:export (dub-build-system))
(define (default-ldc)
"Return the default ldc package."
;; Lazily resolve the binding to avoid a circular dependency.
(let ((ldc (resolve-interface '(gnu packages ldc))))
(module-ref ldc 'ldc)))
(define (default-dub)
"Return the default dub package."
;; Lazily resolve the binding to avoid a circular dependency.
(let ((ldc (resolve-interface '(gnu packages ldc))))
(module-ref ldc 'dub)))
(define (default-pkg-config)
"Return the default pkg-config package."
;; Lazily resolve the binding to avoid a circular dependency.
(let ((pkg-config (resolve-interface '(gnu packages pkg-config))))
(module-ref pkg-config 'pkg-config)))
(define %dub-build-system-modules
;; Build-side modules imported by default.
`((guix build dub-build-system)
(guix build syscalls)
,@%gnu-build-system-modules))
(define* (dub-build store name inputs
#:key
(tests? #t)
(test-target #f)
(dub-build-flags ''())
(phases '(@ (guix build dub-build-system)
%standard-phases))
(outputs '("out"))
(search-paths '())
(system (%current-system))
(guile #f)
(imported-modules %dub-build-system-modules)
(modules '((guix build dub-build-system)
(guix build utils))))
"Build SOURCE using DUB, and with INPUTS."
(define builder
`(begin
(use-modules ,@modules)
(dub-build #:name ,name
#:source ,(match (assoc-ref inputs "source")
(((? derivation? source))
(derivation->output-path source))
((source)
source)
(source
source))
#:system ,system
#:test-target ,test-target
#:dub-build-flags ,dub-build-flags
#:tests? ,tests?
#:phases ,phases
#:outputs %outputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:inputs %build-inputs)))
(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
#:inputs inputs
#:system system
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build))
(define* (lower name
#:key source inputs native-inputs outputs system target
(ldc (default-ldc))
(dub (default-dub))
(pkg-config (default-pkg-config))
#:allow-other-keys
#:rest arguments)
"Return a bag for NAME."
(define private-keywords
'(#:source #:target #:ldc #:dub #:pkg-config #:inputs #:native-inputs #:outputs))
(and (not target) ;; TODO: support cross-compilation
(bag
(name name)
(system system)
(target target)
(host-inputs `(,@(if source
`(("source" ,source))
'())
,@inputs
;; Keep the standard inputs of 'gnu-build-system'
,@(standard-packages)))
(build-inputs `(("ldc" ,ldc)
("dub" ,dub)
,@native-inputs))
(outputs outputs)
(build dub-build)
(arguments (strip-keyword-arguments private-keywords arguments)))))
(define dub-build-system
(build-system
(name 'dub)
(description
"DUB build system, to build D packages")
(lower lower)))

125
guix/build/dub-build-system.scm Normal file
View file

@ -0,0 +1,125 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 David Craven <david@craven.ch>
;;; Copyright © 2017 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 dub-build-system)
#:use-module ((guix build gnu-build-system) #:prefix gnu:)
#:use-module (guix build syscalls)
#:use-module (guix build utils)
#:use-module (ice-9 popen)
#:use-module (ice-9 rdelim)
#:use-module (ice-9 ftw)
#:use-module (ice-9 format)
#:use-module (ice-9 match)
#:use-module (rnrs io ports)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:export (%standard-phases
dub-build))
;; Commentary:
;;
;; Builder-side code of the DUB (the build tool for D) build system.
;;
;; Code:
;; FIXME: Needs to be parsed from url not package name.
(define (package-name->d-package-name name)
"Return the package name of NAME."
(match (string-split name #\-)
(("d" rest ...)
(string-join rest "-"))
(_ #f)))
(define* (configure #:key inputs #:allow-other-keys)
"Prepare one new directory with all the required dependencies.
It's necessary to do this (instead of just using /gnu/store as the
directory) because we want to hide the libraries in subdirectories
lib/dub/... instead of polluting the user's profile root."
(let* ((dir (mkdtemp! "/tmp/dub.XXXXXX"))
(vendor-dir (string-append dir "/vendor")))
(setenv "HOME" dir)
(mkdir vendor-dir)
(for-each
(match-lambda
((name . path)
(let* ((d-package (package-name->d-package-name name))
(d-basename (basename path)))
(when (and d-package path)
(match (string-split (basename path) #\-)
((_ ... version)
(symlink (string-append path "/lib/dub/" d-basename)
(string-append vendor-dir "/" d-basename))))))))
inputs)
(zero? (system* "dub" "add-path" vendor-dir))))
(define (grep string file-name)
"Find the first occurence of STRING in the file named FILE-NAME.
Return the position of this occurence, or #f if none was found."
(string-contains (call-with-input-file file-name get-string-all)
string))
(define (grep* string file-name)
"Find the first occurence of STRING in the file named FILE-NAME.
Return the position of this occurence, or #f if none was found.
If the file named FILE-NAME doesn't exist, return #f."
(catch 'system-error
(lambda ()
(grep string file-name))
(lambda args
#f)))
(define* (build #:key (dub-build-flags '())
#:allow-other-keys)
"Build a given DUB package."
(if (or (grep* "sourceLibrary" "package.json")
(grep* "sourceLibrary" "dub.sdl") ; note: format is different!
(grep* "sourceLibrary" "dub.json"))
#t
(let ((status (zero? (apply system* `("dub" "build" ,@dub-build-flags)))))
(system* "dub" "run") ; might fail for "targetType": "library"
status)))
(define* (check #:key tests? #:allow-other-keys)
(if tests?
(zero? (system* "dub" "test"))
#t))
(define* (install #:key inputs outputs #:allow-other-keys)
"Install a given DUB package."
(let* ((out (assoc-ref outputs "out"))
(outbin (string-append out "/bin"))
(outlib (string-append out "/lib/dub/" (basename out))))
(mkdir-p outbin)
;; TODO remove "-test-application"
(copy-recursively "bin" outbin)
(mkdir-p outlib)
(copy-recursively "." (string-append outlib))
#t))
(define %standard-phases
(modify-phases gnu:%standard-phases
(replace 'configure configure)
(replace 'build build)
(replace 'check check)
(replace 'install install)))
(define* (dub-build #:key inputs (phases %standard-phases)
#:allow-other-keys #:rest args)
"Build the given DUB package, applying all of PHASES in order."
(apply gnu:gnu-build #:inputs inputs #:phases phases args))