nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' into core-updates

This commit is contained in:
Ludovic Courtès 2015-04-09 21:10:46 +02:00
parent afd40799e4 0cc0095f3c
commit ee5408576d
21 changed files with 1962 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
configure.ac
View File

@ -9,6 +9,9 @@ AC_CONFIG_AUX_DIR([build-aux])
AM_INIT_AUTOMAKE([1.12 gnu silent-rules subdir-objects \ AM_INIT_AUTOMAKE([1.12 gnu silent-rules subdir-objects \
color-tests parallel-tests -Woverride]) color-tests parallel-tests -Woverride])
# Enable silent rules by default.
AM_SILENT_RULES([yes])
AC_CONFIG_SRCDIR([guix.scm]) AC_CONFIG_SRCDIR([guix.scm])
AC_CONFIG_MACRO_DIR([m4]) AC_CONFIG_MACRO_DIR([m4])

47
doc/guix.texi
View File

@ -3188,6 +3188,37 @@ bound to the @code{libreoffice} top-level attribute):
@example @example
guix import nix ~/path/to/nixpkgs libreoffice guix import nix ~/path/to/nixpkgs libreoffice
@end example @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 @end table
The structure of the @command{guix import} code is modular. It would be 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 @node User Accounts
@subsection 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 @example
(user-account (user-account
@ -4221,6 +4254,14 @@ User accounts are specified with the @code{user-account} form:
(home-directory "/home/alice")) (home-directory "/home/alice"))
@end example @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 @deftp {Data Type} user-account
Objects of this type represent user accounts. The following members may Objects of this type represent user accounts. The following members may
be specified: be specified:
@ -4260,7 +4301,9 @@ graphical login managers do not list them.
@item @code{password} (default: @code{#f}) @item @code{password} (default: @code{#f})
You would normally leave this field to @code{#f}, initialize user You would normally leave this field to @code{#f}, initialize user
passwords as @code{root} with the @command{passwd} command, and then let 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 If you @emph{do} want to have a preset password for an account, then
this field must contain the encrypted password, as a string. this field must contain the encrypted password, as a string.

1
gnu-system.am
View File

@ -441,6 +441,7 @@ dist_patch_DATA = \
gnu/packages/patches/guix-test-networking.patch \ gnu/packages/patches/guix-test-networking.patch \
gnu/packages/patches/gtkglext-disable-disable-deprecated.patch \ gnu/packages/patches/gtkglext-disable-disable-deprecated.patch \
gnu/packages/patches/hop-bigloo-4.0b.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/irrlicht-mesa-10.patch \
gnu/packages/patches/jbig2dec-ignore-testtest.patch \ gnu/packages/patches/jbig2dec-ignore-testtest.patch \
gnu/packages/patches/kmod-module-directory.patch \ gnu/packages/patches/kmod-module-directory.patch \

49
gnu/build/activation.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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> ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -40,6 +40,24 @@
;;; ;;;
;;; Code: ;;; 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? (define* (add-group name #:key gid password system?
(log-port (current-error-port))) (log-port (current-error-port)))
"Add NAME as a user group, with the given numeric GID if specified." "Add NAME as a user group, with the given numeric GID if specified."
@ -128,6 +146,17 @@ properties. Return #t on success."
,name))) ,name)))
(zero? (apply system* "usermod" args)))) (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 (define* (ensure-user name group
#:key uid comment home shell password system? #:key uid comment home shell password system?
(supplementary-groups '()) (supplementary-groups '())
@ -186,8 +215,22 @@ numeric gid or #f."
#:system? system?)))) #:system? system?))))
groups) groups)
;; Finally create the other user accounts. ;; Create the other user accounts.
(for-each activate-user users)) (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) (define (activate-etc etc)
"Install ETC, a directory in the store, as the source of static files for "Install ETC, a directory in the store, as the source of static files for

10
gnu/packages/admin.scm
View File

@ -55,7 +55,8 @@
#:use-module (gnu packages libftdi) #:use-module (gnu packages libftdi)
#:use-module (gnu packages image) #:use-module (gnu packages image)
#:use-module (gnu packages xorg) #:use-module (gnu packages xorg)
#:use-module (gnu packages python)) #:use-module (gnu packages python)
#:use-module (gnu packages man))
(define-public dmd (define-public dmd
(package (package
@ -158,13 +159,18 @@ re-executing them as necessary.")
version ".tar.gz")) version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"04wrm0v7l4890mmbaawd6wjwdv08bkglgqhpz0q4dkb0l50fl8q4")))) "04wrm0v7l4890mmbaawd6wjwdv08bkglgqhpz0q4dkb0l50fl8q4"))
(patches (list (search-patch "inetutils-syslogd.patch")))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments `(;; FIXME: `tftp.sh' relies on `netstat' from utils-linux, (arguments `(;; FIXME: `tftp.sh' relies on `netstat' from utils-linux,
;; which is currently missing. ;; which is currently missing.
#:tests? #f)) #:tests? #f))
(inputs `(("ncurses" ,ncurses) (inputs `(("ncurses" ,ncurses)
("readline" ,readline))) ; for 'ftp' ("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/") (home-page "http://www.gnu.org/software/inetutils/")
(synopsis "Basic networking utilities") (synopsis "Basic networking utilities")
(description (description

48
gnu/packages/gnome.scm
View File

@ -1739,6 +1739,54 @@ library.")
and the GLib main loop, to integrate well with GNOME applications.") and the GLib main loop, to integrate well with GNOME applications.")
(license license:lgpl2.0+))) (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 (define-public gnome-mines
(package (package
(name "gnome-mines") (name "gnome-mines")

648
gnu/packages/haskell.scm
View File

@ -18,12 +18,14 @@
(define-module (gnu packages haskell) (define-module (gnu packages haskell)
#:use-module (ice-9 regex) #:use-module (ice-9 regex)
#:use-module (guix licenses) #:use-module ((guix licenses) #:select (bsd-3))
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix download) #:use-module (guix download)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix build-system gnu) #:use-module (guix build-system gnu)
#:use-module (guix build-system haskell)
#:use-module (gnu packages perl) #:use-module (gnu packages perl)
#:use-module (gnu packages compression)
#:use-module (gnu packages elf) #:use-module (gnu packages elf)
#:use-module (gnu packages bootstrap) #:use-module (gnu packages bootstrap)
#:use-module (gnu packages ghostscript) #:use-module (gnu packages ghostscript)
@ -224,4 +226,648 @@
interactive environment for the functional language Haskell.") interactive environment for the functional language Haskell.")
(license bsd-3))) (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 ;;; haskell.scm ends here

7
gnu/packages/package-management.scm
View File

@ -142,7 +142,10 @@ the Nix package manager.")
(define guix-devel (define guix-devel
;; Development version of Guix. ;; 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) (package (inherit guix-0.8.1)
(version (string-append "0.8.1." commit)) (version (string-append "0.8.1." commit))
(source (origin (source (origin
@ -152,7 +155,7 @@ the Nix package manager.")
(commit commit))) (commit commit)))
(sha256 (sha256
(base32 (base32
"0dcmw8gz2qxknjnh9k8rdwmgysnxnvawdmlg1pyzngakwlsy1c3z")))) "0h9yyfxs14di858hb9ypjvdjryv8nzll6f9vxkggcy40iyhp65sh"))))
(arguments (arguments
(substitute-keyword-arguments (package-arguments guix-0.8.1) (substitute-keyword-arguments (package-arguments guix-0.8.1)
((#:phases phases) ((#:phases phases)

20
gnu/packages/patches/inetutils-syslogd.patch Normal file
View File

@ -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);)

44
guix/build/haskell-build-system.scm
View File

@ -70,26 +70,28 @@ and parameters ~s~%"
#:allow-other-keys) #:allow-other-keys)
"Configure a given Haskell package." "Configure a given Haskell package."
(let* ((out (assoc-ref outputs "out")) (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 (input-dirs (match inputs
(((_ . dir) ...) (((_ . dir) ...)
dir) dir)
(_ '()))) (_ '())))
(params (append `(,(string-append "--prefix=" out)) (params (append `(,(string-append "--prefix=" out))
`(,(string-append "--libdir=" (or lib out) "/lib"))
`(,(string-append "--bindir=" (or bin out) "/bin"))
`(,(string-append `(,(string-append
"--docdir=" out "/share/doc/" "--docdir=" (or doc out)
(package-name-version out))) "/share/doc/" (package-name-version out)))
'("--libsubdir=$compiler/$pkg-$version")
`(,(string-append "--package-db=" %tmp-db-dir)) `(,(string-append "--package-db=" %tmp-db-dir))
'("--global") '("--global")
`(,(string-append `(,@(map
"--extra-include-dirs=" (cut string-append "--extra-include-dirs=" <>)
(list->search-path-as-string (search-path-as-list '("include") input-dirs)))
(search-path-as-list '("include") input-dirs) `(,@(map
":"))) (cut string-append "--extra-lib-dirs=" <>)
`(,(string-append (search-path-as-list '("lib") input-dirs)))
"--extra-lib-dirs="
(list->search-path-as-string
(search-path-as-list '("lib") input-dirs)
":")))
(if tests? (if tests?
'("--enable-tests") '("--enable-tests")
'()) '())
@ -140,7 +142,7 @@ first match and return the content of the group."
dir) dir)
(_ '()))) (_ '())))
(conf-dirs (search-path-as-list (conf-dirs (search-path-as-list
`(,(string-append "lib/" system "-" `(,(string-append "lib/"
(package-name-version haskell) (package-name-version haskell)
"/package.conf.d")) "/package.conf.d"))
input-dirs)) input-dirs))
@ -160,8 +162,8 @@ generate the cache as it would clash in user profiles."
(let* ((out (assoc-ref outputs "out")) (let* ((out (assoc-ref outputs "out"))
(haskell (assoc-ref inputs "haskell")) (haskell (assoc-ref inputs "haskell"))
(lib (string-append out "/lib")) (lib (string-append out "/lib"))
(config-dir (string-append lib "/" system (config-dir (string-append lib "/"
"-" (package-name-version haskell) (package-name-version haskell)
"/package.conf.d")) "/package.conf.d"))
(id-rx (make-regexp "^id: *(.*)$")) (id-rx (make-regexp "^id: *(.*)$"))
(lib-rx (make-regexp "lib.*\\.(a|so)")) (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) (define* (haddock #:key outputs haddock? haddock-flags #:allow-other-keys)
"Run the test suite of a given Haskell package." "Run the test suite of a given Haskell package."
(if haddock? (if haddock?
(let* ((out (assoc-ref outputs "out")) (run-setuphs "haddock" haddock-flags)
(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))
#t)) #t))
(define %standard-phases (define %standard-phases
(modify-phases gnu:%standard-phases (modify-phases gnu:%standard-phases
(add-before configure setup-compiler setup-compiler) (add-before configure setup-compiler setup-compiler)
(add-after install haddock haddock) (add-before install haddock haddock)
(add-after install register register) (add-after install register register)
(replace install install) (replace install install)
(replace check check) (replace check check)

41
guix/http-client.scm
View File

@ -135,6 +135,47 @@ closed it will also close PORT, unless the KEEP-ALIVE? is true."
(when (module-variable %web-http 'read-chunk-body) (when (module-variable %web-http 'read-chunk-body)
(module-set! %web-http 'make-chunked-input-port make-chunked-input-port)) (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) (define (read-response-body* r)
"Reads the response body from @var{r}, as a bytevector. Returns "Reads the response body from @var{r}, as a bytevector. Returns
@code{#f} if there was no response body." @code{#f} if there was no response body."

767
guix/import/hackage.scm Normal file
View File

@ -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

60
guix/profiles.scm
View File

@ -404,6 +404,55 @@ MANIFEST."
(gexp->derivation "info-dir" build (gexp->derivation "info-dir" build
#:modules '((guix build utils))))) #: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) (define (ca-certificate-bundle manifest)
"Return a derivation that builds a single-file bundle containing the CA "Return a derivation that builds a single-file bundle containing the CA
certificates in the /etc/ssl/certs sub-directories of the packages in 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 (define* (profile-derivation manifest
#:key #:key
(info-dir? #t) (info-dir? #t)
(ghc-package-cache? #t)
(ca-certificate-bundle? #t)) (ca-certificate-bundle? #t))
"Return a derivation that builds a profile (aka. 'user environment') with "Return a derivation that builds a profile (aka. 'user environment') with
the given MANIFEST. The profile includes a top-level Info 'dir' file unless 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 INFO-DIR? is #f, a GHC 'package.cache' file unless GHC-PACKAGE-CACHE? is #f
CA-CERTIFICATE-BUNDLE? is #f." and a single-file CA certificate bundle unless CA-CERTIFICATE-BUNDLE? is #f."
(mlet %store-monad ((info-dir (if info-dir? (mlet %store-monad ((info-dir (if info-dir?
(info-dir-file manifest) (info-dir-file manifest)
(return #f))) (return #f)))
(ghc-package-cache (if ghc-package-cache?
(ghc-package-cache-file manifest)
(return #f)))
(ca-cert-bundle (if ca-certificate-bundle? (ca-cert-bundle (if ca-certificate-bundle?
(ca-certificate-bundle manifest) (ca-certificate-bundle manifest)
(return #f)))) (return #f))))
@ -480,6 +533,9 @@ CA-CERTIFICATE-BUNDLE? is #f."
(append (if info-dir (append (if info-dir
(list (gexp-input info-dir)) (list (gexp-input info-dir))
'()) '())
(if ghc-package-cache
(list (gexp-input ghc-package-cache))
'())
(if ca-cert-bundle (if ca-cert-bundle
(list (gexp-input ca-cert-bundle)) (list (gexp-input ca-cert-bundle))
'()) '())

2
guix/scripts/import.scm
View File

@ -73,7 +73,7 @@ rather than \\n."
;;; Entry point. ;;; Entry point.
;;; ;;;
(define importers '("gnu" "nix" "pypi" "cpan")) (define importers '("gnu" "nix" "pypi" "cpan" "hackage"))
(define (resolve-importer name) (define (resolve-importer name)
(let ((module (resolve-interface (let ((module (resolve-interface

106
guix/scripts/import/hackage.scm Normal file
View File

@ -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~%"))))))

1
guix/scripts/package.scm
View File

@ -838,6 +838,7 @@ more information.~%"))
(profile-derivation (profile-derivation
new new
#:info-dir? (not bootstrap?) #:info-dir? (not bootstrap?)
#:ghc-package-cache? (not bootstrap?)
#:ca-certificate-bundle? (not bootstrap?)))) #:ca-certificate-bundle? (not bootstrap?))))
(prof (derivation->output-path prof-drv))) (prof (derivation->output-path prof-drv)))
(show-manifest-transaction (%store) manifest transaction (show-manifest-transaction (%store) manifest transaction

1
po/guix/POTFILES.in
View File

@ -8,6 +8,7 @@ guix/scripts/download.scm
guix/scripts/package.scm guix/scripts/package.scm
guix/scripts/gc.scm guix/scripts/gc.scm
guix/scripts/hash.scm guix/scripts/hash.scm
guix/scripts/import.scm
guix/scripts/pull.scm guix/scripts/pull.scm
guix/scripts/substitute.scm guix/scripts/substitute.scm
guix/scripts/authenticate.scm guix/scripts/authenticate.scm

8
tests/guix-package-net.sh
View File

@ -37,6 +37,14 @@ shebang_too_long ()
-ge 128 -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-$$" profile="t-profile-$$"
rm -f "$profile" rm -f "$profile"

134
tests/hackage.scm Normal file
View File

@ -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))

1
tests/packages.scm
View File

@ -597,6 +597,7 @@
(manifest (map package->manifest-entry (manifest (map package->manifest-entry
(list p1 p2))) (list p1 p2)))
#:info-dir? #f #:info-dir? #f
#:ghc-package-cache? #f
#:ca-certificate-bundle? #f) #:ca-certificate-bundle? #f)
#:guile-for-build (%guile-for-build)))) #:guile-for-build (%guile-for-build))))
(build-derivations %store (list prof)) (build-derivations %store (list prof))

2
tests/profiles.scm
View File

@ -184,6 +184,7 @@
(guile (package->derivation %bootstrap-guile)) (guile (package->derivation %bootstrap-guile))
(drv (profile-derivation (manifest (list entry)) (drv (profile-derivation (manifest (list entry))
#:info-dir? #f #:info-dir? #f
#:ghc-package-cache? #f
#:ca-certificate-bundle? #f)) #:ca-certificate-bundle? #f))
(profile -> (derivation->output-path drv)) (profile -> (derivation->output-path drv))
(bindir -> (string-append profile "/bin")) (bindir -> (string-append profile "/bin"))
@ -197,6 +198,7 @@
((entry -> (package->manifest-entry packages:glibc "debug")) ((entry -> (package->manifest-entry packages:glibc "debug"))
(drv (profile-derivation (manifest (list entry)) (drv (profile-derivation (manifest (list entry))
#:info-dir? #f #:info-dir? #f
#:ghc-package-cache? #f
#:ca-certificate-bundle? #f))) #:ca-certificate-bundle? #f)))
(return (derivation-inputs drv)))) (return (derivation-inputs drv))))