guix/channels.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
   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 channels)
  20   #:use-module (guix git)
  21   #:use-module (guix records)
  22   #:use-module (guix gexp)
  23   #:use-module (guix discovery)
  24   #:use-module (guix monads)
  25   #:use-module (guix profiles)
  26   #:use-module (guix derivations)
  27   #:use-module (guix store)
  28   #:use-module (guix i18n)
  29   #:use-module (srfi srfi-1)
  30   #:use-module (srfi srfi-9)
  31   #:use-module (srfi srfi-11)
  32   #:autoload   (guix self) (whole-package)
  33   #:use-module (ice-9 match)
  34   #:export (channel
  35             channel?
  36             channel-name
  37             channel-url
  38             channel-branch
  39             channel-commit
  40             channel-location
  41
  42             %default-channels
  43
  44             channel-instance?
  45             channel-instance-channel
  46             channel-instance-commit
  47             channel-instance-checkout
  48
  49             latest-channel-instances
  50             checkout->channel-instance
  51             latest-channel-derivation
  52             channel-instances->manifest
  53             channel-instances->derivation))
  54
  55 ;;; Commentary:
  56 ;;;
  57 ;;; This module implements "channels."  A channel is usually a source of
  58 ;;; package definitions.  There's a special channel, the 'guix' channel, that
  59 ;;; provides all of Guix, including its commands and its documentation.
  60 ;;; User-defined channels are expected to typically provide a bunch of .scm
  61 ;;; files meant to be added to the '%package-search-path'.
  62 ;;;
  63 ;;; This module provides tools to fetch and update channels from a Git
  64 ;;; repository and to build them.
  65 ;;;
  66 ;;; Code:
  67
  68 (define-record-type* <channel> channel make-channel
  69   channel?
  70   (name      channel-name)
  71   (url       channel-url)
  72   (branch    channel-branch (default "master"))
  73   (commit    channel-commit (default #f))
  74   (location  channel-location
  75              (default (current-source-location)) (innate)))
  76 ;; TODO: Add a way to express dependencies among channels.
  77
  78 (define %default-channels
  79   ;; Default list of channels.
  80   (list (channel
  81          (name 'guix)
  82          (branch "master")
  83          (url "https://git.savannah.gnu.org/git/guix.git"))))
  84
  85 (define (guix-channel? channel)
  86   "Return true if CHANNEL is the 'guix' channel."
  87   (eq? 'guix (channel-name channel)))
  88
  89 (define-record-type <channel-instance>
  90   (channel-instance channel commit checkout)
  91   channel-instance?
  92   (channel   channel-instance-channel)
  93   (commit    channel-instance-commit)
  94   (checkout  channel-instance-checkout))
  95
  96 (define (channel-reference channel)
  97   "Return the \"reference\" for CHANNEL, an sexp suitable for
  98 'latest-repository-commit'."
  99   (match (channel-commit channel)
 100     (#f      `(branch . ,(channel-branch channel)))
 101     (commit  `(commit . ,(channel-commit channel)))))
 102
 103 (define (latest-channel-instances store channels)
 104   "Return a list of channel instances corresponding to the latest checkouts of
 105 CHANNELS."
 106   (map (lambda (channel)
 107          (format (current-error-port)
 108                  (G_ "Updating channel '~a' from Git repository at '~a'...~%")
 109                  (channel-name channel)
 110                  (channel-url channel))
 111          (let-values (((checkout commit)
 112                        (latest-repository-commit store (channel-url channel)
 113                                                  #:ref (channel-reference
 114                                                         channel))))
 115            (channel-instance channel commit checkout)))
 116        channels))
 117
 118 (define* (checkout->channel-instance checkout
 119                                      #:key commit
 120                                      (url checkout) (name 'guix))
 121   "Return a channel instance for CHECKOUT, which is assumed to be a checkout
 122 of COMMIT at URL.  Use NAME as the channel name."
 123   (let* ((commit  (or commit (make-string 40 #\0)))
 124          (channel (channel (name name)
 125                            (commit commit)
 126                            (url url))))
 127     (channel-instance channel commit checkout)))
 128
 129 (define %self-build-file
 130   ;; The file containing code to build Guix.  This serves the same purpose as
 131   ;; a makefile, and, similarly, is intended to always keep this name.
 132   "build-aux/build-self.scm")
 133
 134 (define %pull-version
 135   ;; This is the version of the 'guix pull' protocol.  It specifies what's
 136   ;; expected from %SELF-BUILD-FILE.  The initial version ("0") was when we'd
 137   ;; place a set of compiled Guile modules in ~/.config/guix/latest.
 138   1)
 139
 140 (define (standard-module-derivation name source dependencies)
 141   "Return a derivation that builds the Scheme modules in SOURCE and that
 142 depend on DEPENDENCIES, a list of lowerable objects.  The assumption is that
 143 SOURCE contains package modules to be added to '%package-module-path'."
 144   (define modules
 145     (scheme-modules* source))
 146
 147   ;; FIXME: We should load, say SOURCE/.guix-channel.scm, which would allow
 148   ;; channel publishers to specify things such as the sub-directory where .scm
 149   ;; files live, files to exclude from the channel, preferred substitute URLs,
 150   ;; etc.
 151   (mlet* %store-monad ((compiled
 152                         (compiled-modules modules
 153                                           #:name name
 154                                           #:module-path (list source)
 155                                           #:extensions dependencies)))
 156
 157     (gexp->derivation name
 158                       (with-extensions dependencies
 159                         (with-imported-modules '((guix build utils))
 160                           #~(begin
 161                               (use-modules (guix build utils))
 162
 163                               (let ((go  (string-append #$output "/lib/guile/"
 164                                                         (effective-version)
 165                                                         "/site-ccache"))
 166                                     (scm (string-append #$output
 167                                                         "/share/guile/site/"
 168                                                         (effective-version))))
 169                                 (mkdir-p (dirname go))
 170                                 (symlink #$compiled go)
 171                                 (mkdir-p (dirname scm))
 172                                 (symlink #$source scm))))))))
 173
 174 (define* (build-from-source name source
 175                             #:key verbose? commit
 176                             (dependencies '()))
 177   "Return a derivation to build Guix from SOURCE, using the self-build script
 178 contained therein.  Use COMMIT as the version string."
 179   ;; Running the self-build script makes it easier to update the build
 180   ;; procedure: the self-build script of the Guix-to-be-installed contains the
 181   ;; right dependencies, build procedure, etc., which the Guix-in-use may not
 182   ;; be know.
 183   (define script
 184     (string-append source "/" %self-build-file))
 185
 186   (if (file-exists? script)
 187       (let ((build (save-module-excursion
 188                     (lambda ()
 189                       (primitive-load script)))))
 190         ;; BUILD must be a monadic procedure of at least one argument: the
 191         ;; source tree.
 192         ;;
 193         ;; Note: BUILD can return #f if it does not support %PULL-VERSION.  In
 194         ;; the future we'll fall back to a previous version of the protocol
 195         ;; when that happens.
 196         (build source #:verbose? verbose? #:version commit
 197                #:pull-version %pull-version))
 198
 199       ;; Build a set of modules that extend Guix using the standard method.
 200       (standard-module-derivation name source dependencies)))
 201
 202 (define* (build-channel-instance instance #:optional (dependencies '()))
 203   "Return, as a monadic value, the derivation for INSTANCE, a channel
 204 instance.  DEPENDENCIES is a list of extensions providing Guile modules that
 205 INSTANCE depends on."
 206   (build-from-source (symbol->string
 207                       (channel-name (channel-instance-channel instance)))
 208                      (channel-instance-checkout instance)
 209                      #:commit (channel-instance-commit instance)
 210                      #:dependencies dependencies))
 211
 212 (define (channel-instance-derivations instances)
 213   "Return the list of derivations to build INSTANCES, in the same order as
 214 INSTANCES."
 215   (define core-instance
 216     ;; The 'guix' channel is treated specially: it's an implicit dependency of
 217     ;; all the other channels.
 218     (find (lambda (instance)
 219             (guix-channel? (channel-instance-channel instance)))
 220           instances))
 221
 222   (define dependencies
 223     ;; Dependencies of CORE-INSTANCE.
 224     ;; FIXME: It would be best not to hard-wire this information here and
 225     ;; instead query it to CORE-INSTANCE.
 226     (list (module-ref (resolve-interface '(gnu packages gnupg))
 227                       'guile-gcrypt)
 228           (module-ref (resolve-interface '(gnu packages guile))
 229                       'guile-git)
 230           (module-ref (resolve-interface '(gnu packages guile))
 231                       'guile-bytestructures)))
 232
 233   (mlet %store-monad ((core (build-channel-instance core-instance)))
 234     (mapm %store-monad
 235           (lambda (instance)
 236             (if (eq? instance core-instance)
 237                 (return core)
 238                 (build-channel-instance instance
 239                                         (cons core dependencies))))
 240           instances)))
 241
 242 (define (whole-package-for-legacy name modules)
 243   "Return a full-blown Guix package for MODULES, a derivation that builds Guix
 244 modules in the old ~/.config/guix/latest style."
 245   (define packages
 246     (resolve-interface '(gnu packages guile)))
 247
 248   (letrec-syntax ((list (syntax-rules (->)
 249                           ((_)
 250                            '())
 251                           ((_ (module -> variable) rest ...)
 252                            (cons (module-ref (resolve-interface
 253                                               '(gnu packages module))
 254                                              'variable)
 255                                  (list rest ...)))
 256                           ((_ variable rest ...)
 257                            (cons (module-ref packages 'variable)
 258                                  (list rest ...))))))
 259     (whole-package name modules
 260
 261                    ;; In the "old style", %SELF-BUILD-FILE would simply return a
 262                    ;; derivation that builds modules.  We have to infer what the
 263                    ;; dependencies of these modules were.
 264                    (list guile-json guile-git guile-bytestructures
 265                          (ssh -> guile-ssh) (tls -> gnutls)))))
 266
 267 (define (old-style-guix? drv)
 268   "Return true if DRV corresponds to a ~/.config/guix/latest style of
 269 derivation."
 270   ;; Here we rely on a gross historical fact: that derivations produced by the
 271   ;; "old style" (before commit 8a0d9bc8a3f153159d9e239a151c0fa98f1e12d8,
 272   ;; dated May 30, 2018) did not depend on "guix-command.drv".
 273   (not (find (lambda (input)
 274                (string-suffix? "-guix-command.drv"
 275                                (derivation-input-path input)))
 276              (derivation-inputs drv))))
 277
 278 (define (channel-instances->manifest instances)
 279   "Return a profile manifest with entries for all of INSTANCES, a list of
 280 channel instances."
 281   (define instance->entry
 282     (match-lambda
 283       ((instance drv)
 284        (let ((commit  (channel-instance-commit instance))
 285              (channel (channel-instance-channel instance)))
 286          (with-monad %store-monad
 287            (return (manifest-entry
 288                      (name (symbol->string (channel-name channel)))
 289                      (version (string-take commit 7))
 290                      (item (if (guix-channel? channel)
 291                                (if (old-style-guix? drv)
 292                                    (whole-package-for-legacy
 293                                     (string-append name "-" version)
 294                                     drv)
 295                                    drv)
 296                                drv))
 297                      (properties
 298                       `((source (repository
 299                                  (version 0)
 300                                  (url ,(channel-url channel))
 301                                  (branch ,(channel-branch channel))
 302                                  (commit ,commit))))))))))))
 303
 304   (mlet* %store-monad ((derivations (channel-instance-derivations instances))
 305                        (entries     (mapm %store-monad instance->entry
 306                                           (zip instances derivations))))
 307     (return (manifest entries))))
 308
 309 (define (channel-instances->derivation instances)
 310   "Return the derivation of the profile containing INSTANCES, a list of
 311 channel instances."
 312   (mlet %store-monad ((manifest (channel-instances->manifest instances)))
 313     (profile-derivation manifest)))
 314
 315 (define latest-channel-instances*
 316   (store-lift latest-channel-instances))
 317
 318 (define* (latest-channel-derivation #:optional (channels %default-channels))
 319   "Return as a monadic value the derivation that builds the profile for the
 320 latest instances of CHANNELS."
 321   (mlet %store-monad ((instances (latest-channel-instances* channels)))
 322     (channel-instances->derivation instances)))