Add a declarative packaging layer.
* Makefile.am (MODULES): Add `guix/packages.scm' and `distro/base.scm'. (TESTS): Add `tests/packages.scm'. (EXTRA_DIST): New variable. * guix/packages.scm, distro/base.scm, tests/packages.scm: New files. * guix/http.scm (http-fetch): Make `name' an optional argument, to match the expectations of `package-source-derivation'.
This commit is contained in:
		
							parent
							
								
									e1e8874ee8
								
							
						
					
					
						commit
						e3ce5d709f
					
				
					 5 changed files with 235 additions and 3 deletions
				
			
		|  | @ -26,7 +26,9 @@ MODULES =					\ | |||
|   guix/build/gnu-build-system.scm		\ | ||||
|   guix/build/http.scm				\ | ||||
|   guix/build/utils.scm				\ | ||||
|   guix.scm | ||||
|   guix/packages.scm				\ | ||||
|   guix.scm					\ | ||||
|   distro/base.scm | ||||
| 
 | ||||
| GOBJECTS = $(MODULES:%.scm=%.go) | ||||
| 
 | ||||
|  | @ -36,13 +38,15 @@ nobase_nodist_guilemodule_DATA = $(GOBJECTS) | |||
| TESTS =						\ | ||||
|   tests/builders.scm				\ | ||||
|   tests/derivations.scm				\ | ||||
|   tests/utils.scm | ||||
|   tests/utils.scm				\ | ||||
|   tests/packages.scm | ||||
| 
 | ||||
| TESTS_ENVIRONMENT =							\ | ||||
|   NIXPKGS="$(NIXPKGS)"							\ | ||||
|   GUILE_LOAD_COMPILED_PATH="$(top_builddir):$$GUILE_LOAD_COMPILED_PATH"	\ | ||||
|   $(GUILE) -L "$(top_srcdir)" | ||||
| 
 | ||||
| EXTRA_DIST = $(TESTS) | ||||
| CLEANFILES = $(GOBJECTS) *.log | ||||
| 
 | ||||
| .scm.go: | ||||
|  |  | |||
							
								
								
									
										49
									
								
								distro/base.scm
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										49
									
								
								distro/base.scm
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,49 @@ | |||
| ;;; Guix --- Nix package management from Guile.         -*- coding: utf-8 -*- | ||||
| ;;; Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org> | ||||
| ;;; | ||||
| ;;; This file is part of Guix. | ||||
| ;;; | ||||
| ;;; 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. | ||||
| ;;; | ||||
| ;;; 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 Guix.  If not, see <http://www.gnu.org/licenses/>. | ||||
| 
 | ||||
