From 863af4e121d827d3e72a43e405069bf6d887ccba Mon Sep 17 00:00:00 2001 From: Federico Beffa Date: Sat, 7 Mar 2015 17:23:14 +0100 Subject: import: Add hackage importer. * guix/scripts/import.scm (importers): Add hackage. * guix/scripts/import/hackage.scm: New file. * po/guix/POTFILES.in: Add guix/scripts/import.scm. * doc/guix.texi: Add section on 'hackage' importer. --- guix/scripts/import.scm | 2 +- guix/scripts/import/hackage.scm | 106 ++++++++++++++++++++++++++++++++++++++++ 2 files changed, 107 insertions(+), 1 deletion(-) create mode 100644 guix/scripts/import/hackage.scm (limited to 'guix/scripts') diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm index 7e75c10b3e..06b4c17573 100644 --- a/guix/scripts/import.scm +++ b/guix/scripts/import.scm @@ -73,7 +73,7 @@ rather than \\n." ;;; Entry point. ;;; -(define importers '("gnu" "nix" "pypi" "cpan")) +(define importers '("gnu" "nix" "pypi" "cpan" "hackage")) (define (resolve-importer name) (let ((module (resolve-interface diff --git a/guix/scripts/import/hackage.scm b/guix/scripts/import/hackage.scm new file mode 100644 index 0000000000..f7c18cd3bf --- /dev/null +++ b/guix/scripts/import/hackage.scm @@ -0,0 +1,106 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015 Federico Beffa +;;; +;;; 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 . + +(define-module (guix scripts import hackage) + #:use-module (guix ui) + #:use-module (guix utils) + #:use-module (guix import hackage) + #:use-module (guix scripts import) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-37) + #:use-module (ice-9 match) + #:use-module (ice-9 format) + #:export (guix-import-hackage)) + + +;;; +;;; Command-line options. +;;; + +(define %default-options + '((include-test-dependencies? . #t))) + +(define (show-help) + (display (_ "Usage: guix import hackage PACKAGE-NAME +Import and convert the Hackage package for PACKAGE-NAME. If PACKAGE-NAME +includes a suffix constituted by a dash followed by a numerical version (as +used with Guix packages), then a definition for the specified version of the +package will be generated. If no version suffix is pecified, then the +generated package definition will correspond to the latest available +version.\n")) + (display (_ " + -h, --help display this help and exit")) + (display (_ " + -t, --no-test-dependencies don't include test only dependencies")) + (display (_ " + -V, --version display version information and exit")) + (newline) + (show-bug-report-information)) + +(define %options + ;; Specification of the command-line options. + (cons* (option '(#\h "help") #f #f + (lambda args + (show-help) + (exit 0))) + (option '(#\V "version") #f #f + (lambda args + (show-version-and-exit "guix import hackage"))) + (option '(#\t "no-test-dependencies") #f #f + (lambda (opt name arg result) + (alist-cons 'include-test-dependencies? #f + (alist-delete 'include-test-dependencies? + result)))) + %standard-import-options)) + + +;;; +;;; Entry point. +;;; + +(define (guix-import-hackage . args) + (define (parse-options) + ;; Return the alist of option values. + (args-fold* args %options + (lambda (opt name arg result) + (leave (_ "~A: unrecognized option~%") name)) + (lambda (arg result) + (alist-cons 'argument arg result)) + %default-options)) + + (let* ((opts (parse-options)) + (args (filter-map (match-lambda + (('argument . value) + value) + (_ #f)) + (reverse opts)))) + (match args + ((package-name) + (let ((sexp (hackage->guix-package + package-name + #:include-test-dependencies? + (assoc-ref opts 'include-test-dependencies?)))) + (unless sexp + (leave (_ "failed to download cabal file for package '~a'~%") + package-name)) + sexp)) + (() + (leave (_ "too few arguments~%"))) + ((many ...) + (leave (_ "too many arguments~%")))))) -- cgit v1.2.3 From 042bc828fcd2dc7bbacbe6ef0408722a3d51a684 Mon Sep 17 00:00:00 2001 From: Federico Beffa Date: Sat, 4 Apr 2015 22:51:13 +0200 Subject: profiles: Generate GHC's package database cache. * guix/profiles.scm (ghc-package-cache-file): New procedure. (profile-derivation): Add 'ghc-package-cache?' keyword argument. If true (the default), add the result of 'ghc-package-cache-file' to 'inputs'. * guix/scripts/package.scm (guix-package)[process-actions]: Pass #:ghc-package-cache? to 'profile-generation'. * tests/packages.scm ("--search-paths with pattern"): Likewise. * tests/profiles.scm ("profile-derivation"): Likewise. --- guix/profiles.scm | 60 ++++++++++++++++++++++++++++++++++++++++++++++-- guix/scripts/package.scm | 1 + tests/packages.scm | 1 + tests/profiles.scm | 2 ++ 4 files changed, 62 insertions(+), 2 deletions(-) (limited to 'guix/scripts') diff --git a/guix/profiles.scm b/guix/profiles.scm index 465aaf9477..a2f63d1cca 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -404,6 +404,55 @@ MANIFEST." (gexp->derivation "info-dir" build #:modules '((guix build utils))))) +(define (ghc-package-cache-file manifest) + "Return a derivation that builds the GHC 'package.cache' file for all the +entries of MANIFEST." + (define ghc ;lazy reference + (module-ref (resolve-interface '(gnu packages haskell)) 'ghc)) + + (define build + #~(begin + (use-modules (guix build utils) + (srfi srfi-1) (srfi srfi-26) + (ice-9 ftw)) + + (define ghc-name-version + (let* ((base (basename #+ghc))) + (string-drop base + (+ 1 (string-index base #\-))))) + + (define db-subdir + (string-append "lib/" ghc-name-version "/package.conf.d")) + + (define db-dir + (string-append #$output "/" db-subdir)) + + (define (conf-files top) + (find-files (string-append top "/" db-subdir) "\\.conf$")) + + (define (copy-conf-file conf) + (let ((base (basename conf))) + (copy-file conf (string-append db-dir "/" base)))) + + (system* (string-append #+ghc "/bin/ghc-pkg") "init" db-dir) + (for-each copy-conf-file + (append-map conf-files + '#$(manifest-inputs manifest))) + (let ((success + (zero? + (system* (string-append #+ghc "/bin/ghc-pkg") "recache" + (string-append "--package-db=" db-dir))))) + (for-each delete-file (find-files db-dir "\\.conf$")) + success))) + + ;; Don't depend on GHC when there's nothing to do. + (if (any (cut string-prefix? "ghc" <>) + (map manifest-entry-name (manifest-entries manifest))) + (gexp->derivation "ghc-package-cache" build + #:modules '((guix build utils)) + #:local-build? #t) + (gexp->derivation "ghc-package-cache" #~(mkdir #$output)))) + (define (ca-certificate-bundle manifest) "Return a derivation that builds a single-file bundle containing the CA certificates in the /etc/ssl/certs sub-directories of the packages in @@ -465,14 +514,18 @@ MANIFEST. Single-file bundles are required by programs such as Git and Lynx." (define* (profile-derivation manifest #:key (info-dir? #t) + (ghc-package-cache? #t) (ca-certificate-bundle? #t)) "Return a derivation that builds a profile (aka. 'user environment') with the given MANIFEST. The profile includes a top-level Info 'dir' file unless -INFO-DIR? is #f, and a single-file CA certificate bundle unless -CA-CERTIFICATE-BUNDLE? is #f." +INFO-DIR? is #f, a GHC 'package.cache' file unless GHC-PACKAGE-CACHE? is #f +and a single-file CA certificate bundle unless CA-CERTIFICATE-BUNDLE? is #f." (mlet %store-monad ((info-dir (if info-dir? (info-dir-file manifest) (return #f))) + (ghc-package-cache (if ghc-package-cache? + (ghc-package-cache-file manifest) + (return #f))) (ca-cert-bundle (if ca-certificate-bundle? (ca-certificate-bundle manifest) (return #f)))) @@ -480,6 +533,9 @@ CA-CERTIFICATE-BUNDLE? is #f." (append (if info-dir (list (gexp-input info-dir)) '()) + (if ghc-package-cache + (list (gexp-input ghc-package-cache)) + '()) (if ca-cert-bundle (list (gexp-input ca-cert-bundle)) '()) diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 6190f3286d..09ae782751 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -838,6 +838,7 @@ more information.~%")) (profile-derivation new #:info-dir? (not bootstrap?) + #:ghc-package-cache? (not bootstrap?) #:ca-certificate-bundle? (not bootstrap?)))) (prof (derivation->output-path prof-drv))) (show-manifest-transaction (%store) manifest transaction diff --git a/tests/packages.scm b/tests/packages.scm index c9dd5d859a..4e3a116cb8 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -600,6 +600,7 @@ (manifest (map package->manifest-entry (list p1 p2))) #:info-dir? #f + #:ghc-package-cache? #f #:ca-certificate-bundle? #f) #:guile-for-build (%guile-for-build)))) (build-derivations %store (list prof)) diff --git a/tests/profiles.scm b/tests/profiles.scm index 7b942e35b0..d20cb9d808 100644 --- a/tests/profiles.scm +++ b/tests/profiles.scm @@ -184,6 +184,7 @@ (guile (package->derivation %bootstrap-guile)) (drv (profile-derivation (manifest (list entry)) #:info-dir? #f + #:ghc-package-cache? #f #:ca-certificate-bundle? #f)) (profile -> (derivation->output-path drv)) (bindir -> (string-append profile "/bin")) @@ -197,6 +198,7 @@ ((entry -> (package->manifest-entry packages:glibc "debug")) (drv (profile-derivation (manifest (list entry)) #:info-dir? #f + #:ghc-package-cache? #f #:ca-certificate-bundle? #f))) (return (derivation-inputs drv)))) -- cgit v1.2.3