Merge branch 'master' into core-updates
This commit is contained in:
Mark H Weaver
commit
2abf678682
|
|
@ -113,6 +113,8 @@ MODULES = \
|
||||||
guix/scripts/import/hackage.scm \
|
guix/scripts/import/hackage.scm \
|
||||||
guix/scripts/environment.scm \
|
guix/scripts/environment.scm \
|
||||||
guix/scripts/publish.scm \
|
guix/scripts/publish.scm \
|
||||||
|
guix/scripts/edit.scm \
|
||||||
|
guix/scripts/size.scm \
|
||||||
guix.scm \
|
guix.scm \
|
||||||
$(GNU_SYSTEM_MODULES)
|
$(GNU_SYSTEM_MODULES)
|
||||||
|
|
||||||
|
|
@ -191,7 +193,8 @@ SCM_TESTS = \
|
||||||
tests/syscalls.scm \
|
tests/syscalls.scm \
|
||||||
tests/gremlin.scm \
|
tests/gremlin.scm \
|
||||||
tests/lint.scm \
|
tests/lint.scm \
|
||||||
tests/publish.scm
|
tests/publish.scm \
|
||||||
|
tests/size.scm
|
||||||
|
|
||||||
if HAVE_GUILE_JSON
|
if HAVE_GUILE_JSON
|
||||||
|
|
||||||
|
|
@ -264,7 +267,6 @@ EXTRA_DIST = \
|
||||||
build-aux/check-available-binaries.scm \
|
build-aux/check-available-binaries.scm \
|
||||||
build-aux/check-final-inputs-self-contained.scm \
|
build-aux/check-final-inputs-self-contained.scm \
|
||||||
build-aux/download.scm \
|
build-aux/download.scm \
|
||||||
build-aux/list-packages.scm \
|
|
||||||
build-aux/make-binary-tarball.scm \
|
build-aux/make-binary-tarball.scm \
|
||||||
srfi/srfi-37.scm.in \
|
srfi/srfi-37.scm.in \
|
||||||
srfi/srfi-64.scm \
|
srfi/srfi-64.scm \
|
||||||
|
|
|
||||||
|
|
@ -22,22 +22,14 @@
|
||||||
;;; machine images that we build.
|
;;; machine images that we build.
|
||||||
;;;
|
;;;
|
||||||
|
|
||||||
(use-modules (gnu)
|
(use-modules (gnu))
|
||||||
|
(use-service-modules desktop xorg networking avahi)
|
||||||
(gnu packages xorg)
|
(use-package-modules linux xorg tor avahi)
|
||||||
(gnu packages avahi)
|
|
||||||
(gnu packages linux)
|
|
||||||
(gnu packages tor)
|
|
||||||
|
|
||||||
(gnu services networking)
|
|
||||||
(gnu services avahi)
|
|
||||||
(gnu services dbus)
|
|
||||||
(gnu services xorg))
|
|
||||||
|
|
||||||
(operating-system
|
(operating-system
|
||||||
(host-name "gnu")
|
(host-name "gnu")
|
||||||
(timezone "Europe/Paris")
|
(timezone "Europe/Paris")
|
||||||
(locale "en_US.utf8")
|
(locale "en_US.UTF-8")
|
||||||
|
|
||||||
(bootloader (grub-configuration
|
(bootloader (grub-configuration
|
||||||
(device "/dev/sda")))
|
(device "/dev/sda")))
|
||||||
|
|
|
||||||
|
|
@ -1,450 +0,0 @@
|
||||||
#!/bin/sh
|
|
||||||
exec guile -l "$0" \
|
|
||||||
-c '(apply (@ (list-packages) list-packages)
|
|
||||||
(cdr (command-line)))'
|
|
||||||
!#
|
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
|
||||||
;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
|
|
||||||
;;; Copyright © 2013 Alex Sassmannshausen <alex.sassmannshausen@gmail.com>
|
|
||||||
;;;
|
|
||||||
;;; 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 (list-packages)
|
|
||||||
#:use-module (guix utils)
|
|
||||||
#:use-module (guix packages)
|
|
||||||
#:use-module (guix licenses)
|
|
||||||
#:use-module (guix gnu-maintenance)
|
|
||||||
#:use-module ((guix download) #:select (%mirrors))
|
|
||||||
#:use-module ((guix build download) #:select (maybe-expand-mirrors))
|
|
||||||
#:use-module (gnu packages)
|
|
||||||
#:use-module (sxml simple)
|
|
||||||
#:use-module (sxml fold)
|
|
||||||
#:use-module (web uri)
|
|
||||||
#:use-module (ice-9 match)
|
|
||||||
#:use-module (srfi srfi-1)
|
|
||||||
#:export (list-packages))
|
|
||||||
|
|
||||||
;;; Commentary:
|
|
||||||
;;;
|
|
||||||
;;; Emit an HTML representation of the packages available in GNU Guix.
|
|
||||||
;;;
|
|
||||||
;;; Code:
|
|
||||||
|
|
||||||
(define lookup-gnu-package
|
|
||||||
(let ((gnu (official-gnu-packages)))
|
|
||||||
(lambda (name)
|
|
||||||
"Return the package description for GNU package NAME, or #f."
|
|
||||||
(find (lambda (package)
|
|
||||||
(equal? (gnu-package-name package) name))
|
|
||||||
gnu))))
|
|
||||||
|
|
||||||
(define (list-join lst item)
|
|
||||||
"Join the items in LST by inserting ITEM between each pair of elements."
|
|
||||||
(let loop ((lst lst)
|
|
||||||
(result '()))
|
|
||||||
(match lst
|
|
||||||
(()
|
|
||||||
(match (reverse result)
|
|
||||||
(()
|
|
||||||
'())
|
|
||||||
((_ rest ...)
|
|
||||||
rest)))
|
|
||||||
((head tail ...)
|
|
||||||
(loop tail
|
|
||||||
(cons* head item result))))))
|
|
||||||
|
|
||||||
(define (package->sxml package previous description-ids remaining)
|
|
||||||
"Return 3 values: the HTML-as-SXML for PACKAGE added to all previously
|
|
||||||
collected package output in PREVIOUS, a list of DESCRIPTION-IDS and the number
|
|
||||||
of packages still to be processed in REMAINING. Also Introduces a call to the
|
|
||||||
JavaScript prep_pkg_descs function as part of the output of PACKAGE, every
|
|
||||||
time the length of DESCRIPTION-IDS, increasing, is 15 or when REMAINING,
|
|
||||||
decreasing, is 1."
|
|
||||||
(define (location-url loc)
|
|
||||||
(string-append "http://git.savannah.gnu.org/cgit/guix.git/tree/"
|
|
||||||
(location-file loc) "#n"
|
|
||||||
(number->string (location-line loc))))
|
|
||||||
|
|
||||||
(define (source-url package)
|
|
||||||
(let ((loc (package-location package)))
|
|
||||||
(and loc (location-url loc))))
|
|
||||||
|
|
||||||
(define (license package)
|
|
||||||
(define ->sxml
|
|
||||||
(match-lambda
|
|
||||||
((lst ...)
|
|
||||||
`(div ,(map ->sxml lst)))
|
|
||||||
((? license? license)
|
|
||||||
(let ((uri (license-uri license)))
|
|
||||||
(case (and=> (and uri (string->uri uri)) uri-scheme)
|
|
||||||
((http https)
|
|
||||||
`(div (a (@ (href ,uri)
|
|
||||||
(title "Link to the full license"))
|
|
||||||
,(license-name license))))
|
|
||||||
(else
|
|
||||||
`(div ,(license-name license) " ("
|
|
||||||
,(license-comment license) ")")))))
|
|
||||||
(#f "")))
|
|
||||||
|
|
||||||
(->sxml (package-license package)))
|
|
||||||
|
|
||||||
(define (patches package)
|
|
||||||
(define patch-url
|
|
||||||
(match-lambda
|
|
||||||
((? string? patch)
|
|
||||||
(string-append
|
|
||||||
"http://git.savannah.gnu.org/cgit/guix.git/tree/gnu/packages/patches/"
|
|
||||||
(basename patch)))
|
|
||||||
((? origin? patch)
|
|
||||||
(uri->string
|
|
||||||
(first (maybe-expand-mirrors (string->uri
|
|
||||||
(match (origin-uri patch)
|
|
||||||
((? string? uri) uri)
|
|
||||||
((head . tail) head)))
|
|
||||||
%mirrors))))))
|
|
||||||
|
|
||||||
(define patch-name
|
|
||||||
(match-lambda
|
|
||||||
((? string? patch)
|
|
||||||
(basename patch))
|
|
||||||
((? origin? patch)
|
|
||||||
(match (origin-uri patch)
|
|
||||||
((? string? uri) (basename uri))
|
|
||||||
((head . tail) (basename head))))))
|
|
||||||
|
|
||||||
(define (snippet-link snippet)
|
|
||||||
(let ((loc (or (package-field-location package 'source)
|
|
||||||
(package-location package))))
|
|
||||||
`(a (@ (href ,(location-url loc))
|
|
||||||
(title "Link to patch snippet"))
|
|
||||||
"snippet")))
|
|
||||||
|
|
||||||
(and (origin? (package-source package))
|
|
||||||
(let ((patches (origin-patches (package-source package)))
|
|
||||||
(snippet (origin-snippet (package-source package))))
|
|
||||||
(and (or (pair? patches) snippet)
|
|
||||||
`(div "patches: "
|
|
||||||
,(let loop ((patches patches)
|
|
||||||
(number 1)
|
|
||||||
(links '()))
|
|
||||||
(match patches
|
|
||||||
(()
|
|
||||||
(let* ((additional (and snippet
|
|
||||||
(snippet-link snippet)))
|
|
||||||
(links (if additional
|
|
||||||
(cons additional links)
|
|
||||||
links)))
|
|
||||||
(list-join (reverse links) ", ")))
|
|
||||||
((patch rest ...)
|
|
||||||
(loop rest
|
|
||||||
(+ 1 number)
|
|
||||||
(cons `(a (@ (href ,(patch-url patch))
|
|
||||||
(title ,(string-append
|
|
||||||
"Link to "
|
|
||||||
(patch-name patch))))
|
|
||||||
,(number->string number))
|
|
||||||
links))))))))))
|
|
||||||
|
|
||||||
(define (status package)
|
|
||||||
(define (url system)
|
|
||||||
`(a (@ (href ,(string-append "http://hydra.gnu.org/job/gnu/master/"
|
|
||||||
(package-full-name package) "."
|
|
||||||
system))
|
|
||||||
(title "View the status of this architecture's build at Hydra"))
|
|
||||||
,system))
|
|
||||||
|
|
||||||
`(div "status: "
|
|
||||||
,(list-join (map url
|
|
||||||
(lset-intersection
|
|
||||||
string=?
|
|
||||||
%hydra-supported-systems
|
|
||||||
(package-transitive-supported-systems package)))
|
|
||||||
" ")))
|
|
||||||
|
|
||||||
(define (package-logo name)
|
|
||||||
(and=> (lookup-gnu-package name)
|
|
||||||
gnu-package-logo))
|
|
||||||
|
|
||||||
(define (insert-tr description-id js?)
|
|
||||||
(define (insert-js-call description-ids)
|
|
||||||
"Return an sxml call to prep_pkg_descs, with up to 15 elements of
|
|
||||||
description-ids as formal parameters."
|
|
||||||
`(script (@ (type "text/javascript"))
|
|
||||||
,(format #f "prep_pkg_descs(~a)"
|
|
||||||
(string-append "'"
|
|
||||||
(string-join description-ids "', '")
|
|
||||||
"'"))))
|
|
||||||
|
|
||||||
(let ((description-ids (cons description-id description-ids)))
|
|
||||||
`(tr (td ,(if (gnu-package? package)
|
|
||||||
`(img (@ (src "/graphics/gnu-head-mini.png")
|
|
||||||
(alt "Part of GNU")
|
|
||||||
(title "Part of GNU")))
|
|
||||||
""))
|
|
||||||
(td (a (@ (href ,(source-url package))
|
|
||||||
(title "Link to the Guix package source code"))
|
|
||||||
,(package-name package) " "
|
|
||||||
,(package-version package)))
|
|
||||||
(td (span ,(package-synopsis package))
|
|
||||||
(div (@ (id ,description-id))
|
|
||||||
,(match (package-logo (package-name package))
|
|
||||||
((? string? url)
|
|
||||||
`(img (@ (src ,url)
|
|
||||||
(height "35")
|
|
||||||
(class "package-logo")
|
|
||||||
(alt ("Logo of " ,(package-name package))))))
|
|
||||||
(_ #f))
|
|
||||||
(p ,(package-description package))
|
|
||||||
,(license package)
|
|
||||||
(a (@ (href ,(package-home-page package))
|
|
||||||
(title "Link to the package's website"))
|
|
||||||
,(package-home-page package))
|
|
||||||
,(status package)
|
|
||||||
,(patches package)
|
|
||||||
,(if js?
|
|
||||||
(insert-js-call description-ids)
|
|
||||||
""))))))
|
|
||||||
|
|
||||||
(let ((description-id (symbol->string
|
|
||||||
(gensym (package-name package)))))
|
|
||||||
(cond ((= remaining 1) ; Last package in packages
|
|
||||||
(values
|
|
||||||
(reverse ; Fold has reversed packages
|
|
||||||
(cons (insert-tr description-id 'js) ; Prefix final sxml
|
|
||||||
previous))
|
|
||||||
'() ; No more work to do
|
|
||||||
0)) ; End of the line
|
|
||||||
((= (length description-ids) 15) ; Time for a JS call
|
|
||||||
(values
|
|
||||||
(cons (insert-tr description-id 'js)
|
|
||||||
previous) ; Prefix new sxml
|
|
||||||
'() ; Reset description-ids
|
|
||||||
(1- remaining))) ; Reduce remaining
|
|
||||||
(else ; Insert another row, and build description-ids
|
|
||||||
(values
|
|
||||||
(cons (insert-tr description-id #f)
|
|
||||||
previous) ; Prefix new sxml
|
|
||||||
(cons description-id description-ids) ; Update description-ids
|
|
||||||
(1- remaining)))))) ; Reduce remaining
|
|
||||||
|
|
||||||
(define (packages->sxml packages)
|
|
||||||
"Return an HTML page as SXML describing PACKAGES."
|
|
||||||
`(div
|
|
||||||
(h2 "GNU Guix Package List")
|
|
||||||
(div (@ (id "intro"))
|
|
||||||
(div
|
|
||||||
(img (@ (src "graphics/GuixSD-V.png")
|
|
||||||
(alt "Guix System Distribution")
|
|
||||||
(height "83"))))
|
|
||||||
(p "This web page lists the packages currently provided by the "
|
|
||||||
(a (@ (href "manual/guix.html#GNU-Distribution"))
|
|
||||||
"Guix System Distribution")
|
|
||||||
". "
|
|
||||||
"Our " (a (@ (href "http://hydra.gnu.org/jobset/gnu/master"))
|
|
||||||
"continuous integration system")
|
|
||||||
" shows their current build status."))
|
|
||||||
(table (@ (id "packages"))
|
|
||||||
(tr (th "GNU?")
|
|
||||||
(th "Package version")
|
|
||||||
(th "Package details"))
|
|
||||||
,@(fold-values package->sxml packages '() '() (length packages)))
|
|
||||||
(a (@ (href "#intro")
|
|
||||||
(title "Back to top.")
|
|
||||||
(id "top"))
|
|
||||||
"^")))
|
|
||||||
|
|
||||||
|
|
||||||
(define (insert-css)
|
|
||||||
"Return the CSS for the list-packages page."
|
|
||||||
(format #t
|
|
||||||
"<style>
|
|
||||||
/* license: CC0 */
|
|
||||||
a {
|
|
||||||
transition: all 0.3s;
|
|
||||||
}
|
|
||||||
div#intro {
|
|
||||||
margin-bottom: 2em;
|
|
||||||
}
|
|
||||||
div#intro div, div#intro p {
|
|
||||||
padding:0.5em;
|
|
||||||
}
|
|
||||||
div#intro div {
|
|
||||||
float:left;
|
|
||||||
}
|
|
||||||
div#intro img {
|
|
||||||
float:left;
|
|
||||||
padding:0.75em;
|
|
||||||
}
|
|
||||||
table#packages, table#packages tr, table#packages tbody, table#packages td, table#packages th {
|
|
||||||
border: 0px solid black;
|
|
||||||
clear: both;
|
|
||||||
}
|
|
||||||
table#packages tr:nth-child(even) {
|
|
||||||
background-color: #FFF;
|
|
||||||
}
|
|
||||||
table#packages tr:nth-child(odd) {
|
|
||||||
background-color: #EEE;
|
|
||||||
}
|
|
||||||
table#packages tr:hover, table#packages tr:focus, table#packages tr:active {
|
|
||||||
background-color: #DDD;
|
|
||||||
}
|
|
||||||
table#packages tr:first-child, table#packages tr:first-child:hover, table#packages tr:first-child:focus, table#packages tr:first-child:active {
|
|
||||||
background-color: #333;
|
|
||||||
color: #fff;
|
|
||||||
}
|
|
||||||
table#packages td {
|
|
||||||
margin:0px;
|
|
||||||
padding:0.2em 0.5em;
|
|
||||||
}
|
|
||||||
table#packages td:first-child {
|
|
||||||
width:10%;
|
|
||||||
text-align:center;
|
|
||||||
}
|
|
||||||
table#packages td:nth-child(2) {
|
|
||||||
width:30%;
|
|
||||||
}
|
|
||||||
table#packages td:last-child {
|
|
||||||
width:60%;
|
|
||||||
}
|
|
||||||
img.package-logo {
|
|
||||||
float: left;
|
|
||||||
padding: 0.75em;
|
|
||||||
}
|
|
||||||
table#packages span {
|
|
||||||
font-weight: 700;
|
|
||||||
}
|
|
||||||
table#packages span a {
|
|
||||||
float: right;
|
|
||||||
font-weight: 500;
|
|
||||||
}
|
|
||||||
a#top {
|
|
||||||
position:fixed;
|
|
||||||
right:10px;
|
|
||||||
bottom:10px;
|
|
||||||
font-size:150%;
|
|
||||||
background-color:#EEE;
|
|
||||||
padding:10px 7.5px 0 7.5px;
|
|
||||||
text-decoration:none;
|
|
||||||
color:#000;
|
|
||||||
border-radius:5px;
|
|
||||||
}
|
|
||||||
a#top:hover, a#top:focus {
|
|
||||||
background-color:#333;
|
|
||||||
color:#fff;
|
|
||||||
}
|
|
||||||
</style>"))
|
|
||||||
|
|
||||||
(define (insert-js)
|
|
||||||
"Return the JavaScript for the list-packages page."
|
|
||||||
(format #t
|
|
||||||
"<script type=\"text/javascript\">
|
|
||||||
// license: CC0
|
|
||||||
function show_hide(idThing)
|
|
||||||
{
|
|
||||||
if(document.getElementById && document.createTextNode) {
|
|
||||||
var thing = document.getElementById(idThing);
|
|
||||||
/* Used to change the link text, depending on whether description is
|
|
||||||
collapsed or expanded */
|
|
||||||
var thingLink = thing.previousSibling.lastChild.firstChild;
|
|
||||||
if (thing) {
|
|
||||||
if (thing.style.display == \"none\") {
|
|
||||||
thing.style.display = \"\";
|
|
||||||
thingLink.data = 'Collapse';
|
|
||||||
} else {
|
|
||||||
thing.style.display = \"none\";
|
|
||||||
thingLink.data = 'Expand';
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
/* Add controllers used for collapse/expansion of package descriptions */
|
|
||||||
function prep(idThing)
|
|
||||||
{
|
|
||||||
var tdThing = document.getElementById(idThing).parentNode;
|
|
||||||
if (tdThing) {
|
|
||||||
var aThing = tdThing.firstChild.appendChild(document.createElement('a'));
|
|
||||||
aThing.setAttribute('href', 'javascript:void(0)');
|
|
||||||
aThing.setAttribute('title', 'show/hide package description');
|
|
||||||
aThing.appendChild(document.createTextNode('Expand'));
|
|
||||||
aThing.onclick=function(){show_hide(idThing);};
|
|
||||||
/* aThing.onkeypress=function(){show_hide(idThing);}; */
|
|
||||||
}
|
|
||||||
}
|
|
||||||
/* Take n element IDs, prepare them for javascript enhanced
|
|
||||||
display and hide the IDs by default. */
|
|
||||||
function prep_pkg_descs()
|
|
||||||
{
|
|
||||||
if(document.getElementById && document.createTextNode) {
|
|
||||||
for(var i=0; i<arguments.length; i++) {
|
|
||||||
prep(arguments[i])
|
|
||||||
show_hide(arguments[i]);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
</script>"))
|
|
||||||
|
|
||||||
|
|
||||||
(define (list-packages . args)
|
|
||||||
"Return an HTML page listing all the packages found in the GNU distribution,
|
|
||||||
with gnu.org server-side include and all that."
|
|
||||||
;; Don't attempt to translate descriptions.
|
|
||||||
(setlocale LC_ALL "C")
|
|
||||||
|
|
||||||
;; Output the page as UTF-8 since that's what the gnu.org server-side
|
|
||||||
;; headers claim.
|
|
||||||
(set-port-encoding! (current-output-port) "UTF-8")
|
|
||||||
|
|
||||||
(let ((packages (sort (fold-packages cons '())
|
|
||||||
(lambda (p1 p2)
|
|
||||||
(string<? (package-name p1) (package-name p2))))))
|
|
||||||
(format #t "<!--#include virtual=\"/server/html5-header.html\" -->
|
|
||||||
<!-- Parent-Version: 1.70 $ -->
|
|
||||||
<title>GNU Guix - GNU Distribution - GNU Project</title>
|
|
||||||
")
|
|
||||||
(insert-css)
|
|
||||||
(insert-js)
|
|
||||||
(format #t "<!--#include virtual=\"/server/banner.html\" -->")
|
|
||||||
|
|
||||||
(sxml->xml (packages->sxml packages))
|
|
||||||
(format #t "</div>
|
|
||||||
<!--#include virtual=\"/server/footer.html\" -->
|
|
||||||
<div id=\"footer\">
|
|
||||||
|
|
||||||
<p>Please send general FSF & GNU inquiries to
|
|
||||||
<a href=\"mailto:gnu@gnu.org\"><gnu@gnu.org></a>.
|
|
||||||
There are also <a href=\"/contact/\">other ways to contact</a>
|
|
||||||
the FSF. Broken links and other corrections or suggestions can be sent
|
|
||||||
to <a href=\"mailto:bug-guix@gnu.org\"><bug-guix@gnu.org></a>.</p>
|
|
||||||
|
|
||||||
<p>Copyright © 2013 Free Software Foundation, Inc.</p>
|
|
||||||
|
|
||||||
<p>This page is licensed under a <a rel=\"license\"
|
|
||||||
href=\"http://creativecommons.org/licenses/by-nd/3.0/us/\">Creative
|
|
||||||
Commons Attribution-NoDerivs 3.0 United States License</a>.</p>
|
|
||||||
|
|
||||||
<p>Updated:
|
|
||||||
<!-- timestamp start -->
|
|
||||||
$Date$
|
|
||||||
<!-- timestamp end -->
|
|
||||||
</p>
|
|
||||||
</div>
|
|
||||||
</div>
|
|
||||||
</body>
|
|
||||||
</html>
|
|
||||||
"))
|
|
||||||
)
|
|
||||||
|
|
||||||
;;; list-packages.scm ends here
|
|
||||||
10
doc.am
10
doc.am
|
|
@ -90,6 +90,7 @@ SUBCOMMANDS := \
|
||||||
archive \
|
archive \
|
||||||
build \
|
build \
|
||||||
download \
|
download \
|
||||||
|
edit \
|
||||||
environment \
|
environment \
|
||||||
gc \
|
gc \
|
||||||
hash \
|
hash \
|
||||||
|
|
@ -99,6 +100,7 @@ SUBCOMMANDS := \
|
||||||
publish \
|
publish \
|
||||||
pull \
|
pull \
|
||||||
refresh \
|
refresh \
|
||||||
|
size \
|
||||||
system
|
system
|
||||||
|
|
||||||
$(eval $(foreach subcommand,$(SUBCOMMANDS), \
|
$(eval $(foreach subcommand,$(SUBCOMMANDS), \
|
||||||
|
|
@ -106,5 +108,11 @@ $(eval $(foreach subcommand,$(SUBCOMMANDS), \
|
||||||
|
|
||||||
dist_man1_MANS = \
|
dist_man1_MANS = \
|
||||||
doc/guix.1 \
|
doc/guix.1 \
|
||||||
doc/guix-daemon.1 \
|
|
||||||
$(SUBCOMMANDS:%=doc/guix-%.1)
|
$(SUBCOMMANDS:%=doc/guix-%.1)
|
||||||
|
|
||||||
|
if BUILD_DAEMON
|
||||||
|
|
||||||
|
dist_man1_MANS += \
|
||||||
|
doc/guix-daemon.1
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
|
||||||
|
|
@ -203,14 +203,32 @@ standards, GNU Coding Standards}); you can check the commit history for
|
||||||
examples.
|
examples.
|
||||||
|
|
||||||
Before submitting a patch that adds or modifies a package definition,
|
Before submitting a patch that adds or modifies a package definition,
|
||||||
please run @code{guix lint @var{package}}, where @var{package} is the
|
please run through this check list:
|
||||||
|
|
||||||
|
@enumerate
|
||||||
|
@item
|
||||||
|
Run @code{guix lint @var{package}}, where @var{package} is the
|
||||||
name of the new or modified package, and fix any errors it reports
|
name of the new or modified package, and fix any errors it reports
|
||||||
(@pxref{Invoking guix lint}). In addition, please make sure the package
|
(@pxref{Invoking guix lint}).
|
||||||
builds on your platform, using @code{guix build @var{package}}. You may
|
|
||||||
also want to check that dependent package (if applicable) are not
|
@item
|
||||||
affected by the change; @code{guix refresh --list-dependent
|
Make sure the package builds on your platform, using @code{guix build
|
||||||
|
@var{package}}.
|
||||||
|
|
||||||
|
@item
|
||||||
|
Take a look at the profile reported by @command{guix size}
|
||||||
|
(@pxref{Invoking guix size}). This will allow you to notice references
|
||||||
|
to other packages unwillingly retained. It may also help determine
|
||||||
|
whether to split the package (@pxref{Packages with Multiple Outputs}),
|
||||||
|
and which optional dependencies should be used.
|
||||||
|
|
||||||
|
@item
|
||||||
|
For important changes, check that dependent package (if applicable) are
|
||||||
|
not affected by the change; @code{guix refresh --list-dependent
|
||||||
@var{package}} will help you do that (@pxref{Invoking guix refresh}).
|
@var{package}} will help you do that (@pxref{Invoking guix refresh}).
|
||||||
|
|
||||||
|
@end enumerate
|
||||||
|
|
||||||
When posting a patch to the mailing list, use @samp{[PATCH] @dots{}} as a
|
When posting a patch to the mailing list, use @samp{[PATCH] @dots{}} as a
|
||||||
subject. You may use your email client or the @command{git send-mail}
|
subject. You may use your email client or the @command{git send-mail}
|
||||||
command.
|
command.
|
||||||
|
|
|
||||||
109
doc/guix.texi
109
doc/guix.texi
|
|
@ -124,11 +124,13 @@ Defining Packages
|
||||||
Utilities
|
Utilities
|
||||||
|
|
||||||
* Invoking guix build:: Building packages from the command line.
|
* Invoking guix build:: Building packages from the command line.
|
||||||
|
* Invoking guix edit:: Editing package definitions.
|
||||||
* Invoking guix download:: Downloading a file and printing its hash.
|
* Invoking guix download:: Downloading a file and printing its hash.
|
||||||
* Invoking guix hash:: Computing the cryptographic hash of a file.
|
* Invoking guix hash:: Computing the cryptographic hash of a file.
|
||||||
* Invoking guix import:: Importing package definitions.
|
* Invoking guix import:: Importing package definitions.
|
||||||
* Invoking guix refresh:: Updating package definitions.
|
* Invoking guix refresh:: Updating package definitions.
|
||||||
* Invoking guix lint:: Finding errors in package definitions.
|
* Invoking guix lint:: Finding errors in package definitions.
|
||||||
|
* Invoking guix size:: Profiling disk usage.
|
||||||
* Invoking guix environment:: Setting up development environments.
|
* Invoking guix environment:: Setting up development environments.
|
||||||
* Invoking guix publish:: Sharing substitutes.
|
* Invoking guix publish:: Sharing substitutes.
|
||||||
|
|
||||||
|
|
@ -1494,7 +1496,8 @@ graphical user interfaces (GUIs). The former depend solely on the C
|
||||||
library, whereas the latter depend on Tcl/Tk and the underlying X
|
library, whereas the latter depend on Tcl/Tk and the underlying X
|
||||||
libraries. In this case, we leave the command-line tools in the default
|
libraries. In this case, we leave the command-line tools in the default
|
||||||
output, whereas the GUIs are in a separate output. This allows users
|
output, whereas the GUIs are in a separate output. This allows users
|
||||||
who do not need the GUIs to save space.
|
who do not need the GUIs to save space. The @command{guix size} command
|
||||||
|
can help find out about such situations (@pxref{Invoking guix size}).
|
||||||
|
|
||||||
There are several such multiple-output packages in the GNU distribution.
|
There are several such multiple-output packages in the GNU distribution.
|
||||||
Other conventional output names include @code{lib} for libraries and
|
Other conventional output names include @code{lib} for libraries and
|
||||||
|
|
@ -1574,11 +1577,15 @@ as arguments.
|
||||||
|
|
||||||
@item --requisites
|
@item --requisites
|
||||||
@itemx -R
|
@itemx -R
|
||||||
|
@cindex closure
|
||||||
List the requisites of the store files passed as arguments. Requisites
|
List the requisites of the store files passed as arguments. Requisites
|
||||||
include the store files themselves, their references, and the references
|
include the store files themselves, their references, and the references
|
||||||
of these, recursively. In other words, the returned list is the
|
of these, recursively. In other words, the returned list is the
|
||||||
@dfn{transitive closure} of the store files.
|
@dfn{transitive closure} of the store files.
|
||||||
|
|
||||||
|
@xref{Invoking guix size}, for a tool to profile the size of an
|
||||||
|
element's closure.
|
||||||
|
|
||||||
@end table
|
@end table
|
||||||
|
|
||||||
Lastly, the following options allow you to check the integrity of the
|
Lastly, the following options allow you to check the integrity of the
|
||||||
|
|
@ -1931,7 +1938,10 @@ unavailable to the build process, possibly leading to a build failure.
|
||||||
|
|
||||||
Once a package definition is in place, the
|
Once a package definition is in place, the
|
||||||
package may actually be built using the @code{guix build} command-line
|
package may actually be built using the @code{guix build} command-line
|
||||||
tool (@pxref{Invoking guix build}). @xref{Packaging Guidelines}, for
|
tool (@pxref{Invoking guix build}). You can easily jump back to the
|
||||||
|
package definition using the @command{guix edit} command
|
||||||
|
(@pxref{Invoking guix edit}).
|
||||||
|
@xref{Packaging Guidelines}, for
|
||||||
more information on how to test package definitions, and
|
more information on how to test package definitions, and
|
||||||
@ref{Invoking guix lint}, for information on how to check a definition
|
@ref{Invoking guix lint}, for information on how to check a definition
|
||||||
for style conformance.
|
for style conformance.
|
||||||
|
|
@ -3261,11 +3271,13 @@ programming interface of Guix in a convenient way.
|
||||||
|
|
||||||
@menu
|
@menu
|
||||||
* Invoking guix build:: Building packages from the command line.
|
* Invoking guix build:: Building packages from the command line.
|
||||||
|
* Invoking guix edit:: Editing package definitions.
|
||||||
* Invoking guix download:: Downloading a file and printing its hash.
|
* Invoking guix download:: Downloading a file and printing its hash.
|
||||||
* Invoking guix hash:: Computing the cryptographic hash of a file.
|
* Invoking guix hash:: Computing the cryptographic hash of a file.
|
||||||
* Invoking guix import:: Importing package definitions.
|
* Invoking guix import:: Importing package definitions.
|
||||||
* Invoking guix refresh:: Updating package definitions.
|
* Invoking guix refresh:: Updating package definitions.
|
||||||
* Invoking guix lint:: Finding errors in package definitions.
|
* Invoking guix lint:: Finding errors in package definitions.
|
||||||
|
* Invoking guix size:: Profiling disk usage.
|
||||||
* Invoking guix environment:: Setting up development environments.
|
* Invoking guix environment:: Setting up development environments.
|
||||||
* Invoking guix publish:: Sharing substitutes.
|
* Invoking guix publish:: Sharing substitutes.
|
||||||
@end menu
|
@end menu
|
||||||
|
|
@ -3548,6 +3560,28 @@ the parsed command-line options.
|
||||||
@end defvr
|
@end defvr
|
||||||
|
|
||||||
|
|
||||||
|
@node Invoking guix edit
|
||||||
|
@section Invoking @command{guix edit}
|
||||||
|
|
||||||
|
@cindex package definition, editing
|
||||||
|
So many packages, so many source files! The @command{guix edit} command
|
||||||
|
facilitates the life of packagers by pointing their editor at the source
|
||||||
|
file containing the definition of the specified packages. For instance:
|
||||||
|
|
||||||
|
@example
|
||||||
|
guix edit gcc-4.8 vim
|
||||||
|
@end example
|
||||||
|
|
||||||
|
@noindent
|
||||||
|
launches the program specified in the @code{EDITOR} environment variable
|
||||||
|
to edit the recipe of GCC@tie{}4.8.4 and that of Vim.
|
||||||
|
|
||||||
|
If you are using Emacs, note that the Emacs user interface provides
|
||||||
|
similar functionality in the ``package info'' buffers created by
|
||||||
|
@kbd{M-x guix-search-by-name} and similar commands (@pxref{Emacs
|
||||||
|
Commands}).
|
||||||
|
|
||||||
|
|
||||||
@node Invoking guix download
|
@node Invoking guix download
|
||||||
@section Invoking @command{guix download}
|
@section Invoking @command{guix download}
|
||||||
|
|
||||||
|
|
@ -3947,6 +3981,73 @@ and exit.
|
||||||
|
|
||||||
@end table
|
@end table
|
||||||
|
|
||||||
|
@node Invoking guix size
|
||||||
|
@section Invoking @command{guix size}
|
||||||
|
|
||||||
|
The @command{guix size} command helps package developers profile the
|
||||||
|
disk usage of packages. It is easy to overlook the impact of an
|
||||||
|
additional dependency added to a package, or the impact of using a
|
||||||
|
single output for a package that could easily be split (@pxref{Packages
|
||||||
|
with Multiple Outputs}). These are the typical issues that
|
||||||
|
@command{guix size} can highlight.
|
||||||
|
|
||||||
|
The command can be passed a package specification such as @code{gcc-4.8}
|
||||||
|
or @code{guile:debug}, or a file name in the store. Consider this
|
||||||
|
example:
|
||||||
|
|
||||||
|
@example
|
||||||
|
$ guix size coreutils
|
||||||
|
store item total self
|
||||||
|
/gnu/store/@dots{}-coreutils-8.23 70.0 13.9 19.8%
|
||||||
|
/gnu/store/@dots{}-gmp-6.0.0a 55.3 2.5 3.6%
|
||||||
|
/gnu/store/@dots{}-acl-2.2.52 53.7 0.5 0.7%
|
||||||
|
/gnu/store/@dots{}-attr-2.4.46 53.2 0.3 0.5%
|
||||||
|
/gnu/store/@dots{}-gcc-4.8.4-lib 52.9 15.7 22.4%
|
||||||
|
/gnu/store/@dots{}-glibc-2.21 37.2 37.2 53.1%
|
||||||
|
@end example
|
||||||
|
|
||||||
|
@cindex closure
|
||||||
|
The store items listed here constitute the @dfn{transitive closure} of
|
||||||
|
Coreutils---i.e., Coreutils and all its dependencies, recursively---as
|
||||||
|
would be returned by:
|
||||||
|
|
||||||
|
@example
|
||||||
|
$ guix gc -R /gnu/store/@dots{}-coreutils-8.23
|
||||||
|
@end example
|
||||||
|
|
||||||
|
Here the output shows 3 columns next to store items. The first column,
|
||||||
|
labeled ``total'', shows the size in mebibytes (MiB) of the closure of
|
||||||
|
the store item---that is, its own size plus the size of all its
|
||||||
|
dependencies. The next column, labeled ``self'', shows the size of the
|
||||||
|
item itself. The last column shows the ratio of the item's size to the
|
||||||
|
space occupied by all the items listed here.
|
||||||
|
|
||||||
|
In this example, we see that the closure of Coreutils weighs in at
|
||||||
|
70@tie{}MiB, half of which is taken by libc. (That libc represents a
|
||||||
|
large fraction of the closure is not a problem @i{per se} because it is
|
||||||
|
always available on the system anyway.)
|
||||||
|
|
||||||
|
When the package passed to @command{guix size} is available in the
|
||||||
|
store, @command{guix size} queries the daemon to determine its
|
||||||
|
dependencies, and measures its size in the store, similar to @command{du
|
||||||
|
-ms --apparent-size} (@pxref{du invocation,,, coreutils, GNU
|
||||||
|
Coreutils}).
|
||||||
|
|
||||||
|
When the given package is @emph{not} in the store, @command{guix size}
|
||||||
|
reports information based on information about the available substitutes
|
||||||
|
(@pxref{Substitutes}). This allows it to profile disk usage of store
|
||||||
|
items that are not even on disk, only available remotely.
|
||||||
|
|
||||||
|
A single option is available:
|
||||||
|
|
||||||
|
@table @option
|
||||||
|
|
||||||
|
@item --system=@var{system}
|
||||||
|
@itemx -s @var{system}
|
||||||
|
Consider packages for @var{system}---e.g., @code{x86_64-linux}.
|
||||||
|
|
||||||
|
@end table
|
||||||
|
|
||||||
@node Invoking guix environment
|
@node Invoking guix environment
|
||||||
@section Invoking @command{guix environment}
|
@section Invoking @command{guix environment}
|
||||||
|
|
||||||
|
|
@ -4606,8 +4707,8 @@ Linux @dfn{pluggable authentication module} (PAM) services.
|
||||||
List of string-valued G-expressions denoting setuid programs.
|
List of string-valued G-expressions denoting setuid programs.
|
||||||
@xref{Setuid Programs}.
|
@xref{Setuid Programs}.
|
||||||
|
|
||||||
@item @code{sudoers} (default: @var{%sudoers-specification})
|
@item @code{sudoers-file} (default: @var{%sudoers-specification})
|
||||||
@cindex sudoers
|
@cindex sudoers file
|
||||||
The contents of the @file{/etc/sudoers} file as a file-like object
|
The contents of the @file{/etc/sudoers} file as a file-like object
|
||||||
(@pxref{G-Expressions, @code{local-file} and @code{plain-file}}).
|
(@pxref{G-Expressions, @code{local-file} and @code{plain-file}}).
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -161,20 +161,27 @@ as created and modified at the Epoch."
|
||||||
(utime file 0 0 0 0))))
|
(utime file 0 0 0 0))))
|
||||||
(find-files directory "")))
|
(find-files directory "")))
|
||||||
|
|
||||||
(define (register-closure store closure)
|
(define* (register-closure store closure
|
||||||
|
#:key (deduplicate? #t))
|
||||||
"Register CLOSURE in STORE, where STORE is the directory name of the target
|
"Register CLOSURE in STORE, where STORE is the directory name of the target
|
||||||
store and CLOSURE is the name of a file containing a reference graph as used
|
store and CLOSURE is the name of a file containing a reference graph as used
|
||||||
by 'guix-register'. As a side effect, this resets timestamps on store files."
|
by 'guix-register'. As a side effect, this resets timestamps on store files
|
||||||
(let ((status (system* "guix-register" "--prefix" store
|
and, if DEDUPLICATE? is true, deduplicates files common to CLOSURE and the
|
||||||
closure)))
|
rest of STORE."
|
||||||
|
(let ((status (apply system* "guix-register" "--prefix" store
|
||||||
|
(append (if deduplicate? '() '("--no-deduplication"))
|
||||||
|
(list closure)))))
|
||||||
(unless (zero? status)
|
(unless (zero? status)
|
||||||
(error "failed to register store items" closure))))
|
(error "failed to register store items" closure))))
|
||||||
|
|
||||||
(define* (populate-single-profile-directory directory
|
(define* (populate-single-profile-directory directory
|
||||||
#:key profile closure)
|
#:key profile closure
|
||||||
|
deduplicate?)
|
||||||
"Populate DIRECTORY with a store containing PROFILE, whose closure is given
|
"Populate DIRECTORY with a store containing PROFILE, whose closure is given
|
||||||
in the file called CLOSURE (as generated by #:references-graphs.) DIRECTORY
|
in the file called CLOSURE (as generated by #:references-graphs.) DIRECTORY
|
||||||
is initialized to contain a single profile under /root pointing to PROFILE.
|
is initialized to contain a single profile under /root pointing to PROFILE.
|
||||||
|
DEDUPLICATE? determines whether to deduplicate files in the store.
|
||||||
|
|
||||||
This is used to create the self-contained Guix tarball."
|
This is used to create the self-contained Guix tarball."
|
||||||
(define (scope file)
|
(define (scope file)
|
||||||
(string-append directory "/" file))
|
(string-append directory "/" file))
|
||||||
|
|
@ -190,7 +197,8 @@ This is used to create the self-contained Guix tarball."
|
||||||
|
|
||||||
;; Populate the store.
|
;; Populate the store.
|
||||||
(populate-store (list closure) directory)
|
(populate-store (list closure) directory)
|
||||||
(register-closure (canonicalize-path directory) closure)
|
(register-closure (canonicalize-path directory) closure
|
||||||
|
#:deduplicate? deduplicate?)
|
||||||
|
|
||||||
;; XXX: 'guix-register' registers profiles as GC roots but the symlink
|
;; XXX: 'guix-register' registers profiles as GC roots but the symlink
|
||||||
;; target uses $TMPDIR. Fix that.
|
;; target uses $TMPDIR. Fix that.
|
||||||
|
|
|
||||||
|
|
@ -51,7 +51,8 @@
|
||||||
|
|
||||||
check-package-freshness
|
check-package-freshness
|
||||||
|
|
||||||
specification->package))
|
specification->package
|
||||||
|
specification->package+output))
|
||||||
|
|
||||||
;;; Commentary:
|
;;; Commentary:
|
||||||
;;;
|
;;;
|
||||||
|
|
@ -418,3 +419,36 @@ present, return the preferred newest version."
|
||||||
(leave (_ "~A: package not found for version ~a~%")
|
(leave (_ "~A: package not found for version ~a~%")
|
||||||
name version)
|
name version)
|
||||||
(leave (_ "~A: unknown package~%") name))))))
|
(leave (_ "~A: unknown package~%") name))))))
|
||||||
|
|
||||||
|
(define* (specification->package+output spec #:optional (output "out"))
|
||||||
|
"Return the package and output specified by SPEC, or #f and #f; SPEC may
|
||||||
|
optionally contain a version number and an output name, as in these examples:
|
||||||
|
|
||||||
|
guile
|
||||||
|
guile-2.0.9
|
||||||
|
guile:debug
|
||||||
|
guile-2.0.9:debug
|
||||||
|
|
||||||
|
If SPEC does not specify a version number, return the preferred newest
|
||||||
|
version; if SPEC does not specify an output, return OUTPUT."
|
||||||
|
(define (ensure-output p sub-drv)
|
||||||
|
(if (member sub-drv (package-outputs p))
|
||||||
|
sub-drv
|
||||||
|
(leave (_ "package `~a' lacks output `~a'~%")
|
||||||
|
(package-full-name p)
|
||||||
|
sub-drv)))
|
||||||
|
|
||||||
|
(let-values (((name version sub-drv)
|
||||||
|
(package-specification->name+version+output spec output)))
|
||||||
|
(match (find-best-packages-by-name name version)
|
||||||
|
((p)
|
||||||
|
(values p (ensure-output p sub-drv)))
|
||||||
|
((p p* ...)
|
||||||
|
(warning (_ "ambiguous package specification `~a'~%")
|
||||||
|
spec)
|
||||||
|
(warning (_ "choosing ~a from ~a~%")
|
||||||
|
(package-full-name p)
|
||||||
|
(location->string (package-location p)))
|
||||||
|
(values p (ensure-output p sub-drv)))
|
||||||
|
(()
|
||||||
|
(leave (_ "~a: package not found~%") spec)))))
|
||||||
|
|
|
||||||
|
|
@ -1,5 +1,6 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2014, 2015 Ricardo Wurmus <rekado@elephly.net>
|
;;; Copyright © 2014, 2015 Ricardo Wurmus <rekado@elephly.net>
|
||||||
|
;;; Copyright © 2015 Ben Woodcroft <donttrustben@gmail.com>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
|
@ -28,6 +29,7 @@
|
||||||
#:use-module (guix build-system python)
|
#:use-module (guix build-system python)
|
||||||
#:use-module (guix build-system trivial)
|
#:use-module (guix build-system trivial)
|
||||||
#:use-module (gnu packages)
|
#:use-module (gnu packages)
|
||||||
|
#:use-module (gnu packages algebra)
|
||||||
#:use-module (gnu packages base)
|
#:use-module (gnu packages base)
|
||||||
#:use-module (gnu packages boost)
|
#:use-module (gnu packages boost)
|
||||||
#:use-module (gnu packages compression)
|
#:use-module (gnu packages compression)
|
||||||
|
|
@ -87,7 +89,7 @@ BAM files.")
|
||||||
(define-public bedops
|
(define-public bedops
|
||||||
(package
|
(package
|
||||||
(name "bedops")
|
(name "bedops")
|
||||||
(version "2.4.5")
|
(version "2.4.14")
|
||||||
(source (origin
|
(source (origin
|
||||||
(method url-fetch)
|
(method url-fetch)
|
||||||
(uri (string-append "https://github.com/bedops/bedops/archive/v"
|
(uri (string-append "https://github.com/bedops/bedops/archive/v"
|
||||||
|
|
@ -95,7 +97,7 @@ BAM files.")
|
||||||
(file-name (string-append name "-" version ".tar.gz"))
|
(file-name (string-append name "-" version ".tar.gz"))
|
||||||
(sha256
|
(sha256
|
||||||
(base32
|
(base32
|
||||||
"0wmg6j0icimlrnsidaxrzf3hfgjvlkkcwvpdg7n4gg7hdv2m9ni5"))))
|
"1kqbac547wyqma81cyky9n7mkgikjpsfd3nnmcm6hpqwanqgh10v"))))
|
||||||
(build-system gnu-build-system)
|
(build-system gnu-build-system)
|
||||||
(arguments
|
(arguments
|
||||||
'(#:tests? #f
|
'(#:tests? #f
|
||||||
|
|
@ -615,6 +617,56 @@ file formats including SAM/BAM, Wiggle/BigWig, BED, GFF/GTF, VCF.")
|
||||||
other types of unwanted sequence from high-throughput sequencing reads.")
|
other types of unwanted sequence from high-throughput sequencing reads.")
|
||||||
(license license:expat)))
|
(license license:expat)))
|
||||||
|
|
||||||
|
(define-public diamond
|
||||||
|
(package
|
||||||
|
(name "diamond")
|
||||||
|
(version "0.7.9")
|
||||||
|
(source (origin
|
||||||
|
(method url-fetch)
|
||||||
|
(uri (string-append
|
||||||
|
"https://github.com/bbuchfink/diamond/archive/v"
|
||||||
|
version ".tar.gz"))
|
||||||
|
(file-name (string-append name "-" version ".tar.gz"))
|
||||||
|
(sha256
|
||||||
|
(base32
|
||||||
|
"0hfkcfv9f76h5brbyw9fyvmc0l9cmbsxrcdqk0fa9xv82zj47p15"))
|
||||||
|
(snippet '(begin
|
||||||
|
(delete-file "bin/diamond")
|
||||||
|
#t))))
|
||||||
|
(build-system gnu-build-system)
|
||||||
|
(arguments
|
||||||
|
'(#:tests? #f ;no "check" target
|
||||||
|
#:phases
|
||||||
|
(modify-phases %standard-phases
|
||||||
|
(add-after 'unpack 'enter-source-dir
|
||||||
|
(lambda _
|
||||||
|
(chdir "src")
|
||||||
|
#t))
|
||||||
|
(delete 'configure)
|
||||||
|
(replace 'install
|
||||||
|
(lambda* (#:key outputs #:allow-other-keys)
|
||||||
|
(let ((bin (string-append (assoc-ref outputs "out")
|
||||||
|
"/bin")))
|
||||||
|
(mkdir-p bin)
|
||||||
|
(copy-file "../bin/diamond"
|
||||||
|
(string-append bin "/diamond"))
|
||||||
|
#t))))))
|
||||||
|
(native-inputs
|
||||||
|
`(("bc" ,bc)))
|
||||||
|
(inputs
|
||||||
|
`(("boost" ,boost)
|
||||||
|
("zlib" ,zlib)))
|
||||||
|
(home-page "https://github.com/bbuchfink/diamond")
|
||||||
|
(synopsis "Accelerated BLAST compatible local sequence aligner")
|
||||||
|
(description
|
||||||
|
"DIAMOND is a BLAST-compatible local aligner for mapping protein and
|
||||||
|
translated DNA query sequences against a protein reference database (BLASTP
|
||||||
|
and BLASTX alignment mode). The speedup over BLAST is up to 20,000 on short
|
||||||
|
reads at a typical sensitivity of 90-99% relative to BLAST depending on the
|
||||||
|
data and settings.")
|
||||||
|
(license (license:non-copyleft "file://src/COPYING"
|
||||||
|
"See src/COPYING in the distribution."))))
|
||||||
|
|
||||||
(define-public edirect
|
(define-public edirect
|
||||||
(package
|
(package
|
||||||
(name "edirect")
|
(name "edirect")
|
||||||
|
|
@ -1063,7 +1115,7 @@ sequencing tag position and orientation.")
|
||||||
(source (origin
|
(source (origin
|
||||||
(method url-fetch)
|
(method url-fetch)
|
||||||
(uri (string-append
|
(uri (string-append
|
||||||
"http://pypi.python.org/packages/source/m/misopy/misopy-"
|
"https://pypi.python.org/packages/source/m/misopy/misopy-"
|
||||||
version ".tar.gz"))
|
version ".tar.gz"))
|
||||||
(sha256
|
(sha256
|
||||||
(base32
|
(base32
|
||||||
|
|
|
||||||
|
|
@ -60,7 +60,7 @@
|
||||||
(define-public calibre
|
(define-public calibre
|
||||||
(package
|
(package
|
||||||
(name "calibre")
|
(name "calibre")
|
||||||
(version "2.29.0")
|
(version "2.30.0")
|
||||||
(source
|
(source
|
||||||
(origin
|
(origin
|
||||||
(method url-fetch)
|
(method url-fetch)
|
||||||
|
|
@ -69,7 +69,7 @@
|
||||||
version ".tar.xz"))
|
version ".tar.xz"))
|
||||||
(sha256
|
(sha256
|
||||||
(base32
|
(base32
|
||||||
"1n3cfnjnghhhsgzcbcvbr0gh191lhl6az09q1s68jhlcc2lski6l"))
|
"1k2rpn06nfzqjy5k6fh8pwfj8vbhpn7rgkpkkpz5n2fqg3z8ph1j"))
|
||||||
;; Remove non-free or doubtful code, see
|
;; Remove non-free or doubtful code, see
|
||||||
;; https://lists.gnu.org/archive/html/guix-devel/2015-02/msg00478.html
|
;; https://lists.gnu.org/archive/html/guix-devel/2015-02/msg00478.html
|
||||||
(modules '((guix build utils)))
|
(modules '((guix build utils)))
|
||||||
|
|
|
||||||
|
|
@ -38,7 +38,9 @@
|
||||||
#:use-module (gnu packages docbook)
|
#:use-module (gnu packages docbook)
|
||||||
#:use-module (gnu packages glib) ;intltool
|
#:use-module (gnu packages glib) ;intltool
|
||||||
#:use-module (gnu packages xdisorg)
|
#:use-module (gnu packages xdisorg)
|
||||||
#:use-module (gnu packages xorg))
|
#:use-module (gnu packages xorg)
|
||||||
|
#:use-module (gnu packages doxygen)
|
||||||
|
#:use-module (gnu packages libffi))
|
||||||
|
|
||||||
(define-public xdg-utils
|
(define-public xdg-utils
|
||||||
(package
|
(package
|
||||||
|
|
@ -197,3 +199,36 @@ Python")
|
||||||
|
|
||||||
(define-public python2-pyxdg
|
(define-public python2-pyxdg
|
||||||
(package-with-python2 python-pyxdg))
|
(package-with-python2 python-pyxdg))
|
||||||
|
|
||||||
|
(define-public wayland
|
||||||
|
(package
|
||||||
|
(name "wayland")
|
||||||
|
(version "1.8.1")
|
||||||
|
(source (origin
|
||||||
|
(method url-fetch)
|
||||||
|
(uri (string-append "http://wayland.freedesktop.org/releases/"
|
||||||
|
name "-" version ".tar.xz"))
|
||||||
|
(sha256
|
||||||
|
(base32
|
||||||
|
"1j3gfzn8i0xhk3j34mwb2srrscjxfyi279jhyq80mz943j6r6z7i"))))
|
||||||
|
(build-system gnu-build-system)
|
||||||
|
(native-inputs
|
||||||
|
`(("doxygen" ,doxygen)
|
||||||
|
("pkg-config" ,pkg-config)
|
||||||
|
("xmlto" ,xmlto)
|
||||||
|
("xsltproc" ,libxslt)))
|
||||||
|
(inputs
|
||||||
|
`(("docbook-xml" ,docbook-xml)
|
||||||
|
("docbook-xsl" ,docbook-xsl)
|
||||||
|
("expat" ,expat)
|
||||||
|
("libffi" ,libffi)
|
||||||
|
("libxml2" ,libxml2))) ; for XML_CATALOG_FILES
|
||||||
|
(home-page "http://wayland.freedesktop.org/")
|
||||||
|
(synopsis "Display server protocol")
|
||||||
|
(description
|
||||||
|
"Wayland is a protocol for a compositor to talk to its clients as well as
|
||||||
|
a C library implementation of that protocol. The compositor can be a standalone
|
||||||
|
display server running on Linux kernel modesetting and evdev input devices, an X
|
||||||
|
application, or a wayland client itself. The clients can be traditional
|
||||||
|
applications, X servers (rootless or fullscreen) or other display servers.")
|
||||||
|
(license license:x11)))
|
||||||
|
|
|
||||||
|
|
@ -582,3 +582,26 @@ with lossy compression and typically provides 3x smaller file sizes compared
|
||||||
to PNG when lossy compression is acceptable for the red/green/blue color
|
to PNG when lossy compression is acceptable for the red/green/blue color
|
||||||
channels.")
|
channels.")
|
||||||
(license license:bsd-3)))
|
(license license:bsd-3)))
|
||||||
|
|
||||||
|
(define-public libmng
|
||||||
|
(package
|
||||||
|
(name "libmng")
|
||||||
|
(version "2.0.3")
|
||||||
|
(source (origin
|
||||||
|
(method url-fetch)
|
||||||
|
(uri (string-append "mirror://sourceforge/libmng/"
|
||||||
|
name "-" version ".tar.xz"))
|
||||||
|
(sha256
|
||||||
|
(base32
|
||||||
|
"1lvxnpds0vcf0lil6ia2036ghqlbl740c4d2sz0q5g6l93fjyija"))))
|
||||||
|
(build-system gnu-build-system)
|
||||||
|
(propagated-inputs
|
||||||
|
;; These are all in the 'Libs.private' field of libmng.pc.
|
||||||
|
`(("lcms" ,lcms)
|
||||||
|
("libjpeg" ,libjpeg)
|
||||||
|
("zlib" ,zlib)))
|
||||||
|
(home-page "http://www.libmng.com/")
|
||||||
|
(synopsis "Library for handling MNG files")
|
||||||
|
(description
|
||||||
|
"Libmng is the MNG (Multiple-image Network Graphics) reference library.")
|
||||||
|
(license license:bsd-3)))
|
||||||
|
|
|
||||||
|
|
@ -24,12 +24,12 @@
|
||||||
#:use-module (guix utils)
|
#:use-module (guix utils)
|
||||||
#:use-module (guix build-system gnu)
|
#:use-module (guix build-system gnu)
|
||||||
#:use-module (gnu packages)
|
#:use-module (gnu packages)
|
||||||
|
#:use-module (gnu packages gcc)
|
||||||
#:use-module (gnu packages base)
|
#:use-module (gnu packages base)
|
||||||
#:use-module (gnu packages emacs)
|
#:use-module (gnu packages emacs)
|
||||||
#:use-module (gnu packages texinfo)
|
#:use-module (gnu packages texinfo)
|
||||||
#:use-module (gnu packages pkg-config)
|
#:use-module (gnu packages pkg-config)
|
||||||
#:use-module (gnu packages compression)
|
#:use-module (gnu packages compression)
|
||||||
#:use-module (gnu packages commencement)
|
|
||||||
#:use-module (gnu packages xorg)
|
#:use-module (gnu packages xorg)
|
||||||
#:use-module (gnu packages texlive)
|
#:use-module (gnu packages texlive)
|
||||||
#:use-module (gnu packages perl)
|
#:use-module (gnu packages perl)
|
||||||
|
|
@ -57,8 +57,9 @@
|
||||||
("pkg-config" ,pkg-config)))
|
("pkg-config" ,pkg-config)))
|
||||||
(inputs
|
(inputs
|
||||||
`(("libx11" ,libx11)
|
`(("libx11" ,libx11)
|
||||||
("gcc:lib" ,gcc-final "lib") ; for libiberty, needed for objdump support
|
;; For libiberty, needed for objdump support.
|
||||||
("zlib" ,zlib))) ; also needed for objdump support
|
("gcc:lib" ,(canonical-package gcc-4.8) "lib")
|
||||||
|
("zlib" ,zlib))) ;also needed for objdump support
|
||||||
(arguments
|
(arguments
|
||||||
`(#:modules ((guix build gnu-build-system)
|
`(#:modules ((guix build gnu-build-system)
|
||||||
(guix build utils)
|
(guix build utils)
|
||||||
|
|
|
||||||
|
|
@ -166,7 +166,7 @@ the Nix package manager.")
|
||||||
;;
|
;;
|
||||||
;; Note: use a short commit id; when using the long one, the limit on socket
|
;; Note: use a short commit id; when using the long one, the limit on socket
|
||||||
;; file names is exceeded while running the tests.
|
;; file names is exceeded while running the tests.
|
||||||
(let ((commit "a43b55f"))
|
(let ((commit "684bf7c"))
|
||||||
(package (inherit guix-0.8.2)
|
(package (inherit guix-0.8.2)
|
||||||
(version (string-append "0.8.2." commit))
|
(version (string-append "0.8.2." commit))
|
||||||
(source (origin
|
(source (origin
|
||||||
|
|
@ -176,7 +176,7 @@ the Nix package manager.")
|
||||||
(commit commit)))
|
(commit commit)))
|
||||||
(sha256
|
(sha256
|
||||||
(base32
|
(base32
|
||||||
"1r0l8gfh5nxc1j0sqj8ywkg280k9qbj7zsk33z84rvl7l0nwnk88"))
|
"0fq9ajj17kbb0f1p79al2vcqah9sl0imayhggcp31c3vq0ahya9g"))
|
||||||
(file-name (string-append "guix-" version "-checkout"))))
|
(file-name (string-append "guix-" version "-checkout"))))
|
||||||
(arguments
|
(arguments
|
||||||
(substitute-keyword-arguments (package-arguments guix-0.8.2)
|
(substitute-keyword-arguments (package-arguments guix-0.8.2)
|
||||||
|
|
|
||||||
|
|
@ -29,6 +29,8 @@
|
||||||
#:use-module (gnu packages)
|
#:use-module (gnu packages)
|
||||||
#:use-module (gnu packages bison)
|
#:use-module (gnu packages bison)
|
||||||
#:use-module (gnu packages compression)
|
#:use-module (gnu packages compression)
|
||||||
|
#:use-module (gnu packages cups)
|
||||||
|
#:use-module (gnu packages databases)
|
||||||
#:use-module (gnu packages fontutils)
|
#:use-module (gnu packages fontutils)
|
||||||
#:use-module (gnu packages flex)
|
#:use-module (gnu packages flex)
|
||||||
#:use-module (gnu packages gl)
|
#:use-module (gnu packages gl)
|
||||||
|
|
@ -93,7 +95,7 @@ X11 (yet).")
|
||||||
(define-public qt
|
(define-public qt
|
||||||
(package
|
(package
|
||||||
(name "qt")
|
(name "qt")
|
||||||
(version "5.4.1")
|
(version "5.4.2")
|
||||||
(source (origin
|
(source (origin
|
||||||
(method url-fetch)
|
(method url-fetch)
|
||||||
(uri (string-append "http://download.qt-project.org/official_releases/qt/"
|
(uri (string-append "http://download.qt-project.org/official_releases/qt/"
|
||||||
|
|
@ -103,7 +105,7 @@ X11 (yet).")
|
||||||
version ".tar.xz"))
|
version ".tar.xz"))
|
||||||
(sha256
|
(sha256
|
||||||
(base32
|
(base32
|
||||||
"0q6qzakq8xihw91xv310qi3vyylq7x2bzdkjgy8sqxii2lgbjzhv"))
|
"09gay5cimfdb0apy60v7z4r4zkl2vjysdppzihpla8dp2c30fvcc"))
|
||||||
(patches (list (search-patch "qt5-conflicting-typedefs.patch")
|
(patches (list (search-patch "qt5-conflicting-typedefs.patch")
|
||||||
(search-patch "qt5-runpath.patch")))
|
(search-patch "qt5-runpath.patch")))
|
||||||
(snippet
|
(snippet
|
||||||
|
|
@ -119,12 +121,14 @@ webrtc/tools/e2e_quality/audio/perf")))))
|
||||||
(inputs
|
(inputs
|
||||||
`(("alsa-lib" ,alsa-lib)
|
`(("alsa-lib" ,alsa-lib)
|
||||||
("dbus" ,dbus)
|
("dbus" ,dbus)
|
||||||
|
("cups" ,cups)
|
||||||
("expat" ,expat)
|
("expat" ,expat)
|
||||||
("fontconfig" ,fontconfig)
|
("fontconfig" ,fontconfig)
|
||||||
("freetype" ,freetype)
|
("freetype" ,freetype)
|
||||||
("glib" ,glib)
|
("glib" ,glib)
|
||||||
("icu4c" ,icu4c)
|
("icu4c" ,icu4c)
|
||||||
("libjpeg" ,libjpeg)
|
("libjpeg" ,libjpeg)
|
||||||
|
("libmng" ,libmng)
|
||||||
("libpci" ,pciutils)
|
("libpci" ,pciutils)
|
||||||
("libpng" ,libpng)
|
("libpng" ,libpng)
|
||||||
("libx11" ,libx11)
|
("libx11" ,libx11)
|
||||||
|
|
@ -143,10 +147,12 @@ webrtc/tools/e2e_quality/audio/perf")))))
|
||||||
("mysql" ,mysql)
|
("mysql" ,mysql)
|
||||||
("nss" ,nss)
|
("nss" ,nss)
|
||||||
("openssl" ,openssl)
|
("openssl" ,openssl)
|
||||||
|
("postgresql" ,postgresql)
|
||||||
("pulseaudio" ,pulseaudio)
|
("pulseaudio" ,pulseaudio)
|
||||||
("pcre" ,pcre)
|
("pcre" ,pcre)
|
||||||
("sqlite" ,sqlite)
|
("sqlite" ,sqlite)
|
||||||
("udev" ,eudev)
|
("udev" ,eudev)
|
||||||
|
("unixodbc" ,unixodbc)
|
||||||
("xcb-util" ,xcb-util)
|
("xcb-util" ,xcb-util)
|
||||||
("xcb-util-image" ,xcb-util-image)
|
("xcb-util-image" ,xcb-util-image)
|
||||||
("xcb-util-keysyms" ,xcb-util-keysyms)
|
("xcb-util-keysyms" ,xcb-util-keysyms)
|
||||||
|
|
@ -221,7 +227,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
|
||||||
|
|
||||||
(define-public qt-4
|
(define-public qt-4
|
||||||
(package (inherit qt)
|
(package (inherit qt)
|
||||||
(version "4.8.6")
|
(version "4.8.7")
|
||||||
(source (origin
|
(source (origin
|
||||||
(method url-fetch)
|
(method url-fetch)
|
||||||
(uri (string-append "http://download.qt-project.org/official_releases/qt/"
|
(uri (string-append "http://download.qt-project.org/official_releases/qt/"
|
||||||
|
|
@ -231,7 +237,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
|
||||||
version ".tar.gz"))
|
version ".tar.gz"))
|
||||||
(sha256
|
(sha256
|
||||||
(base32
|
(base32
|
||||||
"0b036iqgmbbv37dgwwfihw3mihjbnw3kb5kaisdy0qi8nn8xs54b"))
|
"183fca7n7439nlhxyg1z7aky0izgbyll3iwakw4gwivy16aj5272"))
|
||||||
(patches (map search-patch
|
(patches (map search-patch
|
||||||
'("qt4-ldflags.patch" "qt4-tests.patch")))))
|
'("qt4-ldflags.patch" "qt4-tests.patch")))))
|
||||||
(inputs `(,@(alist-delete "libjpeg" (package-inputs qt))
|
(inputs `(,@(alist-delete "libjpeg" (package-inputs qt))
|
||||||
|
|
|
||||||
|
|
@ -168,14 +168,14 @@ Desktops into Active Directory environments using the winbind daemon.")
|
||||||
(define-public talloc
|
(define-public talloc
|
||||||
(package
|
(package
|
||||||
(name "talloc")
|
(name "talloc")
|
||||||
(version "2.1.0")
|
(version "2.1.2")
|
||||||
(source (origin
|
(source (origin
|
||||||
(method url-fetch)
|
(method url-fetch)
|
||||||
(uri (string-append "http://www.samba.org/ftp/talloc/talloc-"
|
(uri (string-append "https://www.samba.org/ftp/talloc/talloc-"
|
||||||
version ".tar.gz"))
|
version ".tar.gz"))
|
||||||
(sha256
|
(sha256
|
||||||
(base32
|
(base32
|
||||||
"13zh628hzlp2v9vj70knnfac2xbxqrdhgap30csq4zv4h8w3j087"))))
|
"13c365f7y8idjf2v1jxdjpkc3lxdmsxxfxjx1ymianm7zjiph393"))))
|
||||||
(build-system gnu-build-system)
|
(build-system gnu-build-system)
|
||||||
(arguments
|
(arguments
|
||||||
'(#:phases (alist-replace
|
'(#:phases (alist-replace
|
||||||
|
|
|
||||||
|
|
@ -1,6 +1,7 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2013, 2014, 2015 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>
|
||||||
|
;;; Copyright © 2015 Alex Kost <alezost@gmail.com>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
|
@ -148,8 +149,8 @@
|
||||||
(setuid-programs operating-system-setuid-programs
|
(setuid-programs operating-system-setuid-programs
|
||||||
(default %setuid-programs)) ; list of string-valued gexps
|
(default %setuid-programs)) ; list of string-valued gexps
|
||||||
|
|
||||||
(sudoers operating-system-sudoers ; file-like
|
(sudoers-file operating-system-sudoers-file ; file-like
|
||||||
(default %sudoers-specification)))
|
(default %sudoers-specification)))
|
||||||
|
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
|
|
@ -440,7 +441,7 @@ on SHELLS. /etc/shells is used by xterm, polkit, and other programs."
|
||||||
(pam-services '())
|
(pam-services '())
|
||||||
(profile "/run/current-system/profile")
|
(profile "/run/current-system/profile")
|
||||||
hosts-file nss (shells '())
|
hosts-file nss (shells '())
|
||||||
(sudoers (plain-file "sudoers" "")))
|
(sudoers-file (plain-file "sudoers" "")))
|
||||||
"Return a derivation that builds the static part of the /etc directory."
|
"Return a derivation that builds the static part of the /etc directory."
|
||||||
(mlet* %store-monad
|
(mlet* %store-monad
|
||||||
((pam.d (pam-services->directory pam-services))
|
((pam.d (pam-services->directory pam-services))
|
||||||
|
|
@ -540,7 +541,7 @@ fi\n"))
|
||||||
("hosts" ,#~#$hosts-file)
|
("hosts" ,#~#$hosts-file)
|
||||||
("localtime" ,#~(string-append #$tzdata "/share/zoneinfo/"
|
("localtime" ,#~(string-append #$tzdata "/share/zoneinfo/"
|
||||||
#$timezone))
|
#$timezone))
|
||||||
("sudoers" ,sudoers)))))
|
("sudoers" ,sudoers-file)))))
|
||||||
|
|
||||||
(define (operating-system-profile os)
|
(define (operating-system-profile os)
|
||||||
"Return a derivation that builds the system profile of OS."
|
"Return a derivation that builds the system profile of OS."
|
||||||
|
|
@ -624,9 +625,9 @@ use 'plain-file' instead~%")
|
||||||
#:timezone (operating-system-timezone os)
|
#:timezone (operating-system-timezone os)
|
||||||
#:hosts-file /etc/hosts
|
#:hosts-file /etc/hosts
|
||||||
#:shells shells
|
#:shells shells
|
||||||
#:sudoers (maybe-string->file
|
#:sudoers-file (maybe-string->file
|
||||||
"sudoers"
|
"sudoers"
|
||||||
(operating-system-sudoers os))
|
(operating-system-sudoers-file os))
|
||||||
#:profile profile-drv)))
|
#:profile profile-drv)))
|
||||||
|
|
||||||
(define %setuid-programs
|
(define %setuid-programs
|
||||||
|
|
|
||||||
|
|
@ -63,15 +63,19 @@ under /root/.guix-profile where GUIX is installed."
|
||||||
(setenv "PATH"
|
(setenv "PATH"
|
||||||
(string-append #$guix "/sbin:" #$tar "/bin:" #$xz "/bin"))
|
(string-append #$guix "/sbin:" #$tar "/bin:" #$xz "/bin"))
|
||||||
|
|
||||||
|
;; Note: there is not much to gain here with deduplication and there
|
||||||
|
;; is the overhead of the '.links' directory, so turn it off.
|
||||||
(populate-single-profile-directory %root
|
(populate-single-profile-directory %root
|
||||||
#:profile #$profile
|
#:profile #$profile
|
||||||
#:closure "profile")
|
#:closure "profile"
|
||||||
|
#:deduplicate? #f)
|
||||||
|
|
||||||
;; Create the tarball. Use GNU format so there's no file name
|
;; Create the tarball. Use GNU format so there's no file name
|
||||||
;; length limitation.
|
;; length limitation.
|
||||||
(with-directory-excursion %root
|
(with-directory-excursion %root
|
||||||
(zero? (system* "tar" "--xz" "--format=gnu"
|
(zero? (system* "tar" "--xz" "--format=gnu"
|
||||||
"--owner=root:0" "--group=root:0"
|
"--owner=root:0" "--group=root:0"
|
||||||
|
"--check-links"
|
||||||
"-cvf" #$output
|
"-cvf" #$output
|
||||||
;; Avoid adding / and /var to the tarball,
|
;; Avoid adding / and /var to the tarball,
|
||||||
;; so that the ownership and permissions of those
|
;; so that the ownership and permissions of those
|
||||||
|
|
|
||||||
|
|
@ -192,15 +192,22 @@ network to check in GNU's database."
|
||||||
;; Definitely non-GNU.
|
;; Definitely non-GNU.
|
||||||
'non-gnu)))))
|
'non-gnu)))))
|
||||||
|
|
||||||
(let ((url (and=> (package-source package) origin-uri))
|
(define (gnu-home-page? package)
|
||||||
(name (package-name package)))
|
(and=> (package-home-page package)
|
||||||
(case (and (string? url) (mirror-type url))
|
(lambda (url)
|
||||||
((gnu) #t)
|
(and=> (uri-host (string->uri url))
|
||||||
((non-gnu) #f)
|
(lambda (host)
|
||||||
(else
|
(member host '("www.gnu.org" "gnu.org")))))))
|
||||||
;; Last resort: resort to the network.
|
|
||||||
(and (member name (map gnu-package-name (official-gnu-packages)))
|
(or (gnu-home-page? package)
|
||||||
#t))))))))
|
(let ((url (and=> (package-source package) origin-uri))
|
||||||
|
(name (package-name package)))
|
||||||
|
(case (and (string? url) (mirror-type url))
|
||||||
|
((gnu) #t)
|
||||||
|
((non-gnu) #f)
|
||||||
|
(else
|
||||||
|
(and (member name (map gnu-package-name (official-gnu-packages)))
|
||||||
|
#t)))))))))
|
||||||
|
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
|
|
|
||||||
|
|
@ -27,6 +27,8 @@
|
||||||
#:use-module (guix ui)
|
#:use-module (guix ui)
|
||||||
#:use-module (guix pki)
|
#:use-module (guix pki)
|
||||||
#:use-module (guix pk-crypto)
|
#:use-module (guix pk-crypto)
|
||||||
|
#:use-module (guix scripts build)
|
||||||
|
#:use-module (gnu packages)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
#:use-module (ice-9 format)
|
#:use-module (ice-9 format)
|
||||||
#:use-module (ice-9 rdelim)
|
#:use-module (ice-9 rdelim)
|
||||||
|
|
@ -34,8 +36,6 @@
|
||||||
#:use-module (srfi srfi-11)
|
#:use-module (srfi srfi-11)
|
||||||
#:use-module (srfi srfi-26)
|
#:use-module (srfi srfi-26)
|
||||||
#:use-module (srfi srfi-37)
|
#:use-module (srfi srfi-37)
|
||||||
#:use-module (guix scripts build)
|
|
||||||
#:use-module (guix scripts package)
|
|
||||||
#:use-module (rnrs io ports)
|
#:use-module (rnrs io ports)
|
||||||
#:export (guix-archive))
|
#:export (guix-archive))
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -0,0 +1,79 @@
|
||||||
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
|
;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
|
||||||
|
;;;
|
||||||
|
;;; This file is part of GNU Guix.
|
||||||
|
;;;
|
||||||
|
;;; GNU Guix is free software; you can redistribute it and/or modify it
|
||||||
|
;;; under the terms of the GNU General Public License as published by
|
||||||
|
;;; the Free Software Foundation; either version 3 of the License, or (at
|
||||||
|
;;; your option) any later version.
|
||||||
|
;;;
|
||||||
|
;;; GNU Guix is distributed in the hope that it will be useful, but
|
||||||
|
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
;;; GNU General Public License for more details.
|
||||||
|
;;;
|
||||||
|
;;; You should have received a copy of the GNU General Public License
|
||||||
|
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
(define-module (guix scripts edit)
|
||||||
|
#:use-module (guix ui)
|
||||||
|
#:use-module (guix utils)
|
||||||
|
#:use-module (guix packages)
|
||||||
|
#:use-module (gnu packages)
|
||||||
|
#:use-module (srfi srfi-1)
|
||||||
|
#:use-module (srfi srfi-37)
|
||||||
|
#:export (%editor
|
||||||
|
guix-edit))
|
||||||
|
|
||||||
|
(define %options
|
||||||
|
(list (option '(#\h "help") #f #f
|
||||||
|
(lambda args
|
||||||
|
(show-help)
|
||||||
|
(exit 0)))
|
||||||
|
(option '(#\V "version") #f #f
|
||||||
|
(lambda args
|
||||||
|
(show-version-and-exit "guix edit")))))
|
||||||
|
|
||||||
|
(define (show-help)
|
||||||
|
(display (_ "Usage: guix edit PACKAGE...
|
||||||
|
Start $EDITOR to edit the definitions of PACKAGE...\n"))
|
||||||
|
(newline)
|
||||||
|
(display (_ "
|
||||||
|
-h, --help display this help and exit"))
|
||||||
|
(display (_ "
|
||||||
|
-V, --version display version information and exit"))
|
||||||
|
(newline)
|
||||||
|
(show-bug-report-information))
|
||||||
|
|
||||||
|
(define %editor
|
||||||
|
(make-parameter (or (getenv "EDITOR") "emacsclient")))
|
||||||
|
|
||||||
|
(define (search-path* path file)
|
||||||
|
"Like 'search-path' but exit if FILE is not found."
|
||||||
|
(let ((absolute-file-name (search-path path file)))
|
||||||
|
(unless absolute-file-name
|
||||||
|
;; Shouldn't happen unless somebody fiddled with the 'location' field.
|
||||||
|
(leave (_ "file '~a' not found in search path ~s~%")
|
||||||
|
file path))
|
||||||
|
absolute-file-name))
|
||||||
|
|
||||||
|
|
||||||
|
(define (guix-edit . args)
|
||||||
|
(with-error-handling
|
||||||
|
(let* ((specs (parse-command-line args %options '(())
|
||||||
|
#:argument-handler cons))
|
||||||
|
(packages (map specification->package specs)))
|
||||||
|
(for-each (lambda (package)
|
||||||
|
(unless (package-location package)
|
||||||
|
(leave (_ "source location of package '~a' is unknown~%")
|
||||||
|
(package-full-name package))))
|
||||||
|
packages)
|
||||||
|
(apply execlp (%editor) (%editor)
|
||||||
|
(append-map (lambda (package)
|
||||||
|
(let ((loc (package-location package)))
|
||||||
|
(list (string-append "+"
|
||||||
|
(number->string
|
||||||
|
(location-line loc)))
|
||||||
|
(search-path* %load-path (location-file loc)))))
|
||||||
|
packages)))))
|
||||||
|
|
@ -606,9 +606,7 @@ defines a total order on machines.)"
|
||||||
((machine1 slot1)
|
((machine1 slot1)
|
||||||
(match b
|
(match b
|
||||||
((machine2 slot2)
|
((machine2 slot2)
|
||||||
(if (pred machine1 machine2)
|
(pred machine1 machine2)))))))
|
||||||
(list machine1 slot1)
|
|
||||||
(list machine2 slot2))))))))
|
|
||||||
|
|
||||||
(let loop ((machines+slots
|
(let loop ((machines+slots
|
||||||
(sort machines+slots
|
(sort machines+slots
|
||||||
|
|
|
||||||
|
|
@ -47,8 +47,7 @@
|
||||||
#:use-module (gnu packages base)
|
#:use-module (gnu packages base)
|
||||||
#:use-module (gnu packages guile)
|
#:use-module (gnu packages guile)
|
||||||
#:use-module ((gnu packages bootstrap) #:select (%bootstrap-guile))
|
#:use-module ((gnu packages bootstrap) #:select (%bootstrap-guile))
|
||||||
#:export (specification->package+output
|
#:export (switch-to-generation
|
||||||
switch-to-generation
|
|
||||||
switch-to-previous-generation
|
switch-to-previous-generation
|
||||||
roll-back
|
roll-back
|
||||||
delete-generation
|
delete-generation
|
||||||
|
|
@ -324,39 +323,6 @@ similar."
|
||||||
(primitive-_exit 0)
|
(primitive-_exit 0)
|
||||||
(apply throw args)))))
|
(apply throw args)))))
|
||||||
|
|
||||||
(define* (specification->package+output spec #:optional (output "out"))
|
|
||||||
"Return the package and output specified by SPEC, or #f and #f; SPEC may
|
|
||||||
optionally contain a version number and an output name, as in these examples:
|
|
||||||
|
|
||||||
guile
|
|
||||||
guile-2.0.9
|
|
||||||
guile:debug
|
|
||||||
guile-2.0.9:debug
|
|
||||||
|
|
||||||
If SPEC does not specify a version number, return the preferred newest
|
|
||||||
version; if SPEC does not specify an output, return OUTPUT."
|
|
||||||
(define (ensure-output p sub-drv)
|
|
||||||
(if (member sub-drv (package-outputs p))
|
|
||||||
sub-drv
|
|
||||||
(leave (_ "package `~a' lacks output `~a'~%")
|
|
||||||
(package-full-name p)
|
|
||||||
sub-drv)))
|
|
||||||
|
|
||||||
(let-values (((name version sub-drv)
|
|
||||||
(package-specification->name+version+output spec output)))
|
|
||||||
(match (find-best-packages-by-name name version)
|
|
||||||
((p)
|
|
||||||
(values p (ensure-output p sub-drv)))
|
|
||||||
((p p* ...)
|
|
||||||
(warning (_ "ambiguous package specification `~a'~%")
|
|
||||||
spec)
|
|
||||||
(warning (_ "choosing ~a from ~a~%")
|
|
||||||
(package-full-name p)
|
|
||||||
(location->string (package-location p)))
|
|
||||||
(values p (ensure-output p sub-drv)))
|
|
||||||
(()
|
|
||||||
(leave (_ "~a: package not found~%") spec)))))
|
|
||||||
|
|
||||||
(define (upgradeable? name current-version current-path)
|
(define (upgradeable? name current-version current-path)
|
||||||
"Return #t if there's a version of package NAME newer than CURRENT-VERSION,
|
"Return #t if there's a version of package NAME newer than CURRENT-VERSION,
|
||||||
or if the newest available version is equal to CURRENT-VERSION but would have
|
or if the newest available version is equal to CURRENT-VERSION but would have
|
||||||
|
|
|
||||||
|
|
@ -0,0 +1,247 @@
|
||||||
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
|
;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
|
||||||
|
;;;
|
||||||
|
;;; This file is part of GNU Guix.
|
||||||
|
;;;
|
||||||
|
;;; GNU Guix is free software; you can redistribute it and/or modify it
|
||||||
|
;;; under the terms of the GNU General Public License as published by
|
||||||
|
;;; the Free Software Foundation; either version 3 of the License, or (at
|
||||||
|
;;; your option) any later version.
|
||||||
|
;;;
|
||||||
|
;;; GNU Guix is distributed in the hope that it will be useful, but
|
||||||
|
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
;;; GNU General Public License for more details.
|
||||||
|
;;;
|
||||||
|
;;; You should have received a copy of the GNU General Public License
|
||||||
|
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
(define-module (guix scripts size)
|
||||||
|
#:use-module (guix ui)
|
||||||
|
#:use-module (guix store)
|
||||||
|
#:use-module (guix monads)
|
||||||
|
#:use-module (guix utils)
|
||||||
|
#:use-module (guix packages)
|
||||||
|
#:use-module (guix derivations)
|
||||||
|
#:use-module (gnu packages)
|
||||||
|
#:use-module (srfi srfi-1)
|
||||||
|
#:use-module (srfi srfi-9)
|
||||||
|
#:use-module (srfi srfi-11)
|
||||||
|
#:use-module (srfi srfi-34)
|
||||||
|
#:use-module (srfi srfi-37)
|
||||||
|
#:use-module (ice-9 ftw)
|
||||||
|
#:use-module (ice-9 match)
|
||||||
|
#:use-module (ice-9 format)
|
||||||
|
#:export (profile?
|
||||||
|
profile-file
|
||||||
|
profile-self-size
|
||||||
|
profile-closure-size
|
||||||
|
store-profile
|
||||||
|
|
||||||
|
guix-size))
|
||||||
|
|
||||||
|
;; Size profile of a store item.
|
||||||
|
(define-record-type <profile>
|
||||||
|
(profile file self-size closure-size)
|
||||||
|
profile?
|
||||||
|
(file profile-file) ;store item
|
||||||
|
(self-size profile-self-size) ;size in bytes
|
||||||
|
(closure-size profile-closure-size)) ;size of dependencies in bytes
|
||||||
|
|
||||||
|
(define (file-size file)
|
||||||
|
"Return the size of bytes of FILE, entering it if FILE is a directory."
|
||||||
|
(file-system-fold (const #t)
|
||||||
|
(lambda (file stat result) ;leaf
|
||||||
|
(+ (stat:size stat) result))
|
||||||
|
(lambda (directory stat result) ;down
|
||||||
|
(+ (stat:size stat) result))
|
||||||
|
(lambda (directory stat result) ;up
|
||||||
|
result)
|
||||||
|
(lambda (file stat result) ;skip
|
||||||
|
result)
|
||||||
|
(lambda (file stat errno result)
|
||||||
|
(format (current-error-port)
|
||||||
|
"file-size: ~a: ~a~%" file
|
||||||
|
(strerror errno))
|
||||||
|
result)
|
||||||
|
0
|
||||||
|
file
|
||||||
|
lstat))
|
||||||
|
|
||||||
|
(define substitutable-path-info*
|
||||||
|
(store-lift substitutable-path-info))
|
||||||
|
|
||||||
|
(define (store-item-exists? item)
|
||||||
|
"Return #t if ITEM is in the store, and protect it from GC. Otherwise
|
||||||
|
return #f."
|
||||||
|
(lambda (store)
|
||||||
|
(add-temp-root store item)
|
||||||
|
(values (valid-path? store item) store)))
|
||||||
|
|
||||||
|
(define (file-size* item)
|
||||||
|
"Like 'file-size', but resort to information from substitutes if ITEM is not
|
||||||
|
in the store."
|
||||||
|
(mlet %store-monad ((exists? (store-item-exists? item)))
|
||||||
|
(if exists?
|
||||||
|
(return (file-size item))
|
||||||
|
(mlet %store-monad ((info (substitutable-path-info* (list item))))
|
||||||
|
(match info
|
||||||
|
((info)
|
||||||
|
;; The nar size is an approximation, but a good one.
|
||||||
|
(return (substitutable-nar-size info)))
|
||||||
|
(()
|
||||||
|
(leave (_ "no available substitute information for '~a'~%")
|
||||||
|
item)))))))
|
||||||
|
|
||||||
|
(define* (display-profile profile #:optional (port (current-output-port)))
|
||||||
|
"Display PROFILE, a list of PROFILE objects, to PORT."
|
||||||
|
(define MiB (expt 2 20))
|
||||||
|
|
||||||
|
(format port "~64a ~8a ~a\n"
|
||||||
|
(_ "store item") (_ "total") (_ "self"))
|
||||||
|
(let ((whole (reduce + 0 (map profile-self-size profile))))
|
||||||
|
(for-each (match-lambda
|
||||||
|
(($ <profile> name self total)
|
||||||
|
(format port "~64a ~6,1f ~6,1f ~5,1f%\n"
|
||||||
|
name (/ total MiB) (/ self MiB)
|
||||||
|
(* 100. (/ self whole 1.)))))
|
||||||
|
(sort profile
|
||||||
|
(match-lambda*
|
||||||
|
((($ <profile> _ _ total1) ($ <profile> _ _ total2))
|
||||||
|
(> total1 total2)))))))
|
||||||
|
|
||||||
|
(define display-profile*
|
||||||
|
(lift display-profile %store-monad))
|
||||||
|
|
||||||
|
(define (substitutable-requisites store item)
|
||||||
|
"Return the list of requisites of ITEM based on information available in
|
||||||
|
substitutes."
|
||||||
|
(let loop ((items (list item))
|
||||||
|
(result '()))
|
||||||
|
(match items
|
||||||
|
(()
|
||||||
|
(delete-duplicates result))
|
||||||
|
(items
|
||||||
|
(let ((info (substitutable-path-info store
|
||||||
|
(delete-duplicates items))))
|
||||||
|
(loop (remove (lambda (item) ;XXX: complexity
|
||||||
|
(member item result))
|
||||||
|
(append-map substitutable-references info))
|
||||||
|
(append (append-map substitutable-references info)
|
||||||
|
result)))))))
|
||||||
|
|
||||||
|
(define (requisites* item)
|
||||||
|
"Return as a monadic value the requisites of ITEMS, based either on the
|
||||||
|
information available in the local store or using information about
|
||||||
|
substitutes."
|
||||||
|
(lambda (store)
|
||||||
|
(guard (c ((nix-protocol-error? c)
|
||||||
|
(values (substitutable-requisites store item)
|
||||||
|
store)))
|
||||||
|
(values (requisites store item) store))))
|
||||||
|
|
||||||
|
(define (store-profile item)
|
||||||
|
"Return as a monadic value a list of <profile> objects representing the
|
||||||
|
profile of ITEM and its requisites."
|
||||||
|
(mlet* %store-monad ((refs (>>= (requisites* item)
|
||||||
|
(lambda (refs)
|
||||||
|
(return (delete-duplicates
|
||||||
|
(cons item refs))))))
|
||||||
|
(sizes (mapm %store-monad
|
||||||
|
(lambda (item)
|
||||||
|
(>>= (file-size* item)
|
||||||
|
(lambda (size)
|
||||||
|
(return (cons item size)))))
|
||||||
|
refs)))
|
||||||
|
(define (dependency-size item)
|
||||||
|
(mlet %store-monad ((deps (requisites* item)))
|
||||||
|
(foldm %store-monad
|
||||||
|
(lambda (item total)
|
||||||
|
(return (+ (assoc-ref sizes item) total)))
|
||||||
|
0
|
||||||
|
(delete-duplicates (cons item deps)))))
|
||||||
|
|
||||||
|
(mapm %store-monad
|
||||||
|
(match-lambda
|
||||||
|
((item . size)
|
||||||
|
(mlet %store-monad ((dependencies (dependency-size item)))
|
||||||
|
(return (profile item size dependencies)))))
|
||||||
|
sizes)))
|
||||||
|
|
||||||
|
(define* (ensure-store-item spec-or-item
|
||||||
|
#:key dry-run?)
|
||||||
|
"Return a store file name. If SPEC-OR-ITEM is a store file name, return it
|
||||||
|
as is. Otherwise, assume SPEC-OR-ITEM is a package output specification such
|
||||||
|
as \"guile:debug\" or \"gcc-4.8\" and return its store file name."
|
||||||
|
(with-monad %store-monad
|
||||||
|
(if (store-path? spec-or-item)
|
||||||
|
(return spec-or-item)
|
||||||
|
(let-values (((package output)
|
||||||
|
(specification->package+output spec-or-item)))
|
||||||
|
(mlet %store-monad ((drv (package->derivation package)))
|
||||||
|
;; Note: we don't try building DRV like 'guix archive' does
|
||||||
|
;; because we don't have to since we can instead rely on
|
||||||
|
;; substitute meta-data.
|
||||||
|
(return (derivation->output-path drv output)))))))
|
||||||
|
|
||||||
|
|
||||||
|
;;;
|
||||||
|
;;; Options.
|
||||||
|
;;;
|
||||||
|
|
||||||
|
(define (show-help)
|
||||||
|
(display (_ "Usage: guix size [OPTION]... PACKAGE
|
||||||
|
Report the size of PACKAGE and its dependencies.\n"))
|
||||||
|
(display (_ "
|
||||||
|
-s, --system=SYSTEM consider packages for SYSTEM--e.g., \"i686-linux\""))
|
||||||
|
(newline)
|
||||||
|
(display (_ "
|
||||||
|
-h, --help display this help and exit"))
|
||||||
|
(display (_ "
|
||||||
|
-V, --version display version information and exit"))
|
||||||
|
(newline)
|
||||||
|
(show-bug-report-information))
|
||||||
|
|
||||||
|
(define %options
|
||||||
|
;; Specifications of the command-line options.
|
||||||
|
(list (option '(#\s "system") #t #f
|
||||||
|
(lambda (opt name arg result)
|
||||||
|
(alist-cons 'system arg
|
||||||
|
(alist-delete 'system result eq?))))
|
||||||
|
(option '(#\h "help") #f #f
|
||||||
|
(lambda args
|
||||||
|
(show-help)
|
||||||
|
(exit 0)))
|
||||||
|
(option '(#\V "version") #f #f
|
||||||
|
(lambda args
|
||||||
|
(show-version-and-exit "guix size")))))
|
||||||
|
|
||||||
|
(define %default-options
|
||||||
|
`((system . ,(%current-system))))
|
||||||
|
|
||||||
|
|
||||||
|
;;;
|
||||||
|
;;; Entry point.
|
||||||
|
;;;
|
||||||
|
|
||||||
|
(define (guix-size . args)
|
||||||
|
(with-error-handling
|
||||||
|
(let* ((opts (parse-command-line args %options (list %default-options)))
|
||||||
|
(files (filter-map (match-lambda
|
||||||
|
(('argument . file) file)
|
||||||
|
(_ #f))
|
||||||
|
opts))
|
||||||
|
(system (assoc-ref opts 'system))
|
||||||
|
(dry-run? (assoc-ref opts 'dry-run?)))
|
||||||
|
(match files
|
||||||
|
(()
|
||||||
|
(leave (_ "missing store item argument\n")))
|
||||||
|
((file)
|
||||||
|
(with-store store
|
||||||
|
(run-with-store store
|
||||||
|
(mlet* %store-monad ((item (ensure-store-item file))
|
||||||
|
(profile (store-profile item)))
|
||||||
|
(display-profile* profile))
|
||||||
|
#:system system)))
|
||||||
|
((files ...)
|
||||||
|
(leave (_ "too many arguments\n")))))))
|
||||||
|
|
@ -16,6 +16,8 @@ guix/scripts/authenticate.scm
|
||||||
guix/scripts/system.scm
|
guix/scripts/system.scm
|
||||||
guix/scripts/lint.scm
|
guix/scripts/lint.scm
|
||||||
guix/scripts/publish.scm
|
guix/scripts/publish.scm
|
||||||
|
guix/scripts/edit.scm
|
||||||
|
guix/scripts/size.scm
|
||||||
guix/gnu-maintenance.scm
|
guix/gnu-maintenance.scm
|
||||||
guix/ui.scm
|
guix/ui.scm
|
||||||
guix/http-client.scm
|
guix/http-client.scm
|
||||||
|
|
|
||||||
|
|
@ -0,0 +1,87 @@
|
||||||
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
|
;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
|
||||||
|
;;;
|
||||||
|
;;; This file is part of GNU Guix.
|
||||||
|
;;;
|
||||||
|
;;; GNU Guix is free software; you can redistribute it and/or modify it
|
||||||
|
;;; under the terms of the GNU General Public License as published by
|
||||||
|
;;; the Free Software Foundation; either version 3 of the License, or (at
|
||||||
|
;;; your option) any later version.
|
||||||
|
;;;
|
||||||
|
;;; GNU Guix is distributed in the hope that it will be useful, but
|
||||||
|
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
;;; GNU General Public License for more details.
|
||||||
|
;;;
|
||||||
|
;;; You should have received a copy of the GNU General Public License
|
||||||
|
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
(define-module (test-size)
|
||||||
|
#:use-module (guix store)
|
||||||
|
#:use-module (guix monads)
|
||||||
|
#:use-module (guix packages)
|
||||||
|
#:use-module (guix derivations)
|
||||||
|
#:use-module (guix gexp)
|
||||||
|
#:use-module (guix tests)
|
||||||
|
#:use-module (guix scripts size)
|
||||||
|
#:use-module (gnu packages bootstrap)
|
||||||
|
#:use-module (ice-9 match)
|
||||||
|
#:use-module (srfi srfi-1)
|
||||||
|
#:use-module (srfi srfi-64))
|
||||||
|
|
||||||
|
(define %store
|
||||||
|
(open-connection-for-tests))
|
||||||
|
|
||||||
|
(define-syntax-rule (test-assertm name exp)
|
||||||
|
(test-assert name
|
||||||
|
(run-with-store %store exp
|
||||||
|
#:guile-for-build (%guile-for-build))))
|
||||||
|
|
||||||
|
|
||||||
|
(test-begin "size")
|
||||||
|
|
||||||
|
(test-assertm "store-profile"
|
||||||
|
(mlet* %store-monad ((file1 (gexp->derivation "file1"
|
||||||
|
#~(symlink #$%bootstrap-guile
|
||||||
|
#$output)))
|
||||||
|
(file2 (text-file* "file2"
|
||||||
|
"the file => " file1)))
|
||||||
|
(define (matching-profile item)
|
||||||
|
(lambda (profile)
|
||||||
|
(string=? item (profile-file profile))))
|
||||||
|
|
||||||
|
(mbegin %store-monad
|
||||||
|
(built-derivations (list file2))
|
||||||
|
(mlet %store-monad ((profiles (store-profile
|
||||||
|
(derivation->output-path file2)))
|
||||||
|
(guile (package->derivation %bootstrap-guile)))
|
||||||
|
(define (lookup-profile drv)
|
||||||
|
(find (matching-profile (derivation->output-path drv))
|
||||||
|
profiles))
|
||||||
|
|
||||||
|
(letrec-syntax ((match* (syntax-rules (=>)
|
||||||
|
((_ ((drv => profile) rest ...) body)
|
||||||
|
(match (lookup-profile drv)
|
||||||
|
((? profile? profile)
|
||||||
|
(match* (rest ...) body))))
|
||||||
|
((_ () body)
|
||||||
|
body))))
|
||||||
|
;; Make sure we get all three profiles with sensible values.
|
||||||
|
(return (and (= (length profiles) 3)
|
||||||
|
(match* ((file1 => profile1)
|
||||||
|
(file2 => profile2)
|
||||||
|
(guile => profile3))
|
||||||
|
(and (> (profile-closure-size profile2) 0)
|
||||||
|
(= (profile-closure-size profile2)
|
||||||
|
(+ (profile-self-size profile1)
|
||||||
|
(profile-self-size profile2)
|
||||||
|
(profile-self-size profile3))))))))))))
|
||||||
|
|
||||||
|
(test-end "size")
|
||||||
|
|
||||||
|
|
||||||
|
(exit (= (test-runner-fail-count (test-runner-current)) 0))
|
||||||
|
|
||||||
|
;;; Local Variables:
|
||||||
|
;;; eval: (put 'match* 'scheme-indent-function 1)
|
||||||
|
;;; End:
|
||||||
Loading…
Reference in New Issue