| (define-module (distro base) | ||||
|   #:use-module (guix packages) | ||||
|   #:use-module (guix http) | ||||
|   #:use-module (guix build-system gnu) | ||||
|   #:use-module (guix utils)) | ||||
| 
 | ||||
| ;;; Commentary: | ||||
| ;;; | ||||
| ;;; A Guix-based distribution. | ||||
| ;;; | ||||
| ;;; Code: | ||||
| 
 | ||||
| (define-public hello | ||||
|   (package | ||||
|    (name "hello") | ||||
|    (version "2.8") | ||||
|    (source (source | ||||
|             (method http-fetch) | ||||
|             (uri "http://ftp.gnu.org/gnu/hello/hello-2.8.tar.gz") | ||||
|             (sha256 | ||||
|              (nix-base32-string->bytevector  ; TODO: make conversion implicit | ||||
|               "0wqd8sjmxfskrflaxywc7gqw7sfawrfvdxd9skxawzfgyy0pzdz6")))) | ||||
|    (build-system gnu-build-system) | ||||
|    (arguments '(#:configure-flags | ||||
|                 `("--disable-dependency-tracking" | ||||
|                   ,(string-append "--with-gawk="  ; for illustration purposes | ||||
|                                  (assoc-ref %build-inputs "gawk"))))) | ||||
|    (inputs `(("gawk" ,(nixpkgs-derivation "gawk")))) | ||||
|    (description "GNU Hello") | ||||
|    (long-description "Yeah...") | ||||
|    (license "GPLv3+"))) | ||||
|  | @ -28,7 +28,8 @@ | |||
| ;;; Code: | ||||
| 
 | ||||
| (define* (http-fetch store url hash-algo hash | ||||
|                      #:key name (system (%current-system))) | ||||
|                      #:optional name | ||||
|                      #:key (system (%current-system))) | ||||
|   "Return the path of a fixed-output derivation in STORE that fetches URL, | ||||
| which is expected to have hash HASH of type HASH-ALGO (a symbol).  By | ||||
| default, the file name is the base name of URL; optionally, NAME can specify | ||||
|  |  | |||
							
								
								
									
										127
									
								
								guix/packages.scm
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										127
									
								
								guix/packages.scm
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,127 @@ | |||
| ;;; Guix --- Nix package management from Guile.         -*- coding: utf-8 -*- | ||||
| ;;; Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org> | ||||
| ;;; | ||||
| ;;; This file is part of Guix. | ||||
| ;;; | ||||
| ;;; 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. | ||||
| ;;; | ||||
| ;;; 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 Guix.  If not, see <http://www.gnu.org/licenses/>. | ||||
| 
 | ||||
| (define-module (guix packages) | ||||
|   #:use-module (guix utils) | ||||
|   #:use-module (guix store) | ||||
|   #:use-module (guix build-system) | ||||
|   #:use-module (ice-9 match) | ||||
|   #:export (source | ||||
|             package-source? | ||||
|             package-source-uri | ||||
|             package-source-method | ||||
|             package-source-sha256 | ||||
|             package-source-file-name | ||||
| 
 | ||||
|             package | ||||
|             package? | ||||
|             package-name | ||||
|             package-version | ||||
|             package-source | ||||
|             package-build-system | ||||
|             package-arguments | ||||
|             package-inputs | ||||
|             package-native-inputs | ||||
|             package-outputs | ||||
|             package-search-paths | ||||
|             package-description | ||||
|             package-long-description | ||||
|             package-license | ||||
|             package-platforms | ||||
|             package-maintainers | ||||
| 
 | ||||
|             package-source-derivation | ||||
|             package-derivation | ||||
|             package-cross-derivation)) | ||||
| 
 | ||||
| ;;; Commentary: | ||||
| ;;; | ||||
| ;;; This module provides a high-level mechanism to define packages in a | ||||
| ;;; Guix-based distribution. | ||||
| ;;; | ||||
| ;;; Code: | ||||
| 
 | ||||
| (define-record-type* <package-source> | ||||
|   source make-package-source | ||||
|   package-source? | ||||
|   (uri       package-source-uri)                     ; string | ||||
|   (method    package-source-method)                  ; symbol | ||||
|   (sha256    package-source-sha256)                  ; bytevector | ||||
|   (file-name package-source-file-name                ; optional file name | ||||
|              (default #f))) | ||||
| 
 | ||||
| (define-record-type* <package> | ||||
|   package make-package | ||||
|   package? | ||||
|   (name   package-name)                   ; string | ||||
|   (version package-version)               ; string | ||||
|   (source package-source)                 ; <package-source> instance | ||||
|   (build-system package-build-system)     ; build system | ||||
|   (arguments package-arguments)           ; arguments for the build method | ||||
|   (inputs package-inputs                  ; input packages or derivations | ||||
|           (default '())) | ||||
|   (native-inputs package-native-inputs    ; native input packages/derivations | ||||
|                  (default '())) | ||||
|   (outputs package-outputs                ; list of strings | ||||
|            (default '("out"))) | ||||
|   (search-paths package-search-paths      ; list of (ENV-VAR (DIRS ...)) | ||||
|                 (default '()))            ; tuples; see | ||||
|                                           ; `set-path-environment-variable' | ||||
|                                           ; (aka. "setup-hook") | ||||
| 
 | ||||
|   (description package-description)       ; one-line description | ||||
|   (long-description package-long-description)     ; one or two paragraphs | ||||
|   (license package-license (default '())) | ||||
|   (platforms package-platforms (default '())) | ||||
|   (maintainers package-maintainers (default '()))) | ||||
| 
 | ||||
| (define (package-source-derivation store source) | ||||
|   "Return the derivation path for SOURCE, a package source." | ||||
|   (match source | ||||
|     (($ <package-source> uri method sha256 name) | ||||
|      (method store uri 'sha256 sha256 name)))) | ||||
| 
 | ||||
| (define* (package-derivation store package | ||||
|                              #:optional (system (%current-system))) | ||||
|   "Return the derivation of PACKAGE for SYSTEM." | ||||
|   (match package | ||||
|     (($ <package> name version source (= build-system-builder builder) | ||||
|         args inputs native-inputs outputs) | ||||
|      ;; TODO: For `search-paths', add a builder prologue that calls | ||||
|      ;; `set-path-environment-variable'. | ||||
|      (let ((inputs (map (match-lambda | ||||
|                          (((? string? name) (and package ($ <package>))) | ||||
|                           (list name (package-derivation store package))) | ||||
|                          (((? string? name) (and package ($ <package>)) | ||||
|                            (? string? sub-drv)) | ||||
|                           (list name (package-derivation store package) | ||||
|                                 sub-drv)) | ||||
|                          (((? string? name) | ||||
|                            (and (? string?) (? derivation-path?) drv)) | ||||
|                           (list name drv))) | ||||
|                         (append native-inputs inputs)))) | ||||
|        (apply builder | ||||
|               store (string-append name "-" version) | ||||
|               (package-source-derivation store source) | ||||
|               inputs | ||||
|               #:outputs outputs #:system system | ||||
|               args))))) | ||||
| 
 | ||||
| (define* (package-cross-derivation store package) | ||||
|   ;; TODO | ||||
|   #f) | ||||
							
								
								
									
										51
									
								
								tests/packages.scm
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										51
									
								
								tests/packages.scm
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,51 @@ | |||
| ;;; Guix --- Nix package management from Guile.         -*- coding: utf-8 -*- | ||||
| ;;; Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org> | ||||
| ;;; | ||||
| ;;; This file is part of Guix. | ||||
| ;;; | ||||
| ;;; 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. | ||||
| ;;; | ||||
| ;;; 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 Guix.  If not, see <http://www.gnu.org/licenses/>. | ||||
| 
 | ||||
| 
 | ||||
| (define-module (test-packages) | ||||
|   #:use-module (guix store) | ||||
|   #:use-module (guix utils) | ||||
|   #:use-module (guix derivations) | ||||
|   #:use-module (guix packages) | ||||
|   #:use-module (distro base) | ||||
|   #:use-module (srfi srfi-64)) | ||||
| 
 | ||||
| ;; Test the high-level packaging layer. | ||||
| 
 | ||||
| (define %store | ||||
|   (false-if-exception (open-connection))) | ||||
| 
 | ||||
| (test-begin "packages") | ||||
| 
 | ||||
| (test-skip (if (not %store) 1 0)) | ||||
| 
 | ||||
| (test-assert "GNU Hello" | ||||
|   (and (package? hello) | ||||
|        (let* ((drv (package-derivation %store hello)) | ||||
|               (out (derivation-path->output-path drv))) | ||||
|          (and (build-derivations %store (list drv)) | ||||
|               (file-exists? (string-append out "/bin/hello")))))) | ||||
| 
 | ||||
| (test-end "packages") | ||||
| 
 | ||||
|  | ||||
| (exit (= (test-runner-fail-count (test-runner-current)) 0)) | ||||
| 
 | ||||
| ;;; Local Variables: | ||||
| ;;; eval: (put 'test-assert 'scheme-indent-function 1) | ||||
| ;;; End: | ||||
		Reference in a new issue