diff options
| -rw-r--r-- | configure.ac | 3 | ||||
| -rw-r--r-- | doc/guix.texi | 47 | ||||
| -rw-r--r-- | gnu-system.am | 1 | ||||
| -rw-r--r-- | gnu/build/activation.scm | 49 | ||||
| -rw-r--r-- | gnu/packages/admin.scm | 10 | ||||
| -rw-r--r-- | gnu/packages/gnome.scm | 48 | ||||
| -rw-r--r-- | gnu/packages/haskell.scm | 648 | ||||
| -rw-r--r-- | gnu/packages/package-management.scm | 7 | ||||
| -rw-r--r-- | gnu/packages/patches/inetutils-syslogd.patch | 20 | ||||
| -rw-r--r-- | guix/build/haskell-build-system.scm | 44 | ||||
| -rw-r--r-- | guix/http-client.scm | 41 | ||||
| -rw-r--r-- | guix/import/hackage.scm | 767 | ||||
| -rw-r--r-- | guix/profiles.scm | 60 | ||||
| -rw-r--r-- | guix/scripts/import.scm | 2 | ||||
| -rw-r--r-- | guix/scripts/import/hackage.scm | 106 | ||||
| -rw-r--r-- | guix/scripts/package.scm | 1 | ||||
| -rw-r--r-- | po/guix/POTFILES.in | 1 | ||||
| -rw-r--r-- | tests/guix-package-net.sh | 8 | ||||
| -rw-r--r-- | tests/hackage.scm | 134 | ||||
| -rw-r--r-- | tests/packages.scm | 1 | ||||
| -rw-r--r-- | tests/profiles.scm | 2 |
21 files changed, 1962 insertions, 38 deletions
diff --git a/configure.ac b/configure.ac index f2f803a2cd..6f261cdb63 100644 --- a/configure.ac +++ b/configure.ac @@ -9,6 +9,9 @@ AC_CONFIG_AUX_DIR([build-aux]) AM_INIT_AUTOMAKE([1.12 gnu silent-rules subdir-objects \ color-tests parallel-tests -Woverride]) +# Enable silent rules by default. +AM_SILENT_RULES([yes]) + AC_CONFIG_SRCDIR([guix.scm]) AC_CONFIG_MACRO_DIR([m4]) diff --git a/doc/guix.texi b/doc/guix.texi index 0facda5875..7dbfb661b0 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -3188,6 +3188,37 @@ bound to the @code{libreoffice} top-level attribute): @example guix import nix ~/path/to/nixpkgs libreoffice @end example + +@item hackage +@cindex hackage +Import meta-data from Haskell community's central package archive +@uref{https://hackage.haskell.org/, Hackage}. Information is taken from +Cabal files and includes all the relevant information, including package +dependencies. + +Specific command-line options are: + +@table @code +@item --no-test-dependencies +@itemx -t +Do not include dependencies only required to run the test suite. +@end table + +The command below imports meta-data for the latest version of the +@code{HTTP} Haskell package without including test dependencies: + +@example +guix import hackage -t HTTP +@end example + +A specific package version may optionally be specified by following the +package name by a hyphen and a version number as in the following example: + +@example +guix import hackage mtl-2.1.3.1 +@end example + +Currently only indentation structured Cabal files are supported. @end table The structure of the @command{guix import} code is modular. It would be @@ -4207,7 +4238,9 @@ command, from the same-named package. This relies on the @node User Accounts @subsection User Accounts -User accounts are specified with the @code{user-account} form: +User accounts and groups are entirely managed through the +@code{operating-system} declaration. They are specified with the +@code{user-account} and @code{user-group} forms: @example (user-account @@ -4221,6 +4254,14 @@ User accounts are specified with the @code{user-account} form: (home-directory "/home/alice")) @end example +When booting or upon completion of @command{guix system reconfigure}, +the system ensures that only the user accounts and groups specified in +the @code{operating-system} declaration exist, and with the specified +properties. Thus, account or group creations or modifications made by +directly invoking commands such as @command{useradd} are lost upon +reconfiguration or reboot. This ensures that the system remains exactly +as declared. + @deftp {Data Type} user-account Objects of this type represent user accounts. The following members may be specified: @@ -4260,7 +4301,9 @@ graphical login managers do not list them. @item @code{password} (default: @code{#f}) You would normally leave this field to @code{#f}, initialize user passwords as @code{root} with the @command{passwd} command, and then let -users change it with @command{passwd}. +users change it with @command{passwd}. Passwords set with +@command{passwd} are of course preserved across reboot and +reconfiguration. If you @emph{do} want to have a preset password for an account, then this field must contain the encrypted password, as a string. diff --git a/gnu-system.am b/gnu-system.am index e09ea333f1..969a9116f0 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -441,6 +441,7 @@ dist_patch_DATA = \ gnu/packages/patches/guix-test-networking.patch \ gnu/packages/patches/gtkglext-disable-disable-deprecated.patch \ gnu/packages/patches/hop-bigloo-4.0b.patch \ + gnu/packages/patches/inetutils-syslogd.patch \ gnu/packages/patches/irrlicht-mesa-10.patch \ gnu/packages/patches/jbig2dec-ignore-testtest.patch \ gnu/packages/patches/kmod-module-directory.patch \ diff --git a/gnu/build/activation.scm b/gnu/build/activation.scm index 909e971833..64c3410baf 100644 --- a/gnu/build/activation.scm +++ b/gnu/build/activation.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 © 2015 Mark H Weaver <mhw@netris.org> ;;; ;;; This file is part of GNU Guix. @@ -40,6 +40,24 @@ ;;; ;;; Code: +(define (enumerate thunk) + "Return the list of values returned by THUNK until it returned #f." + (let loop ((entry (thunk)) + (result '())) + (if (not entry) + (reverse result) + (loop (thunk) (cons entry result))))) + +(define (current-users) + "Return the passwd entries for all the currently defined user accounts." + (setpw) + (enumerate getpwent)) + +(define (current-groups) + "Return the group entries for all the currently defined user groups." + (setgr) + (enumerate getgrent)) + (define* (add-group name #:key gid password system? (log-port (current-error-port))) "Add NAME as a user group, with the given numeric GID if specified." @@ -128,6 +146,17 @@ properties. Return #t on success." ,name))) (zero? (apply system* "usermod" args)))) +(define* (delete-user name #:key (log-port (current-error-port))) + "Remove user account NAME. Return #t on success. This may fail if NAME is +logged in." + (format log-port "deleting user '~a'...~%" name) + (zero? (system* "userdel" name))) + +(define* (delete-group name #:key (log-port (current-error-port))) + "Remove group NAME. Return #t on success." + (format log-port "deleting group '~a'...~%" name) + (zero? (system* "groupdel" name))) + (define* (ensure-user name group #:key uid comment home shell password system? (supplementary-groups '()) @@ -186,8 +215,22 @@ numeric gid or #f." #:system? system?)))) groups) - ;; Finally create the other user accounts. - (for-each activate-user users)) + ;; Create the other user accounts. + (for-each activate-user users) + + ;; Finally, delete extra user accounts and groups. + (for-each delete-user + (lset-difference string=? + (map passwd:name (current-users)) + (match users + (((names . _) ...) + names)))) + (for-each delete-group + (lset-difference string=? + (map group:name (current-groups)) + (match groups + (((names . _) ...) + names))))) (define (activate-etc etc) "Install ETC, a directory in the store, as the source of static files for diff --git a/gnu/packages/admin.scm b/gnu/packages/admin.scm index 4d4cef7cf3..3a0361299e 100644 --- a/gnu/packages/admin.scm +++ b/gnu/packages/admin.scm @@ -55,7 +55,8 @@ #:use-module (gnu packages libftdi) #:use-module (gnu packages image) #:use-module (gnu packages xorg) - #:use-module (gnu packages python)) + #:use-module (gnu packages python) + #:use-module (gnu packages man)) (define-public dmd (package @@ -158,13 +159,18 @@ re-executing them as necessary.") version ".tar.gz")) (sha256 (base32 - "04wrm0v7l4890mmbaawd6wjwdv08bkglgqhpz0q4dkb0l50fl8q4")))) + "04wrm0v7l4890mmbaawd6wjwdv08bkglgqhpz0q4dkb0l50fl8q4")) + (patches (list (search-patch "inetutils-syslogd.patch"))))) (build-system gnu-build-system) (arguments `(;; FIXME: `tftp.sh' relies on `netstat' from utils-linux, ;; which is currently missing. #:tests? #f)) (inputs `(("ncurses" ,ncurses) ("readline" ,readline))) ; for 'ftp' + + ;; Help2man is needed because of the patch that modifies syslogd.c. + (native-inputs `(("help2man" ,help2man))) + (home-page "http://www.gnu.org/software/inetutils/") (synopsis "Basic networking utilities") (description diff --git a/gnu/packages/gnome.scm b/gnu/packages/gnome.scm index 0c6476387a..ddb8a1f45e 100644 --- a/gnu/packages/gnome.scm +++ b/gnu/packages/gnome.scm @@ -1739,6 +1739,54 @@ library.") and the GLib main loop, to integrate well with GNOME applications.") (license license:lgpl2.0+))) +(define-public libsecret + (package + (name "libsecret") + (version "0.18") + (source (origin + (method url-fetch) + (uri (string-append + "mirror://gnome/sources/libsecret/" version "/" + name "-" version ".tar.xz")) + (sha256 + (base32 + "1qq29c01xxjyx5sl6y5h22w8r0ff4c73bph3gfx3h7mx5mvalwqc")))) + (build-system gnu-build-system) + (outputs '("out" "doc")) + (arguments + `(#:tests? #f ; FIXME: Testing hangs. + #:make-flags '("CC=gcc") ; for g-ir-scanner. + #:configure-flags + (list (string-append "--with-html-dir=" + (assoc-ref %outputs "doc") + "/share/gtk-doc/html")))) + (native-inputs + `(("glib:bin" ,glib "bin") ; for gdbus-codegen, etc. + ("gobject-introspection" ,gobject-introspection) + ("intltool" ,intltool) + ("pkg-config" ,pkg-config) + ("vala" ,vala) + ("xsltproc" ,libxslt))) + ;; These are needed for the tests. + ;; FIXME: Add gjs once available. + ;("dbus" ,dbus) + ;("python2" ,python-2) + ;("python2-dbus" ,python2-dbus) + ;("python2-pygobject" ,python2-pygobject) + ;("python2-pygobject-2" ,python2-pygobject-2))) + (propagated-inputs + `(("glib" ,glib))) ; required by libsecret-1.pc + (inputs + `(("docbook-xsl" ,docbook-xsl) + ("libgcrypt" ,libgcrypt) + ("libxml2" ,libxml2))) ; for XML_CATALOG_FILES + (home-page "https://wiki.gnome.org/Projects/Libsecret/") + (synopsis "GObject bindings for \"Secret Service\" API") + (description + "Libsecret is a GObject based library for storing and retrieving passwords +and other secrets. It communicates with the \"Secret Service\" using DBus.") + (license license:lgpl2.1+))) + (define-public gnome-mines (package (name "gnome-mines") diff --git a/gnu/packages/haskell.scm b/gnu/packages/haskell.scm index 05622ca068..e6b8e07be7 100644 --- a/gnu/packages/haskell.scm +++ b/gnu/packages/haskell.scm @@ -18,12 +18,14 @@ (define-module (gnu packages haskell) #:use-module (ice-9 regex) - #:use-module (guix licenses) + #:use-module ((guix licenses) #:select (bsd-3)) #:use-module (guix packages) #:use-module (guix download) #:use-module (guix utils) #:use-module (guix build-system gnu) + #:use-module (guix build-system haskell) #:use-module (gnu packages perl) + #:use-module (gnu packages compression) #:use-module (gnu packages elf) #:use-module (gnu packages bootstrap) #:use-module (gnu packages ghostscript) @@ -224,4 +226,648 @@ interactive environment for the functional language Haskell.") (license bsd-3))) +(define-public ghc-mtl + (package + (name "ghc-mtl") + (version "2.1.3.1") + (outputs '("out" "doc")) + (source + (origin + (method url-fetch) + (uri (string-append + "http://hackage.haskell.org/package/mtl/mtl-" + version + ".tar.gz")) + (sha256 + (base32 + "1xpn2wjmqbh2cg1yssc6749xpgcqlrrg4iilwqgkcjgvaxlpdbvp")))) + (build-system haskell-build-system) + (home-page "http://github.com/ekmett/mtl") + (synopsis + "Monad classes, using functional dependencies") + (description + "Monad classes using functional dependencies, with instances +for various monad transformers, inspired by the paper +'Functional Programming with Overloading and Higher-Order Polymorphism', +by Mark P Jones, in 'Advanced School of Functional Programming', 1995 +http://web.cecs.pdx.edu/~mpj/pubs/springschool.html.") + (license bsd-3))) + +(define-public ghc-paths + (package + (name "ghc-paths") + (version "0.1.0.9") + (outputs '("out" "doc")) + (source + (origin + (method url-fetch) + (uri (string-append + "http://hackage.haskell.org/package/ghc-paths/ghc-paths-" + version + ".tar.gz")) + (sha256 + (base32 + "0ibrr1dxa35xx20cpp8jzgfak1rdmy344dfwq4vlq013c6w8z9mg")))) + (build-system haskell-build-system) + (home-page "https://github.com/simonmar/ghc-paths") + (synopsis + "Knowledge of GHC's installation directories") + (description + "Knowledge of GHC's installation directories.") + (license bsd-3))) + +(define-public ghc-zlib + (package + (name "ghc-zlib") + (version "0.5.4.2") + (outputs '("out" "doc")) + (source + (origin + (method url-fetch) + (uri (string-append + "http://hackage.haskell.org/package/zlib/zlib-" + version + ".tar.gz")) + (sha256 + (base32 + "15hhsk7z3gvm7sz2ic2z1ca5c6rpsln2rr391mdbm1bxlzc1gmkm")))) + (build-system haskell-build-system) + (inputs `(("zlib" ,zlib))) + (home-page "http://hackage.haskell.org/package/zlib") + (synopsis + "Compression and decompression in the gzip and zlib formats") + (description + "This package provides a pure interface for compressing and decompressing +streams of data represented as lazy 'ByteString's. It uses the zlib C library +so it has high performance. It supports the 'zlib', 'gzip' and 'raw' +compression formats. It provides a convenient high level API suitable for +most tasks and for the few cases where more control is needed it provides +access to the full zlib feature set.") + (license bsd-3))) + +(define-public ghc-stm + (package + (name "ghc-stm") + (version "2.4.4") + (outputs '("out" "doc")) + (source + (origin + (method url-fetch) + (uri (string-append + "http://hackage.haskell.org/package/stm/stm-" + version + ".tar.gz")) + (sha256 + (base32 + "0gc8zvdijp3rwmidkpxv76b4i0dc8dw6nbd92rxl4vxl0655iysx")))) + (build-system haskell-build-system) + (home-page "http://hackage.haskell.org/package/stm") + (synopsis "Software Transactional Memory") + (description + "A modular composable concurrency abstraction.") + (license bsd-3))) + +(define-public ghc-parallel + (package + (name "ghc-parallel") + (version "3.2.0.6") + (outputs '("out" "doc")) + (source + (origin + (method url-fetch) + (uri (string-append + "http://hackage.haskell.org/package/parallel/parallel-" + version + ".tar.gz")) + (sha256 + (base32 + "0hp6vf4zxsw6vz6lj505xihmnfhgjp39c9q7nyzlgcmps3xx6a5r")))) + (build-system haskell-build-system) + (home-page "http://hackage.haskell.org/package/parallel") + (synopsis "Parallel programming library") + (description + "This package provides a library for parallel programming.") + (license bsd-3))) + +(define-public ghc-text + (package + (name "ghc-text") + (version "1.2.0.4") + (outputs '("out" "doc")) + (source + (origin + (method url-fetch) + (uri (string-append + "http://hackage.haskell.org/package/text/text-" + version + ".tar.gz")) + (sha256 + (base32 + "004p1c74crs8wmjafwsmw3mmycspq1j8fpm1lvfpq6acha7bnpc6")))) + (build-system haskell-build-system) + (arguments + `(#:tests? #f)) ; FIXME: currently missing libraries used for tests. + (home-page "https://github.com/bos/text") + (synopsis + "Efficient packed Unicode text type library.") + (description + "An efficient packed, immutable Unicode text type (both strict and +lazy), with a powerful loop fusion optimization framework. + +The 'Text' type represents Unicode character strings, in a time and +space-efficient manner. This package provides text processing +capabilities that are optimized for performance critical use, both +in terms of large data quantities and high speed.") + (license bsd-3))) + +(define-public ghc-hashable + (package + (name "ghc-hashable") + (version "1.2.3.2") + (outputs '("out" "doc")) + (source + (origin + (method url-fetch) + (uri (string-append + "http://hackage.haskell.org/package/hashable/hashable-" + version + ".tar.gz")) + (sha256 + (base32 + "0h9295pv2sgbaqlwpwbx2bap6nngm0jcdhkqham1wpjwyxqgqrlc")))) + (build-system haskell-build-system) + (arguments + `(#:tests? #f)) ; FIXME: currently missing libraries used for tests. + ;; these inputs are necessary to use this library + (propagated-inputs + `(("ghc-text" ,ghc-text))) + (home-page "http://github.com/tibbe/hashable") + (synopsis + "Class for types that can be converted to a hash value") + (description + "This package defines a class, 'Hashable', for types that can be +converted to a hash value. This class exists for the benefit of hashing-based +data structures. The package provides instances for basic types and a way to +combine hash values.") + (license bsd-3))) + +(define-public ghc-hunit + (package + (name "ghc-hunit") + (version "1.2.5.2") + (outputs '("out" "doc")) + (source + (origin + (method url-fetch) + (uri (string-append + "http://hackage.haskell.org/package/HUnit/HUnit-" + version + ".tar.gz")) + (sha256 + (base32 + "0hcs6qh8bqhip1kkjjnw7ccgcsmawdz5yvffjj5y8zd2vcsavx8a")))) + (build-system haskell-build-system) + (home-page "http://hunit.sourceforge.net/") + (synopsis "Unit testing framework for Haskell") + (description + "HUnit is a unit testing framework for Haskell, inspired by the +JUnit tool for Java.") + (license bsd-3))) + +(define-public ghc-random + (package + (name "ghc-random") + (version "1.1") + (outputs '("out" "doc")) + (source + (origin + (method url-fetch) + (uri (string-append + "http://hackage.haskell.org/package/random/random-" + version + ".tar.gz")) + (sha256 + (base32 "0nis3lbkp8vfx8pkr6v7b7kr5m334bzb0fk9vxqklnp2aw8a865p")))) + (build-system haskell-build-system) + (home-page "http://hackage.haskell.org/package/random") + (synopsis "Random number library") + (description "This package provides a basic random number generation +library, including the ability to split random number generators.") + (license bsd-3))) + +(define-public ghc-primitive + (package + (name "ghc-primitive") + (version "0.5.4.0") + (outputs '("out" "doc")) + (source + (origin + (method url-fetch) + (uri (string-append + "http://hackage.haskell.org/package/primitive/primitive-" + version + ".tar.gz")) + (sha256 + (base32 + "05gdgj383xdrdkhxh26imlvs8ji0z28ny38ms9snpvv5i8l2lg10")))) + (build-system haskell-build-system) + (home-page + "https://github.com/haskell/primitive") + (synopsis "Primitive memory-related operations") + (description + "This package provides various primitive memory-related operations.") + (license bsd-3))) + +(define-public ghc-tf-random + (package + (name "ghc-tf-random") + (version "0.5") + (outputs '("out" "doc")) + (source + (origin + (method url-fetch) + (uri (string-append + "http://hackage.haskell.org/package/tf-random/tf-random-" + version + ".tar.gz")) + (sha256 + (base32 "0445r2nns6009fmq0xbfpyv7jpzwv0snccjdg7hwj4xk4z0cwc1f")))) + (build-system haskell-build-system) + ;; these inputs are necessary to use this package + (propagated-inputs + `(("ghc-primitive" ,ghc-primitive) + ("ghc-random" ,ghc-random))) + (home-page "http://hackage.haskell.org/package/tf-random") + (synopsis "High-quality splittable pseudorandom number generator") + (description "This package contains an implementation of a high-quality +splittable pseudorandom number generator. The generator is based on a +cryptographic hash function built on top of the ThreeFish block cipher. See +the paper \"Splittable Pseudorandom Number Generators Using Cryptographic +Hashing\" by Claessen, Pałka for details and the rationale of the design.") + (license bsd-3))) + +(define-public ghc-quickcheck + (package + (name "ghc-quickcheck") + (version "2.8") + (outputs '("out" "doc")) + (source + (origin + (method url-fetch) + (uri (string-append + "http://hackage.haskell.org/package/QuickCheck/QuickCheck-" + version + ".tar.gz")) + (sha256 + (base32 + "04xs6mq22bcnkpi616qrbm7jlivh9csnhmvjgp1ifq52an1wr4rx")))) + (build-system haskell-build-system) + (arguments + `(#:tests? #f ; FIXME: currently missing libraries used for tests. + #:configure-flags '("-f base4"))) + ;; these inputs are necessary to use this package + (propagated-inputs + `(("ghc-tf-random" ,ghc-tf-random))) + (home-page + "https://github.com/nick8325/quickcheck") + (synopsis + "Automatic testing of Haskell programs") + (description + "QuickCheck is a library for random testing of program properties.") + (license bsd-3))) + +(define-public ghc-case-insensitive + (package + (name "ghc-case-insensitive") + (version "1.2.0.4") + (outputs '("out" "doc")) + (source + (origin + (method url-fetch) + (uri (string-append + "http://hackage.haskell.org/package/case-insensitive/case-insensitive-" + version + ".tar.gz")) + (sha256 + (base32 + "07nm40r9yw2p9qsfp3pjbsmyn4dabrxw34p48171zmccdd5hv0v3")))) + (build-system haskell-build-system) + (inputs + `(("ghc-hunit" ,ghc-hunit))) + ;; these inputs are necessary to use this library + (propagated-inputs + `(("ghc-text" ,ghc-text) + ("ghc-hashable" ,ghc-hashable))) + (arguments + `(#:tests? #f)) ; FIXME: currently missing libraries used for tests. + (home-page + "https://github.com/basvandijk/case-insensitive") + (synopsis "Case insensitive string comparison") + (description + "The module 'Data.CaseInsensitive' provides the 'CI' type constructor +which can be parameterised by a string-like type like: 'String', 'ByteString', +'Text', etc.. Comparisons of values of the resulting type will be insensitive +to cases.") + (license bsd-3))) + +(define-public ghc-syb + (package + (name "ghc-syb") + (version "0.4.4") + (outputs '("out" "doc")) + (source + (origin + (method url-fetch) + (uri (string-append + "http://hackage.haskell.org/package/syb/syb-" + version + ".tar.gz")) + (sha256 + (base32 + "11sc9kmfvcn9bfxf227fgmny502z2h9xs3z0m9ak66lk0dw6f406")))) + (build-system haskell-build-system) + (inputs + `(("ghc-hunit" ,ghc-hunit) + ("ghc-mtl" ,ghc-mtl))) + (home-page + "http://www.cs.uu.nl/wiki/GenericProgramming/SYB") + (synopsis "Scrap Your Boilerplate") + (description + "This package contains the generics system described in the +/Scrap Your Boilerplate/ papers (see +<http://www.cs.uu.nl/wiki/GenericProgramming/SYB>). +It defines the 'Data' class of types permitting folding and unfolding +of constructor applications, instances of this class for primitive +types, and a variety of traversals.") + (license bsd-3))) + +(define-public ghc-containers + (package + (name "ghc-containers") + (version "0.5.6.3") + (outputs '("out" "doc")) + (source + (origin + (method url-fetch) + (uri (string-append + "http://hackage.haskell.org/package/containers/containers-" + version + ".tar.gz")) + (sha256 + (base32 + "1kcd55nl0vzi99i8sr8fmc5j25fv7m0a9hd3nihnq1pd64pfciqn")))) + (build-system haskell-build-system) + (inputs + `(("ghc-hunit" ,ghc-hunit) + ("ghc-quickcheck" ,ghc-quickcheck))) + (arguments + `(#:tests? #f)) ; FIXME: currently missing libraries used for tests. + (home-page "http://hackage.haskell.org/package/containers") + (synopsis "Assorted concrete container types") + (description + "This package contains efficient general-purpose implementations of +various basic immutable container types. The declared cost of each operation +is either worst-case or amortized, but remains valid even if structures are +shared.") + (license bsd-3))) + +(define-public ghc-fgl + (package + (name "ghc-fgl") + (version "5.5.1.0") + (outputs '("out" "doc")) + (source + (origin + (method url-fetch) + (uri (string-append + "http://hackage.haskell.org/package/fgl/fgl-" + version + ".tar.gz")) + (sha256 + (base32 + "0rcmz0xlyr1wj490ffja29z1jgl51gz19ka609da6bx39bwx7nga")))) + (build-system haskell-build-system) + (inputs `(("ghc-mtl" ,ghc-mtl))) + (home-page "http://web.engr.oregonstate.edu/~erwig/fgl/haskell") + (synopsis + "Martin Erwig's Functional Graph Library") + (description "The functional graph library, FGL, is a collection of type +and function definitions to address graph problems. The basis of the library +is an inductive definition of graphs in the style of algebraic data types that +encourages inductive, recursive definitions of graph algorithms.") + (license bsd-3))) + +(define-public ghc-unordered-containers + (package + (name "ghc-unordered-containers") + (version "0.2.5.1") + (outputs '("out" "doc")) + (source + (origin + (method url-fetch) + (uri (string-append + "http://hackage.haskell.org/package/unordered-containers/unordered-containers-" + version + ".tar.gz")) + (sha256 + (base32 + "06l1xv7vhpxly75saxdrbc6p2zlgz1az278arfkz4rgawfnphn3f")))) + (build-system haskell-build-system) + (inputs + `(("ghc-hunit" ,ghc-hunit) + ("ghc-quickcheck" ,ghc-quickcheck))) + ;; these inputs are necessary to use this library + (propagated-inputs `(("ghc-hashable" ,ghc-hashable))) + (arguments + `(#:tests? #f)) ; FIXME: currently missing libraries used for tests. + (home-page + "https://github.com/tibbe/unordered-containers") + (synopsis + "Efficient hashing-based container types") + (description + "Efficient hashing-based container types. The containers have been +optimized for performance critical use, both in terms of large data quantities +and high speed.") + (license bsd-3))) + +(define-public ghc-split + (package + (name "ghc-split") + (version "0.2.2") + (outputs '("out" "doc")) + (source + (origin + (method url-fetch) + (uri (string-append + "http://hackage.haskell.org/package/split/split-" + version + ".tar.gz")) + (sha256 + (base32 + "0xa3j0gwr6k5vizxybnzk5fgb3pppgspi6mysnp2gwjp2dbrxkzr")))) + (build-system haskell-build-system) + (inputs + `(("ghc-quickcheck" ,ghc-quickcheck))) + (home-page "http://hackage.haskell.org/package/split") + (synopsis + "Combinator library for splitting lists") + (description "A collection of various methods for splitting lists into +parts, akin to the 'split' function found in several mainstream languages.") + (license bsd-3))) + +(define-public ghc-parsec + (package + (name "ghc-parsec") + (version "3.1.9") + (outputs '("out" "doc")) + (source + (origin + (method url-fetch) + (uri (string-append + "http://hackage.haskell.org/package/parsec/parsec-" + version + ".tar.gz")) + (sha256 + (base32 "1ja20cmj6v336jy87c6h3jzjp00sdbakwbdwp11iln499k913xvi")))) + (build-system haskell-build-system) + (inputs + `(("ghc-hunit" ,ghc-hunit))) + ;; these inputs are necessary to use this library + (propagated-inputs + `(("ghc-text" ,ghc-text) + ("ghc-mtl" ,ghc-mtl))) + (arguments + `(#:tests? #f)) ; FIXME: currently missing libraries used for tests. + (home-page + "https://github.com/aslatter/parsec") + (synopsis "Monadic parser combinators") + (description "Parsec is a parser library. It is simple, safe, well +documented, has extensive libraries, good error messages, and is fast. It is +defined as a monad transformer that can be stacked on arbitrary monads, and it +is also parametric in the input stream type.") + (license bsd-3))) + +(define-public ghc-vector + (package + (name "ghc-vector") + (version "0.10.12.2") + (outputs '("out" "doc")) + (source + (origin + (method url-fetch) + (uri (string-append + "http://hackage.haskell.org/package/vector/vector-" + version + ".tar.gz")) + (sha256 + (base32 + "01hc71k1z9m0g0dv4zsvq5d2dvbgyc5p01hryw5c53792yi2fm25")))) + (build-system haskell-build-system) + (inputs + `(("ghc-quickcheck" ,ghc-quickcheck))) + ;; these inputs are necessary to use this library + (propagated-inputs + `(("ghc-primitive" ,ghc-primitive))) + (arguments + `(#:tests? #f)) ; FIXME: currently missing libraries used for tests. + (home-page "https://github.com/haskell/vector") + (synopsis "Efficient Arrays") + (description "An efficient implementation of Int-indexed arrays (both +mutable and immutable), with a powerful loop optimisation framework.") + (license bsd-3))) + +(define-public ghc-network + (package + (name "ghc-network") + (version "2.6.0.2") + (outputs '("out" "doc")) + (source + (origin + (method url-fetch) + (uri (string-append + "http://hackage.haskell.org/package/network/network-" + version + ".tar.gz")) + (sha256 + (base32 + "12b7saam5ga6l4cplgkad49xa4vkynz2ri9jxidx1cxiqjcl0vc4")))) + (build-system haskell-build-system) + (inputs + `(("ghc-hunit" ,ghc-hunit))) + (arguments + `(#:tests? #f ; FIXME: currently missing libraries used for tests. + #:phases + (modify-phases %standard-phases + (add-before configure set-sh + (lambda _ (setenv "CONFIG_SHELL" "sh")))))) + (home-page "https://github.com/haskell/network") + (synopsis "Low-level networking interface") + (description + "This package provides a low-level networking interface.") + (license bsd-3))) + +(define-public ghc-network-uri + (package + (name "ghc-network-uri") + (version "2.6.0.1") + (outputs '("out" "doc")) + (source + (origin + (method url-fetch) + (uri (string-append + "http://hackage.haskell.org/package/network-uri/network-uri-" + version + ".tar.gz")) + (sha256 + (base32 + "09ymamb128jgqghpda4nixncr73all8qc6q53976aricm6a27p37")))) + (build-system haskell-build-system) + (inputs + `(("ghc-hunit" ,ghc-hunit) + ("ghc-network" ,ghc-network))) + (arguments + `(#:tests? #f)) ; FIXME: currently missing libraries used for tests. + (propagated-inputs + `(("ghc-parsec" ,ghc-parsec))) + (home-page + "https://github.com/haskell/network-uri") + (synopsis "Labrary for URI manipulation") + (description "This package provides an URI manipulation inteface. In +'network-2.6' the 'Network.URI' module was split off from the 'network' +package into this package.") + (license bsd-3))) + +(define-public ghc-http + (package + (name "ghc-http") + (version "4000.2.19") + (outputs '("out" "doc")) + (source + (origin + (method url-fetch) + (uri (string-append + "http://hackage.haskell.org/package/HTTP/HTTP-" + version + ".tar.gz")) + (sha256 + (base32 + "1yzm8gimh8g0wwbixcbxg60v4l3vgi63w9v55ms0x9qnm6vrgysz")))) + (build-system haskell-build-system) + (inputs + `(("ghc-hunit" ,ghc-hunit))) + (propagated-inputs + `(("ghc-parsec" ,ghc-parsec) + ("ghc-mtl" ,ghc-mtl) + ("ghc-network" ,ghc-network) + ("ghc-network-uri" ,ghc-network-uri))) + (arguments + `(#:tests? #f)) ; FIXME: currently missing libraries used for tests. + (home-page "https://github.com/haskell/HTTP") + (synopsis "Library for client-side HTTP") + (description + "The HTTP package supports client-side web programming in Haskell. It +lets you set up HTTP connections, transmitting requests and processing the +responses coming back.") + (license bsd-3))) + ;;; haskell.scm ends here diff --git a/gnu/packages/package-management.scm b/gnu/packages/package-management.scm index f31f872602..9512fcd3b5 100644 --- a/gnu/packages/package-management.scm +++ b/gnu/packages/package-management.scm @@ -142,7 +142,10 @@ the Nix package manager.") (define guix-devel ;; Development version of Guix. - (let ((commit "9586011")) + ;; + ;; Note: use a short commit id; when using the long one, the limit on socket + ;; file names is exceeded while running the tests. + (let ((commit "0b13161")) (package (inherit guix-0.8.1) (version (string-append "0.8.1." commit)) (source (origin @@ -152,7 +155,7 @@ the Nix package manager.") (commit commit))) (sha256 (base32 - "0dcmw8gz2qxknjnh9k8rdwmgysnxnvawdmlg1pyzngakwlsy1c3z")))) + "0h9yyfxs14di858hb9ypjvdjryv8nzll6f9vxkggcy40iyhp65sh")))) (arguments (substitute-keyword-arguments (package-arguments guix-0.8.1) ((#:phases phases) diff --git a/gnu/packages/patches/inetutils-syslogd.patch b/gnu/packages/patches/inetutils-syslogd.patch new file mode 100644 index 0000000000..0bf9eb7fc6 --- /dev/null +++ b/gnu/packages/patches/inetutils-syslogd.patch @@ -0,0 +1,20 @@ +From <http://lists.gnu.org/archive/html/bug-inetutils/2015-04/msg00001.html>. + +2015-04-01 Ludovic Courtès <ludo@gnu.org> + + * src/syslogd.c (load_conffile): Use 'bcopy' instead of 'strcpy' + since the two regions may overlap. + Reported by Alex Kost <alezost@gmail.com> + at <http://lists.gnu.org/archive/html/guix-devel/2015-03/msg00780.html>. + +--- a/src/syslogd.c ++++ b/src/syslogd.c +@@ -1989,7 +1989,7 @@ load_conffile (const char *filename, struct filed **nextp) + if (*p == '\0' || *p == '#') + continue; + +- strcpy (cline, p); ++ bcopy (p, cline, strlen (p) + 1); + + /* Cut the trailing spaces. */ + for (p = strchr (cline, '\0'); isspace (*--p);) diff --git a/guix/build/haskell-build-system.scm b/guix/build/haskell-build-system.scm index 52b9c79d2f..e17967fb72 100644 --- a/guix/build/haskell-build-system.scm +++ b/guix/build/haskell-build-system.scm @@ -70,26 +70,28 @@ and parameters ~s~%" #:allow-other-keys) "Configure a given Haskell package." (let* ((out (assoc-ref outputs "out")) + (doc (assoc-ref outputs "doc")) + (lib (assoc-ref outputs "lib")) + (bin (assoc-ref outputs "bin")) (input-dirs (match inputs (((_ . dir) ...) dir) (_ '()))) (params (append `(,(string-append "--prefix=" out)) + `(,(string-append "--libdir=" (or lib out) "/lib")) + `(,(string-append "--bindir=" (or bin out) "/bin")) `(,(string-append - "--docdir=" out "/share/doc/" - (package-name-version out))) + "--docdir=" (or doc out) + "/share/doc/" (package-name-version out))) + '("--libsubdir=$compiler/$pkg-$version") `(,(string-append "--package-db=" %tmp-db-dir)) '("--global") - `(,(string-append - "--extra-include-dirs=" - (list->search-path-as-string - (search-path-as-list '("include") input-dirs) - ":"))) - `(,(string-append - "--extra-lib-dirs=" - (list->search-path-as-string - (search-path-as-list '("lib") input-dirs) - ":"))) + `(,@(map + (cut string-append "--extra-include-dirs=" <>) + (search-path-as-list '("include") input-dirs))) + `(,@(map + (cut string-append "--extra-lib-dirs=" <>) + (search-path-as-list '("lib") input-dirs))) (if tests? '("--enable-tests") '()) @@ -140,7 +142,7 @@ first match and return the content of the group." dir) (_ '()))) (conf-dirs (search-path-as-list - `(,(string-append "lib/" system "-" + `(,(string-append "lib/" (package-name-version haskell) "/package.conf.d")) input-dirs)) @@ -160,8 +162,8 @@ generate the cache as it would clash in user profiles." (let* ((out (assoc-ref outputs "out")) (haskell (assoc-ref inputs "haskell")) (lib (string-append out "/lib")) - (config-dir (string-append lib "/" system - "-" (package-name-version haskell) + (config-dir (string-append lib "/" + (package-name-version haskell) "/package.conf.d")) (id-rx (make-regexp "^id: *(.*)$")) (lib-rx (make-regexp "lib.*\\.(a|so)")) @@ -189,21 +191,13 @@ generate the cache as it would clash in user profiles." (define* (haddock #:key outputs haddock? haddock-flags #:allow-other-keys) "Run the test suite of a given Haskell package." (if haddock? - (let* ((out (assoc-ref outputs "out")) - (doc-src (string-append (getcwd) "/dist/doc")) - (doc-dest (string-append out "/share/doc/" - (package-name-version out)))) - (if (run-setuphs "haddock" haddock-flags) - (begin - (copy-recursively doc-src doc-dest) - #t) - #f)) + (run-setuphs "haddock" haddock-flags) #t)) (define %standard-phases (modify-phases gnu:%standard-phases (add-before configure setup-compiler setup-compiler) - (add-after install haddock haddock) + (add-before install haddock haddock) (add-after install register register) (replace install install) (replace check check) diff --git a/guix/http-client.scm b/guix/http-client.scm index 051fceecb5..3bffbb1c24 100644 --- a/guix/http-client.scm +++ b/guix/http-client.scm @@ -135,6 +135,47 @@ closed it will also close PORT, unless the KEEP-ALIVE? is true." (when (module-variable %web-http 'read-chunk-body) (module-set! %web-http 'make-chunked-input-port make-chunked-input-port)) + (define (make-delimited-input-port port len keep-alive?) + "Return an input port that reads from PORT, and makes sure that +exactly LEN bytes are available from PORT. Closing the returned port +closes PORT, unless KEEP-ALIVE? is true." + (define bytes-read 0) + + (define (fail) + ((@@ (web response) bad-response) + "EOF while reading response body: ~a bytes of ~a" + bytes-read len)) + + (define (read! bv start count) + ;; Read at most LEN bytes in total. HTTP/1.1 doesn't say what to do + ;; when a server provides more than the Content-Length, but it seems + ;; wise to just stop reading at LEN. + (let ((count (min count (- len bytes-read)))) + (let loop ((ret (get-bytevector-n! port bv start count))) + (cond ((eof-object? ret) + (if (= bytes-read len) + 0 ; EOF + (fail))) + ((and (zero? ret) (> count 0)) + ;; Do not return zero since zero means EOF, so try again. + (loop (get-bytevector-n! port bv start count))) + (else + (set! bytes-read (+ bytes-read ret)) + ret))))) + + (define close + (and (not keep-alive?) + (lambda () + (close port)))) + + (make-custom-binary-input-port "delimited input port" read! #f #f close)) + + (unless (guile-version>? "2.0.9") + ;; Guile <= 2.0.9 had a bug whereby 'response-body-port' would read more + ;; than what 'content-length' says. See Guile commit 802a25b. + (module-set! (resolve-module '(web response)) + 'make-delimited-input-port make-delimited-input-port)) + (define (read-response-body* r) "Reads the response body from @var{r}, as a bytevector. Returns @code{#f} if there was no response body." diff --git a/guix/import/hackage.scm b/guix/import/hackage.scm new file mode 100644 index 0000000000..1b27803dba --- /dev/null +++ b/guix/import/hackage.scm @@ -0,0 +1,767 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch> +;;; +;;; 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 import hackage) + #:use-module (ice-9 match) + #:use-module (ice-9 regex) + #:use-module (ice-9 rdelim) + #:use-module (ice-9 receive) + #:use-module (ice-9 pretty-print) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-1) + #:use-module ((guix download) #:select (download-to-store)) + #:use-module ((guix utils) #:select (package-name->name+version)) + #:use-module (guix import utils) + #:use-module (guix store) + #:use-module (guix hash) + #:use-module (guix base32) + #:use-module ((guix utils) #:select (call-with-temporary-output-file)) + #:export (hackage->guix-package)) + +;; Part 1: +;; +;; Functions used to read a Cabal file. + +(define ghc-standard-libraries + ;; List of libraries distributed with ghc (7.8.4). We include GHC itself as + ;; some packages list it. + '("ghc" + "haskell98" + "hoopl" + "base" + "transformers" + "deepseq" + "array" + "binary" + "bytestring" + "containers" + "time" + "cabal" + "bin-package-db" + "ghc-prim" + "integer-gmp" + "integer-simple" + "win32" + "template-haskell" + "process" + "haskeline" + "terminfo" + "directory" + "filepath" + "old-locale" + "unix" + "old-time" + "pretty" + "xhtml" + "hpc")) + +(define package-name-prefix "ghc-") + +(define key-value-rx + ;; Regular expression matching "key: value" + (make-regexp "([a-zA-Z0-9-]+):[ \t]*(\\w?.*)$")) + +(define sections-rx + ;; Regular expression matching a section "head sub-head ..." + (make-regexp "([a-zA-Z0-9\\(\\)-]+)")) + +(define comment-rx + ;; Regexp matching Cabal comment lines. + (make-regexp "^ *--")) + +(define (has-key? line) + "Check if LINE includes a key." + (regexp-exec key-value-rx line)) + +(define (comment-line? line) + "Check if LINE is a comment line." + (regexp-exec comment-rx line)) + +(define (line-indentation+rest line) + "Returns two results: The number of indentation spaces and the rest of the +line (without indentation)." + (let loop ((line-lst (string->list line)) + (count 0)) + ;; Sometimes values are spread over multiple lines and new lines start + ;; with a comma ',' with the wrong indentation. See e.g. haddock-api. + (if (or (null? line-lst) + (not (or + (eqv? (first line-lst) #\space) + (eqv? (first line-lst) #\,) ; see, e.g., haddock-api.cabal + (eqv? (first line-lst) #\tab)))) + (values count (list->string line-lst)) + (loop (cdr line-lst) (+ count 1))))) + +(define (multi-line-value lines seed) + "Function to read a value split across multiple lines. LINES are the +remaining input lines to be read. SEED is the value read on the same line as +the key. Return two values: A list with values and the remaining lines to be +processed." + (define (multi-line-value-with-min-indent lines seed min-indent) + (if (null? lines) + (values '() '()) + (let-values (((current-indent value) (line-indentation+rest (first lines))) + ((next-line-indent next-line-value) + (if (null? (cdr lines)) + (values #f "") + (line-indentation+rest (second lines))))) + (if (or (not next-line-indent) (< next-line-indent min-indent) + (regexp-exec condition-rx next-line-value)) + (values (reverse (cons value seed)) (cdr lines)) + (multi-line-value-with-min-indent (cdr lines) (cons value seed) + min-indent))))) + + (let-values (((current-indent value) (line-indentation+rest (first lines)))) + (multi-line-value-with-min-indent lines seed current-indent))) + +(define (read-cabal port) + "Parses a Cabal file from PORT. Return a list of list pairs: + +(((head1 sub-head1 ... key1) (value)) + ((head2 sub-head2 ... key2) (value2)) + ...). + +We try do deduce the Cabal format from the following document: +https://www.haskell.org/cabal/users-guide/developing-packages.html + +Keys are case-insensitive. We therefore lowercase them. Values are +case-sensitive. Currently only indentation-structured files are parsed. +Braces structured files are not handled." ;" <- make emacs happy. + (define (read-and-trim-line port) + (let ((line (read-line port))) + (if (string? line) + (string-trim-both line #\return) + line))) + + (define (strip-insignificant-lines port) + (let loop ((line (read-and-trim-line port)) + (result '())) + (cond + ((eof-object? line) + (reverse result)) + ((or (string-null? line) (comment-line? line)) + (loop (read-and-trim-line port) result)) + (else + (loop (read-and-trim-line port) (cons line result)))))) + + (let loop + ((lines (strip-insignificant-lines port)) + (indents '()) ; only includes indents at start of section heads. + (sections '()) + (result '())) + (let-values + (((current-indent line) + (if (null? lines) + (values 0 "") + (line-indentation+rest (first lines)))) + ((next-line-indent next-line) + (if (or (null? lines) (null? (cdr lines))) + (values 0 "") + (line-indentation+rest (second lines))))) + (if (null? lines) + (reverse result) + (let ((rx-result (has-key? line))) + (cond + (rx-result + (let ((key (string-downcase (match:substring rx-result 1))) + (value (match:substring rx-result 2))) + (cond + ;; Simple single line "key: value". + ((= next-line-indent current-indent) + (loop (cdr lines) indents sections + (cons + (list (reverse (cons key sections)) (list value)) + result))) + ;; Multi line "key: value\n value cont...". + ((> next-line-indent current-indent) + (let*-values (((value-lst lines) + (multi-line-value (cdr lines) + (if (string-null? value) + '() + `(,value))))) + ;; multi-line-value returns to the first line after the + ;; multi-value. + (loop lines indents sections + (cons + (list (reverse (cons key sections)) value-lst) + result)))) + ;; Section ended. + (else + ;; Indentation is reduced. Check by how many levels. + (let* ((idx (and=> (list-index + (lambda (x) (= next-line-indent x)) + indents) + (cut + <> + (if (has-key? next-line) 1 0)))) + (sec + (if idx + (drop sections idx) + (raise + (condition + (&message + (message "unable to parse Cabal file")))))) + (ind (drop indents idx))) + (loop (cdr lines) ind sec + (cons + (list (reverse (cons key sections)) (list value)) + result))))))) + ;; Start of a new section. + ((or (null? indents) + (> current-indent (first indents))) + (loop (cdr lines) (cons current-indent indents) + (cons (string-downcase line) sections) result)) + (else + (loop (cdr lines) indents + (cons (string-downcase line) (cdr sections)) + result)))))))) + +(define condition-rx + ;; Regexp for conditionals. + (make-regexp "^if +(.*)$")) + +(define (split-section section) + "Split SECTION in individual words with exception for the predicate of an +'if' conditional." + (let ((rx-result (regexp-exec condition-rx section))) + (if rx-result + `("if" ,(match:substring rx-result 1)) + (map match:substring (list-matches sections-rx section))))) + +(define (join-sections sec1 sec2) + (fold-right cons sec2 sec1)) + +(define (pre-process-keys key) + (match key + (() '()) + ((sec1 rest ...) + (join-sections (split-section sec1) (pre-process-keys rest))))) + +(define (pre-process-entry-keys entry) + (match entry + ((key value) + (list (pre-process-keys key) value)) + (() '()))) + +(define (pre-process-entries-keys entries) + "ENTRIES is a list of list pairs, a keys list and a valules list, as +produced by 'read-cabal'. Split each element of the keys list into individual +words. This pre-processing is used to read flags." + (match entries + ((entry rest ...) + (cons (pre-process-entry-keys entry) + (pre-process-entries-keys rest))) + (() + '()))) + +(define (get-flags pre-processed-entries) + "PRE-PROCESSED-ENTRIES is a list of list pairs, a keys list and a values +list, as produced by 'read-cabal' and pre-processed by +'pre-process-entries-keys'. Return a list of pairs with the name of flags and +their default value (one of \"False\" or \"True\") as specified in the Cabal file: + +((\"flag1-name\" . \"False-or-True\") ...)." ;" <- make emacs happy + (match pre-processed-entries + (() '()) + (((("flag" flag-name "default") (flag-val)) rest ...) + (cons (cons flag-name flag-val) + (get-flags rest))) + ((entry rest ... ) + (get-flags rest)) + (_ #f))) + +;; Part 2: +;; +;; Functions to read information from the Cabal object created by 'read-cabal' +;; and convert Cabal format dependencies conditionals into equivalent +;; S-expressions. + +(define tests-rx + ;; Cabal test keywords + (make-regexp "(os|arch|flag|impl) *\\(([ a-zA-Z0-9_.<>=-]+)\\)")) + +(define parens-rx + ;; Parentheses within conditions + (make-regexp "\\((.+)\\)")) + +(define or-rx + ;; OR operator in conditions + (make-regexp " +\\|\\| +")) + +(define and-rx + ;; AND operator in conditions + (make-regexp " +&& +")) + +(define not-rx + ;; NOT operator in conditions + (make-regexp "^!.+")) + +(define (bi-op-args str match-lst) + "Return a list with the arguments of (logic) bianry operators. MATCH-LST +is the result of 'list-match' against a binary operator regexp on STR." + (let ((operators (length match-lst))) + (map (lambda (from to) + (substring str from to)) + (cons 0 (map match:end match-lst)) + (append (map match:start match-lst) (list (string-length str)))))) + +(define (bi-op->sexp-like bi-op args) + "BI-OP is a string with the name of a Scheme operator which in a Cabal file +is represented by a binary operator. ARGS are the arguments of said operator. +Return a string representing an S-expression of the operator applied to its +arguments." + (if (= (length args) 1) + (first args) + (string-append "(" bi-op + (fold (lambda (arg seed) (string-append seed " " arg)) + "" args) ")"))) + +(define (not->sexp-like arg) + "If the string ARG is prefixed by a Cabal negation operator, convert it to +an equivalent Scheme S-expression string." + (if (regexp-exec not-rx arg) + (string-append "(not " + (substring arg 1 (string-length arg)) + ")") + arg)) + +(define (parens-less-cond->sexp-like conditional) + "Convert a Cabal CONDITIONAL string into a string with equivalent Scheme +syntax. This procedure accepts only simple conditionals without parentheses." + ;; The outher operation is the one with the lowest priority: OR + (bi-op->sexp-like + "or" + ;; each OR argument may be an AND operation + (map (lambda (or-arg) + (let ((m-lst (list-matches and-rx or-arg))) + ;; is there an AND operation? + (if (> (length m-lst) 0) + (bi-op->sexp-like + "and" + ;; expand NOT operators when there are ANDs + (map not->sexp-like (bi-op-args or-arg m-lst))) + ;; ... and when there aren't. + (not->sexp-like or-arg)))) + ;; list of OR arguments + (bi-op-args conditional (list-matches or-rx conditional))))) + +(define test-keyword-ornament "__") + +(define (conditional->sexp-like conditional) + "Convert a Cabal CONDITIONAL string into a string with equivalent Scheme +syntax." + ;; First we substitute TEST-KEYWORD-ORNAMENT for parentheses around tests + ;; keywords so that parentheses are only used to set precedences. This + ;; substantially simplify parsing. + (let ((conditional + (regexp-substitute/global #f tests-rx conditional + 'pre 1 test-keyword-ornament 2 + test-keyword-ornament 'post))) + (let loop ((sub-cond conditional)) + (let ((rx-result (regexp-exec parens-rx sub-cond))) + (cond + (rx-result + (parens-less-cond->sexp-like + (string-append + (match:prefix rx-result) + (loop (match:substring rx-result 1)) + (match:suffix rx-result)))) + (else + (parens-less-cond->sexp-like sub-cond))))))) + +(define (eval-flags sexp-like-cond flags) + "SEXP-LIKE-COND is a string representing an S-expression conditional. FLAGS +is a list of flag name and value pairs as produced by 'get-flags'. Substitute +\"#t\" or \"#f\" according to the value of flags. (Default to \"True\")." + (fold-right + (lambda (flag sexp) + (match flag + ((name . value) + (let ((rx (make-regexp + (string-append "flag" test-keyword-ornament name + test-keyword-ornament)))) + (regexp-substitute/global + #f rx sexp + 'pre (if (string-ci= value "False") "#f" "#t") 'post))) + (_ sexp))) + sexp-like-cond + (cons '("[a-zA-Z0-9_-]+" . "True") flags))) + +(define (eval-tests->sexp sexp-like-cond) + "In the string SEXP-LIKE-COND substitute test keywords \"os(...)\" and +\"arch(...)\" with equivalent Scheme checks. Retrun an S-expression." + (with-input-from-string + (fold-right + (lambda (test sexp) + (match test + ((type pre-match post-match) + (let ((rx (make-regexp + (string-append type test-keyword-ornament "(\\w+)" + test-keyword-ornament)))) + (regexp-substitute/global + #f rx sexp + 'pre pre-match 2 post-match 'post))) + (_ sexp))) + sexp-like-cond + ;; (%current-system) returns, e.g., "x86_64-linux" or "i686-linux". + '(("(os|arch)" "(string-match \"" "\" (%current-system))"))) + read)) + +(define (eval-impl sexp-like-cond) + "Check for the Cabal test \"impl(...)\" in the string SEXP-LIKE-COND. +Assume the module declaring the generated package includes a local variable +called \"haskell-implementation\" with a string value of the form NAME-VERSION +against which we compare." + (with-output-to-string + (lambda () + (write + (with-input-from-string + (fold-right + (lambda (test sexp) + (match test + ((pre-match post-match) + (let ((rx-with-version + (make-regexp + (string-append + "impl" test-keyword-ornament + "([a-zA-Z0-9_-]+) *([<>=]+) *([0-9.]+) *" + test-keyword-ornament))) + (rx-without-version + (make-regexp + (string-append "impl" test-keyword-ornament "(\\w+)" + test-keyword-ornament)))) + (if (regexp-exec rx-with-version sexp) + (regexp-substitute/global + #f rx-with-version sexp + 'pre pre-match 2 " " post-match " \"" 1 "-" 3 "\")" 'post) + (regexp-substitute/global + #f rx-without-version sexp + 'pre pre-match "-match \"" 1 "\" " post-match ")" 'post)))) + (_ sexp))) + sexp-like-cond + '(("(string" "haskell-implementation"))) + read))))) + +(define (eval-cabal-keywords sexp-like-cond flags) + ((compose eval-tests->sexp eval-impl (cut eval-flags <> flags)) + sexp-like-cond)) + +(define (key->values meta key) + "META is the representation of a Cabal file as produced by 'read-cabal'. +Return the list of values associated with a specific KEY (a string)." + (match meta + (() '()) + (((((? (lambda(x) (equal? x key)))) v) r ...) + v) + (((k v) r ...) + (key->values (cdr meta) key)) + (_ "key Not fount"))) + +(define (key-start-end->entries meta key-start-rx key-end-rx) + "META is the representation of a Cabal file as produced by 'read-cabal'. +Return all entries whose keys list starts with KEY-START and ends with +KEY-END." + (let ((pred + (lambda (x) + (and (regexp-exec key-start-rx (first x)) + (regexp-exec key-end-rx (last x)))))) + ;; (equal? (list key-start key-end) (list (first x) (last x)))))) + (match meta + (() '()) + ((((? pred k) v) r ...) + (cons `(,k ,v) + (key-start-end->entries (cdr meta) key-start-rx key-end-rx))) + (((k v) r ...) + (key-start-end->entries (cdr meta) key-start-rx key-end-rx)) + (_ "key Not fount")))) + +(define else-rx + (make-regexp "^else$")) + +(define (count-if-else rx-result-ls) + (apply + (map (lambda (m) (if m 1 0)) rx-result-ls))) + +(define (analyze-entry-cond entry) + (let* ((keys (first entry)) + (vals (second entry)) + (rx-cond-result + (map (cut regexp-exec condition-rx <>) keys)) + (rx-else-result + (map (cut regexp-exec else-rx <>) keys)) + (cond-no (count-if-else rx-cond-result)) + (else-no (count-if-else rx-else-result)) + (cond-idx (list-index (lambda (rx) (if rx #t #f)) rx-cond-result)) + (else-idx (list-index (lambda (rx) (if rx #t #f)) rx-else-result)) + (key-cond + (cond + ((or (and cond-idx else-idx (< cond-idx else-idx)) + (and cond-idx (not else-idx))) + (match:substring + (receive (head tail) + (split-at rx-cond-result cond-idx) (first tail)))) + ((or (and cond-idx else-idx (> cond-idx else-idx)) + (and (not cond-idx) else-idx)) + (match:substring + (receive (head tail) + (split-at rx-else-result else-idx) (first tail)))) + (else + "")))) + (values keys vals rx-cond-result + rx-else-result cond-no else-no key-cond))) + +(define (remove-cond entry cond) + (match entry + ((k v) + (list (cdr (member cond k)) v)))) + +(define (group-and-reduce-level entries group group-cond) + (let loop + ((true-group group) + (false-group '()) + (entries entries)) + (if (null? entries) + (values (reverse true-group) (reverse false-group) entries) + (let*-values (((entry) (first entries)) + ((keys vals rx-cond-result rx-else-result + cond-no else-no key-cond) + (analyze-entry-cond entry))) + (cond + ((and (>= (+ cond-no else-no) 1) (string= group-cond key-cond)) + (loop (cons (remove-cond entry group-cond) true-group) false-group + (cdr entries))) + ((and (>= (+ cond-no else-no) 1) (string= key-cond "else")) + (loop true-group (cons (remove-cond entry "else") false-group) + (cdr entries))) + (else + (values (reverse true-group) (reverse false-group) entries))))))) + +(define dependencies-rx + (make-regexp "([a-zA-Z0-9_-]+) *[^,]*,?")) + +(define (hackage-name->package-name name) + (if (string-prefix? package-name-prefix name) + (string-downcase name) + (string-append package-name-prefix (string-downcase name)))) + +(define (split-and-filter-dependencies ls names-to-filter) + "Split the comma separated list of dependencies LS coming from the Cabal +file, filter packages included in NAMES-TO-FILTER and return a list with +inputs suitable for the Guix package. Currently the version information is +discarded." + (define (split-at-comma-and-filter d) + (fold + (lambda (m seed) + (let* ((name (string-downcase (match:substring m 1))) + (pkg-name (hackage-name->package-name name))) + (if (member name names-to-filter) + seed + (cons (list pkg-name (list 'unquote (string->symbol pkg-name))) + seed)))) + '() + (list-matches dependencies-rx d))) + + (fold (lambda (d p) (append (split-at-comma-and-filter d) p)) '() ls)) + +(define* (dependencies-cond->sexp meta #:key (include-test-dependencies? #t)) + "META is the representation of a Cabal file as produced by 'read-cabal'. +Return an S-expression containing the list of dependencies as expected by the +'inputs' field of a package. The generated S-expressions may include +conditionals as defined in the cabal file. During this process we discard the +version information of the packages." + (define (take-dependencies meta) + (let ((key-start-exe (make-regexp "executable")) + (key-start-lib (make-regexp "library")) + (key-start-tests (make-regexp "test-suite")) + (key-end (make-regexp "build-depends"))) + (append + (key-start-end->entries meta key-start-exe key-end) + (key-start-end->entries meta key-start-lib key-end) + (if include-test-dependencies? + (key-start-end->entries meta key-start-tests key-end) + '())))) + + (let ((flags (get-flags (pre-process-entries-keys meta))) + (augmented-ghc-std-libs (append (key->values meta "name") + ghc-standard-libraries))) + (delete-duplicates + (let loop ((entries (take-dependencies meta)) + (result '())) + (if (null? entries) + (reverse result) + (let*-values (((entry) (first entries)) + ((keys vals rx-cond-result rx-else-result + cond-no else-no key-cond) + (analyze-entry-cond entry))) + (cond + ((= (+ cond-no else-no) 0) + (loop (cdr entries) + (append + (split-and-filter-dependencies vals + augmented-ghc-std-libs) + result))) + (else + (let-values (((true-group false-group entries) + (group-and-reduce-level entries '() + key-cond)) + ((cond-final) (eval-cabal-keywords + (conditional->sexp-like + (last (split-section key-cond))) + flags))) + (loop entries + (cond + ((or (eq? cond-final #t) (equal? cond-final '(not #f))) + (append (loop true-group '()) result)) + ((or (eq? cond-final #f) (equal? cond-final '(not #t))) + (append (loop false-group '()) result)) + (else + (let ((true-group-result (loop true-group '())) + (false-group-result (loop false-group '()))) + (cond + ((and (null? true-group-result) + (null? false-group-result)) + result) + ((null? false-group-result) + (cons `(unquote-splicing + (when ,cond-final ,true-group-result)) + result)) + ((null? true-group-result) + (cons `(unquote-splicing + (unless ,cond-final ,false-group-result)) + result)) + (else + (cons `(unquote-splicing + (if ,cond-final + ,true-group-result + ,false-group-result)) + result)))))))))))))))) + +;; Part 3: +;; +;; Retrive the desired package and its Cabal file from +;; http://hackage.haskell.org and construct the Guix package S-expression. + +(define (hackage-fetch name-version) + "Return the Cabal file for the package NAME-VERSION, or #f on failure. If +the version part is omitted from the package name, then return the latest +version." + (let*-values (((name version) (package-name->name+version name-version)) + ((url) + (if version + (string-append "http://hackage.haskell.org/package/" + name "-" version "/" name ".cabal") + (string-append "http://hackage.haskell.org/package/" + name "/" name ".cabal")))) + (call-with-temporary-output-file + (lambda (temp port) + (and (url-fetch url temp) + (call-with-input-file temp read-cabal)))))) + +(define string->license + ;; List of valid values from + ;; https://www.haskell.org + ;; /cabal/release/cabal-latest/doc/API/Cabal/Distribution-License.html. + (match-lambda + ("GPL-2" 'gpl2) + ("GPL-3" 'gpl3) + ("GPL" "'gpl??") + ("AGPL-3" 'agpl3) + ("AGPL" "'agpl??") + ("LGPL-2.1" 'lgpl2.1) + ("LGPL-3" 'lgpl3) + ("LGPL" "'lgpl??") + ("BSD2" 'bsd-2) + ("BSD3" 'bsd-3) + ("MIT" 'expat) + ("ISC" 'isc) + ("MPL" 'mpl2.0) + ("Apache-2.0" 'asl2.0) + ((x) (string->license x)) + ((lst ...) `(list ,@(map string->license lst))) + (_ #f))) + +(define* (hackage-module->sexp meta #:key (include-test-dependencies? #t)) + "Return the `package' S-expression for a Cabal package. META is the +representation of a Cabal file as produced by 'read-cabal'." + + (define name + (first (key->values meta "name"))) + + (define version + (first (key->values meta "version"))) + + (define description + (let*-values (((description) (key->values meta "description")) + ((lines last) + (split-at description (- (length description) 1)))) + (fold-right (lambda (line seed) (string-append line "\n" seed)) + (first last) lines))) + + (define source-url + (string-append "http://hackage.haskell.org/package/" name + "/" name "-" version ".tar.gz")) + + ;; Several packages do not have an official home-page other than on Hackage. + (define home-page + (let ((home-page-entry (key->values meta "homepage"))) + (if (null? home-page-entry) + (string-append "http://hackage.haskell.org/package/" name) + (first home-page-entry)))) + + (define (maybe-inputs input-type inputs) + (match inputs + (() + '()) + ((inputs ...) + (list (list input-type + (list 'quasiquote inputs)))))) + + (let ((tarball (with-store store + (download-to-store store source-url)))) + `(package + (name ,(hackage-name->package-name name)) + (version ,version) + (source (origin + (method url-fetch) + (uri (string-append ,@(factorize-uri source-url version))) + (sha256 + (base32 + ,(if tarball + (bytevector->nix-base32-string (file-sha256 tarball)) + "failed to download tar archive"))))) + (build-system haskell-build-system) + ,@(maybe-inputs 'inputs + (dependencies-cond->sexp meta + #:include-test-dependencies? + include-test-dependencies?)) + (home-page ,home-page) + (synopsis ,@(key->values meta "synopsis")) + (description ,description) + (license ,(string->license (key->values meta "license")))))) + +(define* (hackage->guix-package module-name + #:key (include-test-dependencies? #t)) + "Fetch the Cabal file for PACKAGE-NAME from hackage.haskell.org, and return +the `package' S-expression corresponding to that package, or #f on failure." + (let ((module-meta (hackage-fetch module-name))) + (and=> module-meta (cut hackage-module->sexp <> + #:include-test-dependencies? + include-test-dependencies?)))) + +;;; cabal.scm ends here diff --git a/guix/profiles.scm b/guix/profiles.scm index 465aaf9477..a2f63d1cca 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -404,6 +404,55 @@ MANIFEST." (gexp->derivation "info-dir" build #:modules '((guix build utils))))) +(define (ghc-package-cache-file manifest) + "Return a derivation that builds the GHC 'package.cache' file for all the +entries of MANIFEST." + (define ghc ;lazy reference + (module-ref (resolve-interface '(gnu packages haskell)) 'ghc)) + + (define build + #~(begin + (use-modules (guix build utils) + (srfi srfi-1) (srfi srfi-26) + (ice-9 ftw)) + + (define ghc-name-version + (let* ((base (basename #+ghc))) + (string-drop base + (+ 1 (string-index base #\-))))) + + (define db-subdir + (string-append "lib/" ghc-name-version "/package.conf.d")) + + (define db-dir + (string-append #$output "/" db-subdir)) + + (define (conf-files top) + (find-files (string-append top "/" db-subdir) "\\.conf$")) + + (define (copy-conf-file conf) + (let ((base (basename conf))) + (copy-file conf (string-append db-dir "/" base)))) + + (system* (string-append #+ghc "/bin/ghc-pkg") "init" db-dir) + (for-each copy-conf-file + (append-map conf-files + '#$(manifest-inputs manifest))) + (let ((success + (zero? + (system* (string-append #+ghc "/bin/ghc-pkg") "recache" + (string-append "--package-db=" db-dir))))) + (for-each delete-file (find-files db-dir "\\.conf$")) + success))) + + ;; Don't depend on GHC when there's nothing to do. + (if (any (cut string-prefix? "ghc" <>) + (map manifest-entry-name (manifest-entries manifest))) + (gexp->derivation "ghc-package-cache" build + #:modules '((guix build utils)) + #:local-build? #t) + (gexp->derivation "ghc-package-cache" #~(mkdir #$output)))) + (define (ca-certificate-bundle manifest) "Return a derivation that builds a single-file bundle containing the CA certificates in the /etc/ssl/certs sub-directories of the packages in @@ -465,14 +514,18 @@ MANIFEST. Single-file bundles are required by programs such as Git and Lynx." (define* (profile-derivation manifest #:key (info-dir? #t) + (ghc-package-cache? #t) (ca-certificate-bundle? #t)) "Return a derivation that builds a profile (aka. 'user environment') with the given MANIFEST. The profile includes a top-level Info 'dir' file unless -INFO-DIR? is #f, and a single-file CA certificate bundle unless -CA-CERTIFICATE-BUNDLE? is #f." +INFO-DIR? is #f, a GHC 'package.cache' file unless GHC-PACKAGE-CACHE? is #f +and a single-file CA certificate bundle unless CA-CERTIFICATE-BUNDLE? is #f." (mlet %store-monad ((info-dir (if info-dir? (info-dir-file manifest) (return #f))) + (ghc-package-cache (if ghc-package-cache? + (ghc-package-cache-file manifest) + (return #f))) (ca-cert-bundle (if ca-certificate-bundle? (ca-certificate-bundle manifest) (return #f)))) @@ -480,6 +533,9 @@ CA-CERTIFICATE-BUNDLE? is #f." (append (if info-dir (list (gexp-input info-dir)) '()) + (if ghc-package-cache + (list (gexp-input ghc-package-cache)) + '()) (if ca-cert-bundle (list (gexp-input ca-cert-bundle)) '()) diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm index 7e75c10b3e..06b4c17573 100644 --- a/guix/scripts/import.scm +++ b/guix/scripts/import.scm @@ -73,7 +73,7 @@ rather than \\n." ;;; Entry point. ;;; -(define importers '("gnu" "nix" "pypi" "cpan")) +(define importers '("gnu" "nix" "pypi" "cpan" "hackage")) (define (resolve-importer name) (let ((module (resolve-interface diff --git a/guix/scripts/import/hackage.scm b/guix/scripts/import/hackage.scm new file mode 100644 index 0000000000..f7c18cd3bf --- /dev/null +++ b/guix/scripts/import/hackage.scm @@ -0,0 +1,106 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch> +;;; +;;; 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 scripts import hackage) + #:use-module (guix ui) + #:use-module (guix utils) + #:use-module (guix import hackage) + #:use-module (guix scripts import) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-37) + #:use-module (ice-9 match) + #:use-module (ice-9 format) + #:export (guix-import-hackage)) + + +;;; +;;; Command-line options. +;;; + +(define %default-options + '((include-test-dependencies? . #t))) + +(define (show-help) + (display (_ "Usage: guix import hackage PACKAGE-NAME +Import and convert the Hackage package for PACKAGE-NAME. If PACKAGE-NAME +includes a suffix constituted by a dash followed by a numerical version (as +used with Guix packages), then a definition for the specified version of the +package will be generated. If no version suffix is pecified, then the +generated package definition will correspond to the latest available +version.\n")) + (display (_ " + -h, --help display this help and exit")) + (display (_ " + -t, --no-test-dependencies don't include test only dependencies")) + (display (_ " + -V, --version display version information and exit")) + (newline) + (show-bug-report-information)) + +(define %options + ;; Specification of the command-line options. + (cons* (option '(#\h "help") #f #f + (lambda args + (show-help) + (exit 0))) + (option '(#\V "version") #f #f + (lambda args + (show-version-and-exit "guix import hackage"))) + (option '(#\t "no-test-dependencies") #f #f + (lambda (opt name arg result) + (alist-cons 'include-test-dependencies? #f + (alist-delete 'include-test-dependencies? + result)))) + %standard-import-options)) + + +;;; +;;; Entry point. +;;; + +(define (guix-import-hackage . args) + (define (parse-options) + ;; Return the alist of option values. + (args-fold* args %options + (lambda (opt name arg result) + (leave (_ "~A: unrecognized option~%") name)) + (lambda (arg result) + (alist-cons 'argument arg result)) + %default-options)) + + (let* ((opts (parse-options)) + (args (filter-map (match-lambda + (('argument . value) + value) + (_ #f)) + (reverse opts)))) + (match args + ((package-name) + (let ((sexp (hackage->guix-package + package-name + #:include-test-dependencies? + (assoc-ref opts 'include-test-dependencies?)))) + (unless sexp + (leave (_ "failed to download cabal file for package '~a'~%") + package-name)) + sexp)) + (() + (leave (_ "too few arguments~%"))) + ((many ...) + (leave (_ "too many arguments~%")))))) diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 6190f3286d..09ae782751 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -838,6 +838,7 @@ more information.~%")) (profile-derivation new #:info-dir? (not bootstrap?) + #:ghc-package-cache? (not bootstrap?) #:ca-certificate-bundle? (not bootstrap?)))) (prof (derivation->output-path prof-drv))) (show-manifest-transaction (%store) manifest transaction diff --git a/po/guix/POTFILES.in b/po/guix/POTFILES.in index 5ac9201295..30ce28b712 100644 --- a/po/guix/POTFILES.in +++ b/po/guix/POTFILES.in @@ -8,6 +8,7 @@ guix/scripts/download.scm guix/scripts/package.scm guix/scripts/gc.scm guix/scripts/hash.scm +guix/scripts/import.scm guix/scripts/pull.scm guix/scripts/substitute.scm guix/scripts/authenticate.scm diff --git a/tests/guix-package-net.sh b/tests/guix-package-net.sh index cedfa3217b..cf3233bee2 100644 --- a/tests/guix-package-net.sh +++ b/tests/guix-package-net.sh @@ -37,6 +37,14 @@ shebang_too_long () -ge 128 } +if ! guile -c '(getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)' 2> /dev/null \ + || shebang_too_long +then + # Skipping. + exit 77 +fi + + profile="t-profile-$$" rm -f "$profile" diff --git a/tests/hackage.scm b/tests/hackage.scm new file mode 100644 index 0000000000..23b854caa4 --- /dev/null +++ b/tests/hackage.scm @@ -0,0 +1,134 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch> +;;; +;;; 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 (test-hackage) + #:use-module (guix import hackage) + #:use-module (guix tests) + #:use-module (srfi srfi-64) + #:use-module (ice-9 match)) + +(define test-cabal-1 + "name: foo +version: 1.0.0 +homepage: http://test.org +synopsis: synopsis +description: description +license: BSD3 +executable cabal + build-depends: + HTTP >= 4000.2.5 && < 4000.3, + mtl >= 2.0 && < 3 +") + +;; Use TABs to indent lines and to separate keys from value. +(define test-cabal-2 + "name: foo +version: 1.0.0 +homepage: http://test.org +synopsis: synopsis +description: description +license: BSD3 +executable cabal + build-depends: HTTP >= 4000.2.5 && < 4000.3, + mtl >= 2.0 && < 3 +") + +;; Use indentation with comma as found, e.g., in 'haddock-api'. +(define test-cabal-3 + "name: foo +version: 1.0.0 +homepage: http://test.org +synopsis: synopsis +description: description +license: BSD3 +executable cabal + build-depends: + HTTP >= 4000.2.5 && < 4000.3 + , mtl >= 2.0 && < 3 +") + +(define test-cond-1 + "(os(darwin) || !(flag(debug))) && flag(cips)") + +(define read-cabal + (@@ (guix import hackage) read-cabal)) + +(define eval-cabal-keywords + (@@ (guix import hackage) eval-cabal-keywords)) + +(define conditional->sexp-like + (@@ (guix import hackage) conditional->sexp-like)) + +(test-begin "hackage") + +(define (eval-test-with-cabal test-cabal) + (mock + ((guix import hackage) hackage-fetch + (lambda (name-version) + (call-with-input-string test-cabal + read-cabal))) + (match (hackage->guix-package "foo") + (('package + ('name "ghc-foo") + ('version "1.0.0") + ('source + ('origin + ('method 'url-fetch) + ('uri ('string-append + "http://hackage.haskell.org/package/foo/foo-" + 'version + ".tar.gz")) + ('sha256 + ('base32 + (? string? hash))))) + ('build-system 'haskell-build-system) + ('inputs + ('quasiquote + (("ghc-http" ('unquote 'ghc-http)) + ("ghc-mtl" ('unquote 'ghc-mtl))))) + ('home-page "http://test.org") + ('synopsis (? string?)) + ('description (? string?)) + ('license 'bsd-3)) + #t) + (x + (pk 'fail x #f))))) + +(test-assert "hackage->guix-package test 1" + (eval-test-with-cabal test-cabal-1)) + +(test-assert "hackage->guix-package test 2" + (eval-test-with-cabal test-cabal-2)) + +(test-assert "hackage->guix-package test 3" + (eval-test-with-cabal test-cabal-3)) + +(test-assert "conditional->sexp-like" + (match + (eval-cabal-keywords + (conditional->sexp-like test-cond-1) + '(("debug" . "False"))) + (('and ('or ('string-match "darwin" ('%current-system)) ('not '#f)) '#t) + #t) + (x + (pk 'fail x #f)))) + +(test-end "hackage") + + +(exit (= (test-runner-fail-count (test-runner-current)) 0)) diff --git a/tests/packages.scm b/tests/packages.scm index a181b1b08a..b50551e963 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -597,6 +597,7 @@ (manifest (map package->manifest-entry (list p1 p2))) #:info-dir? #f + #:ghc-package-cache? #f #:ca-certificate-bundle? #f) #:guile-for-build (%guile-for-build)))) (build-derivations %store (list prof)) diff --git a/tests/profiles.scm b/tests/profiles.scm index 7b942e35b0..d20cb9d808 100644 --- a/tests/profiles.scm +++ b/tests/profiles.scm @@ -184,6 +184,7 @@ (guile (package->derivation %bootstrap-guile)) (drv (profile-derivation (manifest (list entry)) #:info-dir? #f + #:ghc-package-cache? #f #:ca-certificate-bundle? #f)) (profile -> (derivation->output-path drv)) (bindir -> (string-append profile "/bin")) @@ -197,6 +198,7 @@ ((entry -> (package->manifest-entry packages:glibc "debug")) (drv (profile-derivation (manifest (list entry)) #:info-dir? #f + #:ghc-package-cache? #f #:ca-certificate-bundle? #f))) (return (derivation-inputs drv)))) |