diff options
43 files changed, 678 insertions, 427 deletions
diff --git a/build-aux/hydra/gnu-system.scm b/build-aux/hydra/gnu-system.scm index f62c9cb11d..cfef7dc425 100644 --- a/build-aux/hydra/gnu-system.scm +++ b/build-aux/hydra/gnu-system.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -147,14 +147,18 @@ system.") (if (member system '("x86_64-linux" "i686-linux")) (list (->job 'qemu-image (run-with-store store - (system-qemu-image (demo-os) - #:disk-image-size - (* 1400 MiB)))) ; 1.4 GiB + (mbegin %store-monad + (set-guile-for-build (default-guile)) + (system-qemu-image (demo-os) + #:disk-image-size + (* 1400 MiB))))) ; 1.4 GiB (->job 'usb-image (run-with-store store - (system-disk-image installation-os - #:disk-image-size - (* 800 MiB))))) + (mbegin %store-monad + (set-guile-for-build (default-guile)) + (system-disk-image installation-os + #:disk-image-size + (* 800 MiB)))))) '())) (define job-name diff --git a/doc/guix.texi b/doc/guix.texi index 1739f3268d..7febee48ac 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -2194,8 +2194,8 @@ scheme@@(guile-user)> Note that non-monadic values cannot be returned in the @code{store-monad} REPL. -The main syntactic forms to deal with monads in general are described -below. +The main syntactic forms to deal with monads in general are provided by +the @code{(guix monads)} module and are described below. @deffn {Scheme Syntax} with-monad @var{monad} @var{body} ... Evaluate any @code{>>=} or @code{return} forms in @var{body} as being @@ -2235,8 +2235,8 @@ monadic expressions are ignored. In that sense, it is analogous to @code{begin}, but applied to monadic expressions. @end deffn -The interface to the store monad provided by @code{(guix monads)} is as -follows. +The main interface to the store monad, provided by the @code{(guix +store)} module, is as follows. @defvr {Scheme Variable} %store-monad The store monad. Values in the store monad encapsulate accesses to the @@ -2255,31 +2255,6 @@ Return as a monadic value the absolute file name in the store of the file containing @var{text}, a string. @end deffn -@deffn {Monadic Procedure} text-file* @var{name} @var{text} @dots{} -Return as a monadic value a derivation that builds a text file -containing all of @var{text}. @var{text} may list, in addition to -strings, packages, derivations, and store file names; the resulting -store file holds references to all these. - -This variant should be preferred over @code{text-file} anytime the file -to create will reference items from the store. This is typically the -case when building a configuration file that embeds store file names, -like this: - -@example -(define (profile.sh) - ;; Return the name of a shell script in the store that - ;; initializes the 'PATH' environment variable. - (text-file* "profile.sh" - "export PATH=" coreutils "/bin:" - grep "/bin:" sed "/bin\n")) -@end example - -In this example, the resulting @file{/gnu/store/@dots{}-profile.sh} file -will references @var{coreutils}, @var{grep}, and @var{sed}, thereby -preventing them from being garbage-collected during its lifetime. -@end deffn - @deffn {Monadic Procedure} interned-file @var{file} [@var{name}] @ [#:recursive? #t] Return the name of @var{file} once interned in the store. Use @@ -2303,6 +2278,9 @@ The example below adds a file to the store, under two different names: @end deffn +The @code{(guix packages)} module exports the following package-related +monadic procedures: + @deffn {Monadic Procedure} package-file @var{package} [@var{file}] @ [#:system (%current-system)] [#:target #f] @ [#:output "out"] Return as a monadic @@ -2563,6 +2541,31 @@ The resulting file holds references to all the dependencies of @var{exp} or a subset thereof. @end deffn +@deffn {Monadic Procedure} text-file* @var{name} @var{text} @dots{} +Return as a monadic value a derivation that builds a text file +containing all of @var{text}. @var{text} may list, in addition to +strings, packages, derivations, and store file names; the resulting +store file holds references to all these. + +This variant should be preferred over @code{text-file} anytime the file +to create will reference items from the store. This is typically the +case when building a configuration file that embeds store file names, +like this: + +@example +(define (profile.sh) + ;; Return the name of a shell script in the store that + ;; initializes the 'PATH' environment variable. + (text-file* "profile.sh" + "export PATH=" coreutils "/bin:" + grep "/bin:" sed "/bin\n")) +@end example + +In this example, the resulting @file{/gnu/store/@dots{}-profile.sh} file +will references @var{coreutils}, @var{grep}, and @var{sed}, thereby +preventing them from being garbage-collected during its lifetime. +@end deffn + Of course, in addition to gexps embedded in ``host'' code, there are also modules containing build tools. To make it clear that they are meant to be used in the build stratum, these modules are kept in the diff --git a/gnu-system.am b/gnu-system.am index 8cd2c68e0b..58baec7313 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -422,6 +422,7 @@ dist_patch_DATA = \ gnu/packages/patches/mupdf-buildsystem-fix.patch \ gnu/packages/patches/mutt-CVE-2014-9116.patch \ gnu/packages/patches/net-tools-bitrot.patch \ + gnu/packages/patches/ninja-tests.patch \ gnu/packages/patches/nss-pkgconfig.patch \ gnu/packages/patches/nvi-assume-preserve-path.patch \ gnu/packages/patches/orpheus-cast-errors-and-includes.patch \ diff --git a/gnu/packages/bootstrap.scm b/gnu/packages/bootstrap.scm index 8373c4b5c8..1f0fe16688 100644 --- a/gnu/packages/bootstrap.scm +++ b/gnu/packages/bootstrap.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org> ;;; ;;; This file is part of GNU Guix. @@ -59,9 +59,9 @@ "Return a variant of SOURCE, an <origin> instance, whose method uses %BOOTSTRAP-GUILE to do its job." (define (boot fetch) - (lambda* (store url hash-algo hash + (lambda* (url hash-algo hash #:optional name #:key system) - (fetch store url hash-algo hash + (fetch url hash-algo hash #:guile %bootstrap-guile #:system system))) diff --git a/gnu/packages/fontutils.scm b/gnu/packages/fontutils.scm index f98625cdae..646e12c806 100644 --- a/gnu/packages/fontutils.scm +++ b/gnu/packages/fontutils.scm @@ -147,10 +147,19 @@ X11-system or any other graphical user interface.") (version "2.5.1") (source (origin (method url-fetch) - (uri (string-append + (uri (list + (string-append "http://scripts.sil.org/svn-view/teckit/TAGS/TECkit_" (string-map (lambda (x) (if (char=? x #\.) #\_ x)) version) - ".tar.gz")) + ".tar.gz") + "http://pkgs.fedoraproject.org/repo/pkgs/teckit/TECkit_2_5_1.tar.gz/4913f71f0f42bfd9cf8f161688b35dea/TECkit_2_5_1.tar.gz" + ;; This used to be the canonical URL but it vanished. + ;; See <http://bugs.gnu.org/19600>. + ;; (string-append + ;; "http://scripts.sil.org/svn-view/teckit/TAGS/TECkit_" + ;; (string-map (lambda (x) (if (char=? x #\.) #\_ x)) version) + ;; ".tar.gz") + )) (sha256 (base32 "0fjiwvic8mdxpkyccfp7zh26y9xnvkp0skqbyfkrjiacd191k82r")) (patches (list (search-patch "teckit-cstdio.patch"))))) diff --git a/gnu/packages/games.scm b/gnu/packages/games.scm index b1a68a72c7..f206d3caca 100644 --- a/gnu/packages/games.scm +++ b/gnu/packages/games.scm @@ -5,7 +5,7 @@ ;;; Copyright © 2014 Cyrill Schenkel <cyrill.schenkel@gmail.com> ;;; Copyright © 2014 Sylvain Beucler <beuc@beuc.net> ;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org> -;;; Copyright © 2014 Sou Bunnbu <iyzsong@gmail.com> +;;; Copyright © 2014, 2015 Sou Bunnbu <iyzsong@gmail.com> ;;; Copyright © 2014 Mark H Weaver <mhw@netris.org> ;;; ;;; This file is part of GNU Guix. @@ -60,6 +60,9 @@ #:use-module (gnu packages xiph) #:use-module (gnu packages curl) #:use-module (gnu packages lua) + #:use-module (gnu packages video) + #:use-module (gnu packages which) + #:use-module (gnu packages xml) #:use-module (guix build-system trivial) #:use-module (guix build-system gnu) #:use-module (guix build-system cmake) @@ -820,3 +823,56 @@ playing interactive fiction. It was designed by Andrew Plotkin to relieve some of the restrictions in the venerable Z-machine format. This is the reference interpreter, using Glk API.") (license (license:fsf-free "file://README")))) + +(define-public retroarch + (package + (name "retroarch") + (version "1.0.0.3-beta") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/libretro/RetroArch/archive/" + version ".tar.gz")) + (sha256 + (base32 "1iqcrb076xiih20sk8n1w79xsp4fb8pj4vkmdc1xn562h56y4nxx")))) + (build-system gnu-build-system) + (arguments + '(#:tests? #f ; no tests + #:phases + (alist-replace + 'configure + (lambda _ + (substitute* "qb/qb.libs.sh" + (("/bin/true") (which "true"))) + (zero? (system* + "./configure" + (string-append "--prefix=" %output) + (string-append "--global-config-dir=" %output "/etc")))) + %standard-phases))) + (inputs + `(("alsa-lib" ,alsa-lib) + ("ffmpeg" ,ffmpeg) + ("freetype" ,freetype) + ("libxinerama" ,libxinerama) + ("libxkbcommon" ,libxkbcommon) + ("libxml2" ,libxml2) + ("libxv" ,libxv) + ("mesa" ,mesa) + ("openal" ,openal) + ("pulseaudio" ,pulseaudio) + ("python" ,python) + ("sdl" ,sdl2) + ("udev" ,eudev) + ("zlib" ,zlib))) + (native-inputs + `(("pkg-config" ,pkg-config) + ("which" ,which))) + (home-page "http://www.libretro.com/") + (synopsis "Reference frontend for the libretro API") + (description + "Libretro is a simple but powerful development interface that allows for +the easy creation of emulators, games and multimedia applications that can plug +straight into any libretro-compatible frontend. RetroArch is the official +reference frontend for the libretro API, currently used by most as a modular +multi-system game/emulator system.") + (license license:gpl3+))) diff --git a/gnu/packages/gdb.scm b/gnu/packages/gdb.scm index 8826eb44ee..617ca17681 100644 --- a/gnu/packages/gdb.scm +++ b/gnu/packages/gdb.scm @@ -35,14 +35,14 @@ (define-public gdb (package (name "gdb") - (version "7.8.1") + (version "7.8.2") (source (origin (method url-fetch) (uri (string-append "mirror://gnu/gdb/gdb-" version ".tar.xz")) (sha256 (base32 - "0dfwmcgvlfyvgs8cwslbk42291qwxyriwa3l6j645x46hfsj4xs9")))) + "11a4fj1vpsny71kz7xqqbqk3kgzbs5cfjj3z9gm0hpvxfkam8nb0")))) (build-system gnu-build-system) (arguments '(#:tests? #f ; FIXME "make check" fails on single-processor systems. diff --git a/gnu/packages/gl.scm b/gnu/packages/gl.scm index aa90c7e214..0eb2d2609e 100644 --- a/gnu/packages/gl.scm +++ b/gnu/packages/gl.scm @@ -196,6 +196,50 @@ allows Mesa to be used in many different environments ranging from software emulation to complete hardware acceleration for modern GPUs.") (license l:x11))) +(define-public glew + (package + (name "glew") + (version "1.11.0") + (source (origin + (method url-fetch) + (uri (string-append + "mirror://sourceforge/glew/glew-" + version + ".tgz")) + (sha256 + (base32 + "1mhkllxz49l1x680dmzrv2i82qjrq017sykah3xc90f2d8qcxfv9")) + (modules '((guix build utils))) + (snippet + '(substitute* "config/Makefile.linux" + (("= cc") "= gcc") + (("/lib64") "/lib"))))) + (build-system gnu-build-system) + (arguments + '(#:phases (alist-delete 'configure %standard-phases) + #:make-flags (list (string-append "GLEW_PREFIX=" + (assoc-ref %outputs "out")) + (string-append "GLEW_DEST=" + (assoc-ref %outputs "out"))) + #:tests? #f)) ;no 'check' target + (inputs + `(("libxi" ,libxi) + ("libxmu" ,libxmu) + ("libx11" ,libx11) + ("mesa" ,mesa))) + + ;; <GL/glew.h> includes <GL/glu.h>. + (propagated-inputs `(("glu" ,glu))) + + (home-page "http://glew.sourceforge.net/") + (synopsis "OpenGL extension loading library for C and C++") + (description + "The OpenGL Extension Wrangler Library (GLEW) is a C/C++ extension +loading library. GLEW provides efficient run-time mechanisms for determining +which OpenGL extensions are supported on the target platform. OpenGL core and +extension functionality is exposed in a single header file.") + (license l:bsd-3))) + (define-public guile-opengl (package (name "guile-opengl") diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm index efc7fb7b3f..f8bb6e2c1f 100644 --- a/gnu/packages/linux.scm +++ b/gnu/packages/linux.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013, 2014 Andreas Enge <andreas@enge.fr> ;;; Copyright © 2012 Nikita Karetnikov <nikita@karetnikov.org> ;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org> @@ -511,16 +511,28 @@ slabtop, and skill.") version ".tar.gz")) (sha256 (base32 - "0ibkkvp6kan0hn0d1anq4n2md70j5gcm7mwna515w82xwyr02rfw")))) + "0ibkkvp6kan0hn0d1anq4n2md70j5gcm7mwna515w82xwyr02rfw")) + (modules '((guix build utils))) + (snippet + '(substitute* "MCONFIG.in" + (("INSTALL_SYMLINK = /bin/sh") + "INSTALL_SYMLINK = sh"))))) (build-system gnu-build-system) (inputs `(("util-linux" ,util-linux))) (native-inputs `(("pkg-config" ,pkg-config) - ("texinfo" ,texinfo))) ; for the libext2fs Info manual + ("texinfo" ,texinfo))) ;for the libext2fs Info manual (arguments '(;; The 'blkid' command and library are already provided by util-linux, ;; which is the preferred source for them (see, e.g., ;; <http://git.buildroot.net/buildroot/commit/?id=e1ffc2f791b336339909c90559b7db40b455f172>.) - #:configure-flags '("--disable-blkid") + #:configure-flags '("--disable-blkid" + + ;; Install libext2fs et al. + "--enable-elf-shlibs") + + #:make-flags (list (string-append "LDFLAGS=-Wl,-rpath=" + (assoc-ref %outputs "out") + "/lib")) #:phases (alist-cons-before 'configure 'patch-shells @@ -532,7 +544,11 @@ slabtop, and skill.") (substitute* (find-files "." "^Makefile.in$") (("#!/bin/sh") (string-append "#!" (which "sh"))))) - %standard-phases) + (alist-cons-after + 'install 'install-libs + (lambda _ + (zero? (system* "make" "install-libs"))) + %standard-phases)) ;; FIXME: Tests work by comparing the stdout/stderr of programs, that ;; they fail because we get an extra line that says "Can't check if @@ -579,6 +595,41 @@ from the e2fsprogs package. It is meant to be used in initrds.") (home-page (package-home-page e2fsprogs)) (license (package-license e2fsprogs)))) +(define-public zerofree + (package + (name "zerofree") + (version "1.0.3") + (home-page "http://intgat.tigress.co.uk/rmy/uml/") + (source (origin + (method url-fetch) + (uri (string-append home-page name "-" version + ".tgz")) + (sha256 + (base32 + "1xncw3dn2cp922ly42m96p6fh7jv8ysg6bwqbk5xvw701f3dmkrs")))) + (build-system gnu-build-system) + (arguments + '(#:phases (alist-replace + 'install + (lambda* (#:key outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (bin (string-append out "/bin"))) + (mkdir-p bin) + (copy-file "zerofree" + (string-append bin "/zerofree")) + (chmod (string-append bin "/zerofree") + #o555) + #t)) + (alist-delete 'configure %standard-phases)) + #:tests? #f)) ;no tests + (inputs `(("libext2fs" ,e2fsprogs))) + (synopsis "Zero non-allocated regions in ext2/ext3/ext4 file systems") + (description + "The zerofree command scans the free blocks in an ext2 file system and +fills any non-zero blocks with zeroes. This is a useful way to make disk +images more compressible.") + (license gpl2))) + (define-public strace (package (name "strace") @@ -1511,9 +1562,11 @@ mapper. Kernel components are part of Linux-libre.") %standard-phases) #:tests? #f)) (synopsis "Tools for manipulating Linux Wireless Extensions") - (description "Wireless Tools are used to manipulate the Linux Wireless -Extensions. The Wireless Extension is an interface allowing you to set -Wireless LAN specific parameters and get the specific stats.") + (description "Wireless Tools are used to manipulate the now-deprecated +Linux Wireless Extensions; consider using 'iw' instead. The Wireless +Extension was an interface allowing you to set Wireless LAN specific +parameters and get the specific stats. It is deprecated in favor the nl80211 +interface.") (home-page "http://www.hpl.hp.com/personal/Jean_Tourrilhes/Linux/Tools.html") (license gpl2+))) diff --git a/gnu/packages/ninja.scm b/gnu/packages/ninja.scm index fe3f955b5d..7416b67d02 100644 --- a/gnu/packages/ninja.scm +++ b/gnu/packages/ninja.scm @@ -34,7 +34,8 @@ "archive/v" version ".tar.gz")) (sha256 (base32 - "1h3yfwcfl61v493vna6jia2fizh8rpig7qw2504cvkr6gid3p5bw")))) + "1h3yfwcfl61v493vna6jia2fizh8rpig7qw2504cvkr6gid3p5bw")) + (patches (list (search-patch "ninja-tests.patch"))))) (build-system gnu-build-system) (arguments '(#:phases @@ -52,18 +53,7 @@ (lambda _ (and (zero? (system* "./configure.py")) (zero? (system* "./ninja" "ninja_test")) - ;; SubprocessTest.SetWithLots fails with: - ;; Raise [ulimit -n] well above 1025 to make this test go. - ;; Skip it. - ;; - ;; SubprocessTest.InterruptChild fails when using 'system*': - ;; *** Failure in src/subprocess_test.cc:83 - ;; ExitInterrupted == subproc->Finish() - ;; Pass it by using 'system' instead of 'system*'. - (zero? (system (string-append - "./ninja_test " - "--gtest_filter=" - "-SubprocessTest.SetWithLots"))))) + (zero? (system* "./ninja_test")))) (alist-replace 'install (lambda* (#:key outputs #:allow-other-keys) diff --git a/gnu/packages/package-management.scm b/gnu/packages/package-management.scm index 408734d6fa..62c6b488a6 100644 --- a/gnu/packages/package-management.scm +++ b/gnu/packages/package-management.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -118,42 +118,23 @@ the Nix package manager.") (define guix-devel ;; Development version of Guix. - (let ((commit "3b09332")) + (let ((commit "4655005")) (package (inherit guix-0.8) (version (string-append "0.8." commit)) (source (origin (method git-fetch) (uri (git-reference (url "git://git.sv.gnu.org/guix.git") - (commit commit) - (recursive? #t))) + (commit commit))) (sha256 (base32 - "1szlyhpy688ca96kfyjb6cdy5zhxvqmdig4m7ql7rjqfmz0gvka1")))) + "04dmmnr88mwpsl0mmv03hpllyinn9cs4mmly8k0jm2acwnsni3ii")))) (arguments (substitute-keyword-arguments (package-arguments guix-0.8) ((#:phases phases) `(alist-cons-before 'configure 'bootstrap (lambda _ - ;; Comment out `git' invocations, since 'git-fetch' provides us - ;; with a checkout that includes sub-modules. - (substitute* "bootstrap" - (("git ") - "true git ")) - - ;; Keep a list of the files already available under nix/... - (call-with-output-file "ls-R" - (lambda (port) - (for-each (lambda (file) - (format port "~a~%" file)) - (find-files "nix" "")))) - - ;; ... and use that as a substitute to 'git ls-tree'. - (substitute* "nix/sync-with-upstream" - (("git ls-tree HEAD -- [[:graph:]]+") - "cat ls-R")) - ;; Make sure 'msgmerge' can modify the PO files. (for-each (lambda (po) (chmod po #o666)) @@ -177,14 +158,14 @@ the Nix package manager.") (define-public nix (package (name "nix") - (version "1.7") + (version "1.8") (source (origin (method url-fetch) (uri (string-append "http://nixos.org/releases/nix/nix-" version "/nix-" version ".tar.xz")) (sha256 (base32 - "14nc7mnma5sffqk9mglbf99w3jm4ck8pxnmkgyhy3qra9xjn749l")))) + "077hircacgi9y4n6kf48qp4laz1h3ab6sif3rcci1jy13f05w2m3")))) (build-system gnu-build-system) ;; XXX: Should we pass '--with-store-dir=/gnu/store'? But then we'd also ;; need '--localstatedir=/var'. But then! The thing would use /var/nix diff --git a/gnu/packages/patches/ninja-tests.patch b/gnu/packages/patches/ninja-tests.patch new file mode 100644 index 0000000000..3436b6314d --- /dev/null +++ b/gnu/packages/patches/ninja-tests.patch @@ -0,0 +1,44 @@ +SubprocessTest.SetWithLots fails with: + Raise [ulimit -n] well above 1025 to make this test go. +Skip it. + +SubprocessTest.InterruptChild fails when using 'system*': + *** Failure in src/subprocess_test.cc:83 + ExitInterrupted == subproc->Finish() +I can pass it by using 'system' instead of 'system*' when building locally, +but it still failed on Hydra. Skip it. + +--- ninja-1.5.3.orig/src/subprocess_test.cc 2015-01-15 10:34:28.859522176 +0800 ++++ ninja-1.5.3/src/subprocess_test.cc 2015-01-15 10:37:52.969572075 +0800 +@@ -72,6 +72,7 @@ + + #ifndef _WIN32 + ++#if 0 + TEST_F(SubprocessTest, InterruptChild) { + Subprocess* subproc = subprocs_.Add("kill -INT $$"); + ASSERT_NE((Subprocess *) 0, subproc); +@@ -82,6 +83,7 @@ + + EXPECT_EQ(ExitInterrupted, subproc->Finish()); + } ++#endif + + TEST_F(SubprocessTest, InterruptParent) { + Subprocess* subproc = subprocs_.Add("kill -INT $PPID ; sleep 1"); +@@ -169,6 +171,7 @@ + // OS X's process limit is less than 1025 by default + // (|sysctl kern.maxprocperuid| is 709 on 10.7 and 10.8 and less prior to that). + #if !defined(__APPLE__) && !defined(_WIN32) ++#if 0 + TEST_F(SubprocessTest, SetWithLots) { + // Arbitrary big number; needs to be over 1024 to confirm we're no longer + // hostage to pselect. +@@ -196,6 +199,7 @@ + } + ASSERT_EQ(kNumProcs, subprocs_.finished_.size()); + } ++#endif + #endif // !__APPLE__ && !_WIN32 + + // TODO: this test could work on Windows, just not sure how to simply diff --git a/gnu/packages/plotutils.scm b/gnu/packages/plotutils.scm index eae8abaad2..41df88088e 100644 --- a/gnu/packages/plotutils.scm +++ b/gnu/packages/plotutils.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -36,14 +36,21 @@ (sha256 (base32 "1arkyizn5wbgvbh53aziv3s6lmd3wm9lqzkhxb3hijlp1y124hjg")) - (patches (list (search-patch "plotutils-libpng-jmpbuf.patch"))))) + (patches (list (search-patch "plotutils-libpng-jmpbuf.patch"))) + (modules '((guix build utils))) + (snippet + ;; Force the use of libXaw7 instead of libXaw. When not doing + ;; that, libplot.la ends up containing just "-lXaw" (without + ;; "-L/path/to/Xaw"), due to the fact that there is no + ;; libXaw.la, which forces us to propagate libXaw. + '(substitute* "configure" + (("-lXaw") + "-lXaw7"))))) (build-system gnu-build-system) (inputs `(("libpng" ,libpng) ("libx11" ,libx11) - ("libxt" ,libxt))) - - ;; libplot.la has '-lXaw'. - (propagated-inputs `(("libxaw" ,libxaw))) + ("libxt" ,libxt) + ("libxaw" ,libxaw))) (home-page "http://www.gnu.org/software/plotutils/") diff --git a/gnu/packages/version-control.scm b/gnu/packages/version-control.scm index 47b4692d7c..59ca166416 100644 --- a/gnu/packages/version-control.scm +++ b/gnu/packages/version-control.scm @@ -384,14 +384,14 @@ also walk each side of a merge and test those changes individually.") (define-public mercurial (package (name "mercurial") - (version "2.7.1") + (version "3.2.4") (source (origin (method url-fetch) (uri (string-append "http://mercurial.selenic.com/release/mercurial-" version ".tar.gz")) (sha256 (base32 - "121m8f7vmipmdg00cnzdz2rjkgydh28mwfirqkrbs5fv089vywl4")))) + "1g7nfvapxj5k44dyp0p08v37s0zmrj2vl0rjgfd8297x0afidm08")))) (build-system python-build-system) (arguments `(;; Restrict to Python 2, as Python 3 would require diff --git a/gnu/services/avahi.scm b/gnu/services/avahi.scm index 48a2c75927..89478cb997 100644 --- a/gnu/services/avahi.scm +++ b/gnu/services/avahi.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -21,6 +21,7 @@ #:use-module (gnu system shadow) #:use-module (gnu packages avahi) #:use-module (guix monads) + #:use-module (guix store) #:use-module (guix gexp) #:export (avahi-service)) diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 402f5991a5..d55eb3a5f9 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -17,8 +17,7 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (gnu services base) - #:use-module ((guix store) - #:select (%store-prefix)) + #:use-module (guix store) #:use-module (gnu services) #:use-module (gnu services networking) #:use-module (gnu system shadow) ; 'user-account', etc. @@ -193,7 +192,7 @@ in KNOWN-MOUNT-POINTS when it is stopped." ;; the system. Typical example is user-space file systems. "/etc/dmd/do-not-kill") -(define* (user-processes-service requirements #:key (grace-delay 5)) +(define* (user-processes-service requirements #:key (grace-delay 4)) "Return the service that is responsible for terminating all the processes so that the root file system can be re-mounted read-only, just before rebooting/halting. Processes still running GRACE-DELAY seconds after SIGTERM @@ -230,6 +229,18 @@ stopped before 'kill' is called." (@ (ice-9 rdelim) read-string)))) '())) + (define (now) + (car (gettimeofday))) + + (define (sleep* n) + ;; Really sleep N seconds. + ;; Work around <http://bugs.gnu.org/19581>. + (define start (now)) + (let loop ((elapsed 0)) + (when (> n elapsed) + (sleep (- n elapsed)) + (loop (- (now) start))))) + (define lset= (@ (srfi srfi-1) lset=)) (display "sending all processes the TERM signal\n") @@ -238,7 +249,7 @@ stopped before 'kill' is called." (begin ;; Easy: terminate all of them. (kill -1 SIGTERM) - (sleep #$grace-delay) + (sleep* #$grace-delay) (kill -1 SIGKILL)) (begin ;; Kill them all except OMITTED-PIDS. XXX: We @@ -246,7 +257,7 @@ stopped before 'kill' is called." ;; list of processes, like 'killall5' does, but ;; that seems unreliable. (kill-except omitted-pids SIGTERM) - (sleep #$grace-delay) + (sleep* #$grace-delay) (kill-except omitted-pids SIGKILL) (delete-file #$%do-not-kill-file))) @@ -256,7 +267,7 @@ stopped before 'kill' is called." (format #t "waiting for process termination\ (processes left: ~s)~%" pids) - (sleep 2) + (sleep* 2) (wait)))) (display "all processes have been terminated\n") diff --git a/gnu/services/dbus.scm b/gnu/services/dbus.scm index 5da7f14605..d97c54cc5d 100644 --- a/gnu/services/dbus.scm +++ b/gnu/services/dbus.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -21,6 +21,7 @@ #:use-module (gnu system shadow) #:use-module (gnu packages glib) #:use-module (guix monads) + #:use-module (guix store) #:use-module (guix gexp) #:export (dbus-service)) diff --git a/gnu/services/dmd.scm b/gnu/services/dmd.scm index 35b6b384c1..4bf76e01ec 100644 --- a/gnu/services/dmd.scm +++ b/gnu/services/dmd.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -18,7 +18,9 @@ (define-module (gnu services dmd) #:use-module (guix gexp) + #:use-module (guix store) #:use-module (guix monads) + #:use-module (guix derivations) ;imported-modules, etc. #:use-module (gnu services) #:use-module (ice-9 match) #:use-module (srfi srfi-1) diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index db9be8cfbd..f0c3538e0b 100644 --- a/gnu/services/networking.scm +++ b/gnu/services/networking.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -25,6 +25,7 @@ #:use-module (gnu packages messaging) #:use-module (gnu packages ntp) #:use-module (guix gexp) + #:use-module (guix store) #:use-module (guix monads) #:use-module (srfi srfi-26) #:export (%facebook-host-aliases diff --git a/gnu/services/ssh.scm b/gnu/services/ssh.scm index 2b52c777b7..8868e4fcdb 100644 --- a/gnu/services/ssh.scm +++ b/gnu/services/ssh.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -18,10 +18,11 @@ (define-module (gnu services ssh) #:use-module (guix gexp) + #:use-module (guix store) + #:use-module (guix monads) #:use-module (gnu services) #:use-module (gnu system linux) ; 'pam-service' #:use-module (gnu packages lsh) - #:use-module (guix monads) #:export (lsh-service)) ;;; Commentary: diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm index b32bb8674c..6820456698 100644 --- a/gnu/services/xorg.scm +++ b/gnu/services/xorg.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -30,6 +30,7 @@ #:use-module (gnu packages admin) #:use-module (gnu packages bash) #:use-module (guix gexp) + #:use-module (guix store) #:use-module (guix monads) #:use-module (guix derivations) #:use-module (srfi srfi-1) diff --git a/gnu/system.scm b/gnu/system.scm index fc8b57fe06..78c63bb477 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -332,7 +332,12 @@ explicitly appear in OS." (@ (gnu packages admin) dmd) guix lsof ;for Guix's 'list-runtime-roots' pciutils usbutils - util-linux inetutils isc-dhcp wireless-tools + util-linux inetutils isc-dhcp + + ;; wireless-tools is deprecated in favor of iw, but it's still what + ;; many people are familiar with, so keep it around. + iw wireless-tools + net-tools ; XXX: remove when Inetutils suffices man-db diff --git a/gnu/system/install.scm b/gnu/system/install.scm index ab3fe42ae1..35462fff75 100644 --- a/gnu/system/install.scm +++ b/gnu/system/install.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -19,6 +19,7 @@ (define-module (gnu system install) #:use-module (gnu) #:use-module (guix gexp) + #:use-module (guix store) #:use-module (guix monads) #:use-module ((guix store) #:select (%store-prefix)) #:use-module (gnu packages admin) diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm index ee6ce48828..e72d050e96 100644 --- a/gnu/system/linux-initrd.scm +++ b/gnu/system/linux-initrd.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -18,6 +18,7 @@ (define-module (gnu system linux-initrd) #:use-module (guix monads) + #:use-module (guix store) #:use-module (guix gexp) #:use-module (guix utils) #:use-module ((guix store) diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm index b4ba0060bd..4a9580a672 100644 --- a/gnu/system/shadow.scm +++ b/gnu/system/shadow.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -19,6 +19,7 @@ (define-module (gnu system shadow) #:use-module (guix records) #:use-module (guix gexp) + #:use-module (guix store) #:use-module (guix monads) #:use-module ((gnu system file-systems) #:select (%tty-gid)) diff --git a/guix/derivations.scm b/guix/derivations.scm index b48e7e604d..4c34fcb4b8 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -28,6 +28,7 @@ #:use-module (ice-9 vlist) #:use-module (guix store) #:use-module (guix utils) + #:use-module (guix monads) #:use-module (guix hash) #:use-module (guix base32) #:use-module (guix records) @@ -84,11 +85,16 @@ map-derivation - %guile-for-build + built-derivations imported-modules compiled-modules + build-expression->derivation imported-files) + + ;; Re-export it from here for backward compatibility. + #:re-export (%guile-for-build) + #:replace (build-derivations)) ;;; @@ -895,11 +901,6 @@ recursively." ;;; Guile-based builders. ;;; -(define %guile-for-build - ;; The derivation of the Guile to be used within the build environment, - ;; when using `build-expression->derivation'. - (make-parameter #f)) - (define (parent-directories file-name) "Return the list of parent dirs of FILE-NAME, in the order in which an `mkdir -p' implementation would make them." @@ -956,11 +957,11 @@ system, imported, and appears under FINAL-PATH in the resulting store path." ;; up looking for the same files over and over again. (memoize search-path)) -(define* (imported-modules store modules - #:key (name "module-import") - (system (%current-system)) - (guile (%guile-for-build)) - (module-path %load-path)) +(define* (%imported-modules store modules + #:key (name "module-import") + (system (%current-system)) + (guile (%guile-for-build)) + (module-path %load-path)) "Return a derivation that contains the source files of MODULES, a list of module names such as `(ice-9 q)'. All of MODULES must be in the MODULE-PATH search path." @@ -975,18 +976,18 @@ search path." (imported-files store files #:name name #:system system #:guile guile))) -(define* (compiled-modules store modules - #:key (name "module-import-compiled") - (system (%current-system)) - (guile (%guile-for-build)) - (module-path %load-path)) +(define* (%compiled-modules store modules + #:key (name "module-import-compiled") + (system (%current-system)) + (guile (%guile-for-build)) + (module-path %load-path)) "Return a derivation that builds a tree containing the `.go' files corresponding to MODULES. All the MODULES are built in a context where they can refer to each other." - (let* ((module-drv (imported-modules store modules - #:system system - #:guile guile - #:module-path module-path)) + (let* ((module-drv (%imported-modules store modules + #:system system + #:guile guile + #:module-path module-path)) (module-dir (derivation->output-path module-drv)) (files (map (lambda (m) (let ((f (string-join (map symbol->string m) @@ -1218,15 +1219,15 @@ ALLOWED-REFERENCES, and LOCAL-BUILD?." (filter-map source-path inputs))) (mod-drv (and (pair? modules) - (imported-modules store modules - #:guile guile-drv - #:system system))) + (%imported-modules store modules + #:guile guile-drv + #:system system))) (mod-dir (and mod-drv (derivation->output-path mod-drv))) (go-drv (and (pair? modules) - (compiled-modules store modules - #:guile guile-drv - #:system system))) + (%compiled-modules store modules + #:guile guile-drv + #:system system))) (go-dir (and go-drv (derivation->output-path go-drv)))) (derivation store name guile @@ -1255,3 +1256,17 @@ ALLOWED-REFERENCES, and LOCAL-BUILD?." #:references-graphs references-graphs #:allowed-references allowed-references #:local-build? local-build?))) + + +;;; +;;; Monadic interface. +;;; + +(define built-derivations + (store-lift build-derivations)) + +(define imported-modules + (store-lift %imported-modules)) + +(define compiled-modules + (store-lift %compiled-modules)) diff --git a/guix/download.scm b/guix/download.scm index 4c111dd2b5..9a1897525b 100644 --- a/guix/download.scm +++ b/guix/download.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013, 2014 Andreas Enge <andreas@enge.fr> ;;; ;;; This file is part of GNU Guix. @@ -21,7 +21,7 @@ #:use-module (ice-9 match) #:use-module (guix derivations) #:use-module (guix packages) - #:use-module ((guix store) #:select (derivation-path? add-to-store)) + #:use-module (guix store) #:use-module ((guix build download) #:prefix build:) #:use-module (guix monads) #:use-module (guix gexp) @@ -197,27 +197,22 @@ (let ((module (resolve-interface '(gnu packages gnutls)))) (module-ref module 'gnutls))) -(define* (url-fetch store url hash-algo hash +(define* (url-fetch url hash-algo hash #:optional name - #:key (system (%current-system)) guile + #:key (system (%current-system)) + (guile (default-guile)) (mirrors %mirrors)) - "Return the path of a fixed-output derivation in STORE that fetches -URL (a string, or a list of strings denoting alternate URLs), which is -expected to have hash HASH of type HASH-ALGO (a symbol). By default, -the file name is the base name of URL; optionally, NAME can specify a -different file name. + "Return a fixed-output derivation that fetches URL (a string, or a list of +strings denoting alternate URLs), which is expected to have hash HASH of type +HASH-ALGO (a symbol). By default, the file name is the base name of URL; +optionally, NAME can specify a different file name. When one of the URL starts with mirror://, then its host part is interpreted as the name of a mirror scheme, taken from MIRRORS; MIRRORS -must be a list of symbol/URL-list pairs." - (define guile-for-build - (package-derivation store - (or guile - (let ((distro (resolve-interface - '(gnu packages commencement)))) - (module-ref distro 'guile-final))) - system)) +must be a list of symbol/URL-list pairs. +Alternately, when URL starts with file://, return the corresponding file name +in the store." (define file-name (match url ((head _ ...) @@ -254,26 +249,24 @@ must be a list of symbol/URL-list pairs." (let ((uri (and (string? url) (string->uri url)))) (if (or (and (string? url) (not uri)) (and uri (memq (uri-scheme uri) '(#f file)))) - (add-to-store store (or name file-name) - #f "sha256" (if uri (uri-path uri) url)) - (run-with-store store + (interned-file (if uri (uri-path uri) url) + (or name file-name)) + (mlet %store-monad ((guile (package->derivation guile system))) (gexp->derivation (or name file-name) builder + #:guile-for-build guile #:system system #:hash-algo hash-algo #:hash hash #:modules '((guix build download) (guix build utils) (guix ftp-client)) - #:guile-for-build guile-for-build ;; In general, offloading downloads is not a good idea. ;;#:local-build? #t ;; FIXME: The above would also disable use of ;; substitutes, so comment it out; see ;; <https://bugs.gnu.org/18747>. - ) - #:guile-for-build guile-for-build - #:system system)))) + ))))) (define* (download-to-store store url #:optional (name (basename url)) #:key (log (current-error-port))) diff --git a/guix/gexp.scm b/guix/gexp.scm index d13e1c46da..4e8f91df1d 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -17,12 +17,9 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (guix gexp) - #:use-module ((guix store) - #:select (direct-store-path?)) + #:use-module (guix store) #:use-module (guix monads) - #:use-module ((guix derivations) - #:select (derivation? derivation->output-path - %guile-for-build derivation)) + #:use-module (guix derivations) #:use-module (guix packages) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) diff --git a/guix/git-download.scm b/guix/git-download.scm index 94b118a7b9..94a1245480 100644 --- a/guix/git-download.scm +++ b/guix/git-download.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -18,6 +18,7 @@ (define-module (guix git-download) #:use-module (guix gexp) + #:use-module (guix store) #:use-module (guix monads) #:use-module (guix records) #:use-module (guix packages) @@ -52,23 +53,13 @@ (let ((distro (resolve-interface '(gnu packages version-control)))) (module-ref distro 'git))) -(define* (git-fetch store ref hash-algo hash +(define* (git-fetch ref hash-algo hash #:optional name - #:key (system (%current-system)) guile + #:key (system (%current-system)) (guile (default-guile)) (git (git-package))) - "Return a fixed-output derivation in STORE that fetches REF, a -<git-reference> object. The output is expected to have recursive hash HASH of -type HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if -#f." - (define guile-for-build - (match guile - ((? package?) - (package-derivation store guile system)) - (#f ; the default - (let* ((distro (resolve-interface '(gnu packages commencement))) - (guile (module-ref distro 'guile-final))) - (package-derivation store guile system))))) - + "Return a fixed-output derivation that fetches REF, a <git-reference> +object. The output is expected to have recursive hash HASH of type +HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #f." (define inputs ;; When doing 'git clone --recursive', we need sed, grep, etc. to be ;; available so that 'git submodule' works. @@ -95,7 +86,7 @@ type HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #:recursive? '#$(git-reference-recursive? ref) #:git-command (string-append #$git "/bin/git")))) - (run-with-store store + (mlet %store-monad ((guile (package->derivation guile system))) (gexp->derivation (or name "git-checkout") build #:system system ;; FIXME: See <https://bugs.gnu.org/18747>. @@ -105,9 +96,7 @@ type HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #:recursive? #t #:modules '((guix build git) (guix build utils)) - #:guile-for-build guile-for-build - #:local-build? #t) - #:guile-for-build guile-for-build - #:system system)) + #:guile-for-build guile + #:local-build? #t))) ;;; git-download.scm ends here diff --git a/guix/monad-repl.scm b/guix/monad-repl.scm index 5242f5448b..ebd9151065 100644 --- a/guix/monad-repl.scm +++ b/guix/monad-repl.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -19,6 +19,8 @@ (define-module (guix monad-repl) #:use-module (guix store) #:use-module (guix monads) + #:use-module (guix utils) + #:use-module (guix packages) #:use-module (ice-9 pretty-print) #:use-module (system repl repl) #:use-module (system repl common) @@ -54,20 +56,30 @@ #:make-default-environment (language-make-default-environment scheme)))) +(define* (default-guile-derivation store #:optional (system (%current-system))) + "Return the derivation of the default " + (package-derivation store (default-guile) system)) + (define (store-monad-language) "Return a compiler language for the store monad." - (let ((store (open-connection))) + (let* ((store (open-connection)) + (guile (or (%guile-for-build) + (default-guile-derivation store)))) (monad-language %store-monad - (cut run-with-store store <>) + (cut run-with-store store <> + #:guile-for-build guile) 'store-monad))) (define-meta-command ((run-in-store guix) repl (form)) "run-in-store EXP Run EXP through the store monad." - (let ((value (with-store store - (run-with-store store (repl-eval repl form))))) - (run-hook before-print-hook value) - (pretty-print value))) + (with-store store + (let* ((guile (or (%guile-for-build) + (default-guile-derivation store))) + (value (run-with-store store (repl-eval repl form) + #:guile-for-build guile))) + (run-hook before-print-hook value) + (pretty-print value)))) (define-meta-command ((enter-store-monad guix) repl) "enter-store-monad diff --git a/guix/monads.scm b/guix/monads.scm index 20fee79602..7fec3d5168 100644 --- a/guix/monads.scm +++ b/guix/monads.scm @@ -17,9 +17,6 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (guix monads) - #:use-module (guix store) - #:use-module (guix derivations) - #:use-module (guix packages) #:use-module ((system syntax) #:select (syntax-local-binding)) #:use-module (ice-9 match) @@ -49,22 +46,7 @@ anym ;; Concrete monads. - %identity-monad - - %store-monad - store-bind - store-return - store-lift - run-with-store - text-file - interned-file - package-file - origin->derivation - package->derivation - package->cross-derivation - built-derivations) - #:replace (imported-modules - compiled-modules)) + %identity-monad)) ;;; Commentary: ;;; @@ -309,121 +291,4 @@ lifted in MONAD, for which PROC returns true." (bind identity-bind) (return identity-return)) - -;;; -;;; Store monad. -;;; - -;; return:: a -> StoreM a -(define-inlinable (store-return value) - "Return VALUE from a monadic function." - ;; The monadic value is just this. - (lambda (store) - value)) - -;; >>=:: StoreM a -> (a -> StoreM b) -> StoreM b -(define-inlinable (store-bind mvalue mproc) - "Bind MVALUE in MPROC." - (lambda (store) - (let* ((value (mvalue store)) - (mresult (mproc value))) - (mresult store)))) - -(define-monad %store-monad - (bind store-bind) - (return store-return)) - - -(define (store-lift proc) - "Lift PROC, a procedure whose first argument is a connection to the store, -in the store monad." - (define result - (lambda args - (lambda (store) - (apply proc store args)))) - - (set-object-property! result 'documentation - (procedure-property proc 'documentation)) - result) - -;;; -;;; Store monad operators. -;;; - -(define* (text-file name text) - "Return as a monadic value the absolute file name in the store of the file -containing TEXT, a string." - (lambda (store) - (add-text-to-store store name text '()))) - -(define* (interned-file file #:optional name - #:key (recursive? #t)) - "Return the name of FILE once interned in the store. Use NAME as its store -name, or the basename of FILE if NAME is omitted. - -When RECURSIVE? is true, the contents of FILE are added recursively; if FILE -designates a flat file and RECURSIVE? is true, its contents are added, and its -permission bits are kept." - (lambda (store) - (add-to-store store (or name (basename file)) - recursive? "sha256" file))) - -(define* (package-file package - #:optional file - #:key - system (output "out") target) - "Return as a monadic value the absolute file name of FILE within the -OUTPUT directory of PACKAGE. When FILE is omitted, return the name of the -OUTPUT directory of PACKAGE. When TARGET is true, use it as a -cross-compilation target triplet." - (lambda (store) - (define compute-derivation - (if target - (cut package-cross-derivation <> <> target <>) - package-derivation)) - - (let* ((system (or system (%current-system))) - (drv (compute-derivation store package system)) - (out (derivation->output-path drv output))) - (if file - (string-append out "/" file) - out)))) - -(define package->derivation - (store-lift package-derivation)) - -(define package->cross-derivation - (store-lift package-cross-derivation)) - -(define origin->derivation - (store-lift package-source-derivation)) - -(define imported-modules - (store-lift (@ (guix derivations) imported-modules))) - -(define compiled-modules - (store-lift (@ (guix derivations) compiled-modules))) - -(define built-derivations - (store-lift build-derivations)) - -(define* (run-with-store store mval - #:key - (guile-for-build (%guile-for-build)) - (system (%current-system))) - "Run MVAL, a monadic value in the store monad, in STORE, an open store -connection." - (define (default-guile) - ;; Lazily resolve 'guile-final'. This module must not refer to (gnu …) - ;; modules directly, to avoid circular dependencies, hence this hack. - (module-ref (resolve-interface '(gnu packages commencement)) - 'guile-final)) - - (parameterize ((%guile-for-build (or guile-for-build - (package-derivation store - (default-guile) - system))) - (%current-system system)) - (mval store))) - ;;; monads.scm end here diff --git a/guix/packages.scm b/guix/packages.scm index 68fd531c6b..db14f9e0b8 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014 Mark H Weaver <mhw@netris.org> ;;; ;;; This file is part of GNU Guix. @@ -21,6 +21,7 @@ #:use-module (guix utils) #:use-module (guix records) #:use-module (guix store) + #:use-module (guix monads) #:use-module (guix base32) #:use-module (guix derivations) #:use-module (guix build-system) @@ -108,7 +109,15 @@ bag-transitive-inputs bag-transitive-host-inputs bag-transitive-build-inputs - bag-transitive-target-inputs)) + bag-transitive-target-inputs + + default-guile + + set-guile-for-build + package-file + package->derivation + package->cross-derivation + origin->derivation)) ;;; Commentary: ;;; @@ -322,10 +331,12 @@ corresponds to the arguments expected by `set-path-environment-variable'." ("patch" ,(ref '(gnu packages base) 'patch))))) (define (default-guile) - "Return the default Guile package for SYSTEM." + "Return the default Guile package used to run the build code of +derivations." (let ((distro (resolve-interface '(gnu packages commencement)))) (module-ref distro 'guile-final))) +;; TODO: Rewrite using %STORE-MONAD and gexps. (define* (patch-and-repack store source patches #:key (inputs '()) @@ -474,37 +485,6 @@ IMPORTED-MODULES specify modules to use/import for use by SNIPPET." #:modules modules #:guile-for-build guile-for-build))) -(define* (package-source-derivation store source - #:optional (system (%current-system))) - "Return the derivation path for SOURCE, a package source, for SYSTEM." - (match source - (($ <origin> uri method sha256 name () #f) - ;; No patches, no snippet: this is a fixed-output derivation. - (method store uri 'sha256 sha256 name - #:system system)) - (($ <origin> uri method sha256 name (patches ...) snippet - (flags ...) inputs (modules ...) (imported-modules ...) - guile-for-build) - ;; Patches and/or a snippet. - (let ((source (method store uri 'sha256 sha256 name - #:system system)) - (guile (match (or guile-for-build (default-guile)) - ((? package? p) - (package-derivation store p system - #:graft? #f))))) - (patch-and-repack store source patches - #:inputs inputs - #:snippet snippet - #:flags flags - #:system system - #:modules modules - #:imported-modules modules - #:guile-for-build guile))) - ((and (? string?) (? direct-store-path?) file) - file) - ((? string? file) - (add-to-store store (basename file) #t "sha256" file)))) - (define (transitive-inputs inputs) (let loop ((inputs inputs) (result '())) @@ -907,3 +887,82 @@ symbolic output name, such as \"out\". Note that this procedure calls `package-derivation', which is costly." (let ((drv (package-derivation store package system))) (derivation->output-path drv output))) + + +;;; +;;; Monadic interface. +;;; + +(define (set-guile-for-build guile) + "This monadic procedure changes the Guile currently used to run the build +code of derivations to GUILE, a package object." + (lambda (store) + (let ((guile (package-derivation store guile))) + (%guile-for-build guile)))) + +(define* (package-file package + #:optional file + #:key + system (output "out") target) + "Return as a monadic value the absolute file name of FILE within the +OUTPUT directory of PACKAGE. When FILE is omitted, return the name of the +OUTPUT directory of PACKAGE. When TARGET is true, use it as a +cross-compilation target triplet." + (lambda (store) + (define compute-derivation + (if target + (cut package-cross-derivation <> <> target <>) + package-derivation)) + + (let* ((system (or system (%current-system))) + (drv (compute-derivation store package system)) + (out (derivation->output-path drv output))) + (if file + (string-append out "/" file) + out)))) + +(define package->derivation + (store-lift package-derivation)) + +(define package->cross-derivation + (store-lift package-cross-derivation)) + +(define patch-and-repack* + (store-lift patch-and-repack)) + +(define* (origin->derivation source + #:optional (system (%current-system))) + "When SOURCE is an <origin> object, return its derivation for SYSTEM. When +SOURCE is a file name, return either the interned file name (if SOURCE is +outside of the store) or SOURCE itself (if SOURCE is already a store item.)" + (match source + (($ <origin> uri method sha256 name () #f) + ;; No patches, no snippet: this is a fixed-output derivation. + (method uri 'sha256 sha256 name #:system system)) + (($ <origin> uri method sha256 name (patches ...) snippet + (flags ...) inputs (modules ...) (imported-modules ...) + guile-for-build) + ;; Patches and/or a snippet. + (mlet %store-monad ((source (method uri 'sha256 sha256 name + #:system system)) + (guile (package->derivation (or guile-for-build + (default-guile)) + system + #:graft? #f))) + (patch-and-repack* source patches + #:inputs inputs + #:snippet snippet + #:flags flags + #:system system + #:modules modules + #:imported-modules modules + #:guile-for-build guile))) + ((and (? string?) (? direct-store-path?) file) + (with-monad %store-monad + (return file))) + ((? string? file) + (interned-file file (basename file) + #:recursive? #t)))) + +(define package-source-derivation + (store-lower origin->derivation)) diff --git a/guix/profiles.scm b/guix/profiles.scm index 44d7a314a3..921d001fa2 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org> ;;; Copyright © 2014 Alex Kost <alezost@gmail.com> ;;; @@ -25,6 +25,7 @@ #:use-module (guix packages) #:use-module (guix gexp) #:use-module (guix monads) + #:use-module (guix store) #:use-module (ice-9 match) #:use-module (ice-9 regex) #:use-module (ice-9 ftw) diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm index 781ffc5f58..e265f82b52 100644 --- a/guix/scripts/archive.scm +++ b/guix/scripts/archive.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -170,7 +170,10 @@ derivation of a package." (package-name p)))) (package-derivation store p system))) ((? procedure? proc) - (run-with-store store (proc) #:system system)))) + (run-with-store store + (mbegin %store-monad + (set-guile-for-build (default-guile)) + (proc)) #:system system)))) (define (options->derivations+files store opts) "Given OPTS, the result of 'args-fold', return a list of derivations to diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index 26e9f42774..07ced30484 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013 Mark H Weaver <mhw@netris.org> ;;; ;;; This file is part of GNU Guix. @@ -347,12 +347,18 @@ packages." ((? package? p) `(argument . ,p)) ((? procedure? proc) - (let ((drv (run-with-store store (proc) #:system system))) + (let ((drv (run-with-store store + (mbegin %store-monad + (set-guile-for-build (default-guile)) + (proc)) + #:system system))) `(argument . ,drv))) ((? gexp? gexp) (let ((drv (run-with-store store - (gexp->derivation "gexp" gexp - #:system system)))) + (mbegin %store-monad + (set-guile-for-build (default-guile)) + (gexp->derivation "gexp" gexp + #:system system))))) `(argument . ,drv))))) (opt opt)) opts)) diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm index b3a79d9251..ffa3a09799 100644 --- a/guix/scripts/environment.scm +++ b/guix/scripts/environment.scm @@ -230,7 +230,10 @@ packages." (command (assoc-ref opts 'exec)) (inputs (packages->transitive-inputs (pick-all (options/resolve-packages opts) 'package))) - (drvs (run-with-store store (build-inputs inputs opts)))) + (drvs (run-with-store store + (mbegin %store-monad + (set-guile-for-build (default-guile)) + (build-inputs inputs opts))))) (cond ((assoc-ref opts 'dry-run?) #t) ((assoc-ref opts 'search-paths) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 27404772b7..b0974dcfcd 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -553,18 +553,20 @@ Build the operating system declared in FILE according to ACTION.\n")) (set-build-options-from-command-line store opts) (run-with-store store - (perform-action action os - #:dry-run? dry? - #:use-substitutes? (assoc-ref opts 'substitutes?) - #:image-size (assoc-ref opts 'image-size) - #:full-boot? (assoc-ref opts 'full-boot?) - #:mappings (filter-map (match-lambda - (('file-system-mapping . m) - m) - (_ #f)) - opts) - #:grub? grub? - #:target target #:device device) + (mbegin %store-monad + (set-guile-for-build (default-guile)) + (perform-action action os + #:dry-run? dry? + #:use-substitutes? (assoc-ref opts 'substitutes?) + #:image-size (assoc-ref opts 'image-size) + #:full-boot? (assoc-ref opts 'full-boot?) + #:mappings (filter-map (match-lambda + (('file-system-mapping . m) + m) + (_ #f)) + opts) + #:grub? grub? + #:target target #:device device)) #:system system)))) ;;; system.scm ends here diff --git a/guix/store.scm b/guix/store.scm index 571cc060d3..82ed94bbc1 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -20,6 +20,7 @@ #:use-module (guix utils) #:use-module (guix config) #:use-module (guix serialization) + #:use-module (guix monads) #:autoload (guix base32) (bytevector->base32-string) #:use-module (rnrs bytevectors) #:use-module (rnrs io ports) @@ -94,6 +95,16 @@ register-path + %store-monad + store-bind + store-return + store-lift + store-lower + run-with-store + %guile-for-build + text-file + interned-file + %store-prefix store-path? direct-store-path? @@ -836,6 +847,86 @@ be used internally by the daemon's build hook." ;;; +;;; Store monad. +;;; + +;; return:: a -> StoreM a +(define-inlinable (store-return value) + "Return VALUE from a monadic function." + ;; The monadic value is just this. + (lambda (store) + value)) + +;; >>=:: StoreM a -> (a -> StoreM b) -> StoreM b +(define-inlinable (store-bind mvalue mproc) + "Bind MVALUE in MPROC." + (lambda (store) + (let* ((value (mvalue store)) + (mresult (mproc value))) + (mresult store)))) + +;; This is essentially a state monad +(define-monad %store-monad + (bind store-bind) + (return store-return)) + +(define (store-lift proc) + "Lift PROC, a procedure whose first argument is a connection to the store, +in the store monad." + (define result + (lambda args + (lambda (store) + (apply proc store args)))) + + (set-object-property! result 'documentation + (procedure-property proc 'documentation)) + result) + +(define (store-lower proc) + "Lower PROC, a monadic procedure in %STORE-MONAD, to a \"normal\" procedure +taking the store as its first argument." + (lambda (store . args) + (run-with-store store (apply proc args)))) + +;; +;; Store monad operators. +;; + +(define* (text-file name text) + "Return as a monadic value the absolute file name in the store of the file +containing TEXT, a string." + (lambda (store) + (add-text-to-store store name text '()))) + +(define* (interned-file file #:optional name + #:key (recursive? #t)) + "Return the name of FILE once interned in the store. Use NAME as its store +name, or the basename of FILE if NAME is omitted. + +When RECURSIVE? is true, the contents of FILE are added recursively; if FILE +designates a flat file and RECURSIVE? is true, its contents are added, and its +permission bits are kept." + (lambda (store) + (add-to-store store (or name (basename file)) + recursive? "sha256" file))) + +(define %guile-for-build + ;; The derivation of the Guile to be used within the build environment, + ;; when using 'gexp->derivation' and co. + (make-parameter #f)) + +(define* (run-with-store store mval + #:key + (guile-for-build (%guile-for-build)) + (system (%current-system))) + "Run MVAL, a monadic value in the store monad, in STORE, an open store +connection." + (parameterize ((%guile-for-build guile-for-build) + (%current-system system)) + (mval store))) + + +;;; ;;; Store paths. ;;; diff --git a/guix/svn-download.scm b/guix/svn-download.scm index f06e449777..ee67513e16 100644 --- a/guix/svn-download.scm +++ b/guix/svn-download.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014 Sree Harsha Totakura <sreeharsha@totakura.in> ;;; ;;; This file is part of GNU Guix. @@ -20,6 +20,7 @@ (define-module (guix svn-download) #:use-module (guix records) #:use-module (guix gexp) + #:use-module (guix store) #:use-module (guix monads) #:use-module (guix packages) #:use-module (ice-9 match) @@ -48,23 +49,13 @@ (let ((distro (resolve-interface '(gnu packages version-control)))) (module-ref distro 'subversion))) -(define* (svn-fetch store ref hash-algo hash +(define* (svn-fetch ref hash-algo hash #:optional name - #:key (system (%current-system)) guile + #:key (system (%current-system)) (guile (default-guile)) (svn (subversion-package))) - "Return a fixed-output derivation in STORE that fetches REF, a -<svn-reference> object. The output is expected to have recursive hash HASH of -type HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if -#f." - (define guile-for-build - (match guile - ((? package?) - (package-derivation store guile system)) - (#f ; the default - (let* ((distro (resolve-interface '(gnu packages commencement))) - (guile (module-ref distro 'guile-final))) - (package-derivation store guile system))))) - + "Return a fixed-output derivation that fetches REF, a <svn-reference> +object. The output is expected to have recursive hash HASH of type +HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #f." (define build #~(begin (use-modules (guix build svn)) @@ -73,7 +64,7 @@ type HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #$output #:svn-command (string-append #$svn "/bin/svn")))) - (run-with-store store + (mlet %store-monad ((guile (package->derivation guile system))) (gexp->derivation (or name "svn-checkout") build #:system system ;; FIXME: See <https://bugs.gnu.org/18747>. @@ -83,9 +74,7 @@ type HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #:recursive? #t #:modules '((guix build svn) (guix build utils)) - #:guile-for-build guile-for-build - #:local-build? #t) - #:guile-for-build guile-for-build - #:system system)) + #:guile-for-build guile + #:local-build? #t))) ;;; svn-download.scm ends here diff --git a/tests/builders.scm b/tests/builders.scm index 579246d04d..e5acc3e038 100644 --- a/tests/builders.scm +++ b/tests/builders.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -59,6 +59,9 @@ (define network-reachable? (false-if-exception (getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV))) +(define url-fetch* + (store-lower url-fetch)) + (test-begin "builders") @@ -68,8 +71,8 @@ "ftp://ftp.gnu.org/gnu/hello/hello-2.8.tar.gz")) (hash (nix-base32-string->bytevector "0wqd8sjmxfskrflaxywc7gqw7sfawrfvdxd9skxawzfgyy0pzdz6")) - (drv (url-fetch %store url 'sha256 hash - #:guile %bootstrap-guile)) + (drv (url-fetch* %store url 'sha256 hash + #:guile %bootstrap-guile)) (out-path (derivation->output-path drv))) (and (build-derivations %store (list drv)) (file-exists? out-path) @@ -78,16 +81,16 @@ (test-assert "url-fetch, file" (let* ((file (search-path %load-path "guix.scm")) (hash (call-with-input-file file port-sha256)) - (out (url-fetch %store file 'sha256 hash))) + (out (url-fetch* %store file 'sha256 hash))) (and (file-exists? out) (valid-path? %store out)))) (test-assert "url-fetch, file URI" (let* ((file (search-path %load-path "guix.scm")) (hash (call-with-input-file file port-sha256)) - (out (url-fetch %store - (string-append "file://" (canonicalize-path file)) - 'sha256 hash))) + (out (url-fetch* %store + (string-append "file://" (canonicalize-path file)) + 'sha256 hash))) (and (file-exists? out) (valid-path? %store out)))) @@ -99,8 +102,8 @@ (let* ((url "http://ftp.gnu.org/gnu/hello/hello-2.8.tar.gz") (hash (nix-base32-string->bytevector "0wqd8sjmxfskrflaxywc7gqw7sfawrfvdxd9skxawzfgyy0pzdz6")) - (tarball (url-fetch %store url 'sha256 hash - #:guile %bootstrap-guile)) + (tarball (url-fetch* %store url 'sha256 hash + #:guile %bootstrap-guile)) (build (gnu-build %store "hello-2.8" `(("source" ,tarball) ,@%bootstrap-inputs) diff --git a/tests/monads.scm b/tests/monads.scm index 9c3cdd20a7..347a255072 100644 --- a/tests/monads.scm +++ b/tests/monads.scm @@ -21,8 +21,7 @@ #:use-module (guix store) #:use-module (guix monads) #:use-module (guix derivations) - #:use-module ((guix packages) - #:select (package-derivation %current-system)) + #:use-module (guix packages) #:use-module (gnu packages) #:use-module (gnu packages bootstrap) #:use-module ((gnu packages base) #:select (coreutils)) diff --git a/tests/packages.scm b/tests/packages.scm index 72c69ff653..bd5ba3ee92 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -182,10 +182,10 @@ (let* ((file (search-bootstrap-binary "guile-2.0.9.tar.xz" (%current-system))) (sha256 (call-with-input-file file port-sha256)) - (fetch (lambda* (store url hash-algo hash + (fetch (lambda* (url hash-algo hash #:optional name #:key system) (pk 'fetch url hash-algo hash name system) - (add-to-store store (basename url) #f "sha256" url))) + (interned-file url))) (source (bootstrap-origin (origin (method fetch) diff --git a/tests/store.scm b/tests/store.scm index cb5370d5cc..f43fcb14d0 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -595,6 +595,12 @@ Deriver: ~a~%" (null? (valid-derivers %store file)) (null? (referrers %store file)))))) +(test-equal "store-lower" + "Lowered." + (let* ((add (store-lower text-file)) + (file (add %store "foo" "Lowered."))) + (call-with-input-file file get-string-all))) + (test-end "store") |