guix/bzr-download.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2017 Maxim Cournoyer <maxim.cournoyer@gmail.com>
   3 ;;;
   4 ;;; This file is part of GNU Guix.
   5 ;;;
   6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   7 ;;; under the terms of the GNU General Public License as published by
   8 ;;; the Free Software Foundation; either version 3 of the License, or (at
   9 ;;; your option) any later version.
  10 ;;;
  11 ;;; GNU Guix is distributed in the hope that it will be useful, but
  12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;; GNU General Public License for more details.
  15 ;;;
  16 ;;; You should have received a copy of the GNU General Public License
  17 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 (define-module (guix bzr-download)
  20   #:use-module (guix gexp)
  21   #:use-module (guix modules)   ;for 'source-module-closure'
  22   #:use-module (guix monads)
  23   #:use-module (guix packages)
  24   #:use-module (guix records)
  25   #:use-module (guix store)
  26
  27   #:export (bzr-reference
  28             bzr-reference?
  29             bzr-reference-url
  30             bzr-reference-revision
  31
  32             bzr-fetch))
  33
  34 ;;; Commentary:
  35 ;;;
  36 ;;; An <origin> method that fetches a specific revision from a Bazaar
  37 ;;; repository.  The repository URL and revision identifier are specified with
  38 ;;; a <bzr-reference> object.
  39 ;;;
  40 ;;; Code:
  41
  42 (define-record-type* <bzr-reference>
  43   bzr-reference make-bzr-reference
  44   bzr-reference?
  45   (url bzr-reference-url)
  46   (revision bzr-reference-revision))
  47
  48 (define (bzr-package)
  49   "Return the default Bazaar package."
  50   (let ((distro (resolve-interface '(gnu packages version-control))))
  51     (module-ref distro 'bazaar)))
  52
  53 (define* (bzr-fetch ref hash-algo hash
  54                        #:optional name
  55                        #:key (system (%current-system)) (guile (default-guile))
  56                        (bzr (bzr-package)))
  57   "Return a fixed-output derivation that fetches REF, a <bzr-reference>
  58 object.  The output is expected to have recursive hash HASH of type
  59 HASH-ALGO (a symbol).  Use NAME as the file name, or a generic name if #f."
  60   (define build
  61     (with-imported-modules (source-module-closure
  62                             '((guix build bzr)))
  63       #~(begin
  64           (use-modules (guix build bzr))
  65           (bzr-fetch
  66            (getenv "bzr url") (getenv "bzr reference") #$output
  67            #:bzr-command (string-append #+bzr "/bin/bzr")))))
  68
  69   (mlet %store-monad ((guile (package->derivation guile system)))
  70     (gexp->derivation (or name "bzr-branch") build
  71                       ;; Use environment variables and a fixed script name so
  72                       ;; there's only one script in store for all the
  73                       ;; downloads.
  74                       #:script-name "bzr-download"
  75                       #:env-vars
  76                       `(("bzr url" . ,(bzr-reference-url ref))
  77                         ("bzr reference" . ,(bzr-reference-revision ref)))
  78                       #:leaked-env-vars '("http_proxy" "https_proxy"
  79                                           "LC_ALL" "LC_MESSAGES" "LANG"
  80                                           "COLUMNS")
  81                       #:system system
  82                       #:local-build? #t  ;don't offload repo branching
  83                       #:hash-algo hash-algo
  84                       #:hash hash
  85                       #:recursive? #t
  86                       #:guile-for-build guile)))
  87
  88 ;;; bzr-download.scm ends here