aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--configure.ac3
-rw-r--r--doc/guix.texi47
-rw-r--r--gnu-system.am1
-rw-r--r--gnu/build/activation.scm49
-rw-r--r--gnu/packages/admin.scm10
-rw-r--r--gnu/packages/gnome.scm48
-rw-r--r--gnu/packages/haskell.scm648
-rw-r--r--gnu/packages/package-management.scm7
-rw-r--r--gnu/packages/patches/inetutils-syslogd.patch20
-rw-r--r--guix/build/haskell-build-system.scm44
-rw-r--r--guix/http-client.scm41
-rw-r--r--guix/import/hackage.scm767
-rw-r--r--guix/profiles.scm60
-rw-r--r--guix/scripts/import.scm2
-rw-r--r--guix/scripts/import/hackage.scm106
-rw-r--r--guix/scripts/package.scm1
-rw-r--r--po/guix/POTFILES.in1
-rw-r--r--tests/guix-package-net.sh8
-rw-r--r--tests/hackage.scm134
-rw-r--r--tests/packages.scm1
-rw-r--r--tests/profiles.scm2
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))))