[jackhill/guix/guix.git] / guix / channels.scm

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 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 channels)
  #:use-module (guix git)
  #:use-module (guix records)
  #:use-module (guix gexp)
  #:use-module (guix discovery)
  #:use-module (guix monads)
  #:use-module (guix profiles)
  #:use-module (guix derivations)
  #:use-module (guix store)
  #:use-module (guix i18n)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-9)
  #:use-module (srfi srfi-11)
  #:autoload   (guix self) (whole-package)
  #:use-module (ice-9 match)
  #:export (channel
            channel?
            channel-name
            channel-url
            channel-branch
            channel-commit
            channel-location

            %default-channels

            channel-instance?
            channel-instance-channel
            channel-instance-commit
            channel-instance-checkout

            latest-channel-instances
            latest-channel-derivation
            channel-instances->manifest
            channel-instances->derivation))

;;; Commentary:
;;;
;;; This module implements "channels."  A channel is usually a source of
;;; package definitions.  There's a special channel, the 'guix' channel, that
;;; provides all of Guix, including its commands and its documentation.
;;; User-defined channels are expected to typically provide a bunch of .scm
;;; files meant to be added to the '%package-search-path'.
;;;
;;; This module provides tools to fetch and update channels from a Git
;;; repository and to build them.
;;;
;;; Code:

(define-record-type* <channel> channel make-channel
  channel?
  (name      channel-name)
  (url       channel-url)
  (branch    channel-branch (default "master"))
  (commit    channel-commit (default #f))
  (location  channel-location
             (default (current-source-location)) (innate)))
;; TODO: Add a way to express dependencies among channels.

(define %default-channels
  ;; Default list of channels.
  (list (channel
         (name 'guix)
         (branch "master")
         (url "https://git.savannah.gnu.org/git/guix.git"))))

(define (guix-channel? channel)
  "Return true if CHANNEL is the 'guix' channel."
  (eq? 'guix (channel-name channel)))

(define-record-type <channel-instance>
  (channel-instance channel commit checkout)
  channel-instance?
  (channel   channel-instance-channel)
  (commit    channel-instance-commit)
  (checkout  channel-instance-checkout))

(define (channel-reference channel)
  "Return the \"reference\" for CHANNEL, an sexp suitable for
'latest-repository-commit'."
  (match (channel-commit channel)
    (#f      `(branch . ,(channel-branch channel)))
    (commit  `(commit . ,(channel-commit channel)))))

(define (latest-channel-instances store channels)
  "Return a list of channel instances corresponding to the latest checkouts of
CHANNELS."
  (map (lambda (channel)
         (format (current-error-port)
                 (G_ "Updating channel '~a' from Git repository at '~a'...~%")
                 (channel-name channel)
                 (channel-url channel))
         (let-values (((checkout commit)
                       (latest-repository-commit store (channel-url channel)
                                                 #:ref (channel-reference
                                                        channel))))
           (channel-instance channel commit checkout)))
       channels))

(define %self-build-file
  ;; The file containing code to build Guix.  This serves the same purpose as
  ;; a makefile, and, similarly, is intended to always keep this name.
  "build-aux/build-self.scm")

(define %pull-version
  ;; This is the version of the 'guix pull' protocol.  It specifies what's
  ;; expected from %SELF-BUILD-FILE.  The initial version ("0") was when we'd
  ;; place a set of compiled Guile modules in ~/.config/guix/latest.
  1)

(define (standard-module-derivation name source dependencies)
  "Return a derivation that builds the Scheme modules in SOURCE and that
depend on DEPENDENCIES, a list of lowerable objects.  The assumption is that
SOURCE contains package modules to be added to '%package-module-path'."
  (define modules
    (scheme-modules* source))

  ;; FIXME: We should load, say SOURCE/.guix-channel.scm, which would allow
  ;; channel publishers to specify things such as the sub-directory where .scm
  ;; files live, files to exclude from the channel, preferred substitute URLs,
  ;; etc.
  (mlet* %store-monad ((compiled
                        (compiled-modules modules
                                          #:name name
                                          #:module-path (list source)
                                          #:extensions dependencies)))

    (gexp->derivation name
                      (with-extensions dependencies
                        (with-imported-modules '((guix build utils))
                          #~(begin
                              (use-modules (guix build utils))

                              (let ((go  (string-append #$output "/lib/guile/"
                                                        (effective-version)
                                                        "/site-ccache"))
                                    (scm (string-append #$output
                                                        "/share/guile/site/"
                                                        (effective-version))))
                                (mkdir-p (dirname go))
                                (symlink #$compiled go)
                                (mkdir-p (dirname scm))
                                (symlink #$source scm))))))))

(define* (build-from-source name source
                            #:key verbose? commit
                            (dependencies '()))
  "Return a derivation to build Guix from SOURCE, using the self-build script
contained therein.  Use COMMIT as the version string."
  ;; Running the self-build script makes it easier to update the build
  ;; procedure: the self-build script of the Guix-to-be-installed contains the
  ;; right dependencies, build procedure, etc., which the Guix-in-use may not
  ;; be know.
  (define script
    (string-append source "/" %self-build-file))

  (if (file-exists? script)
      (let ((build (save-module-excursion
                    (lambda ()
                      (primitive-load script)))))
        ;; BUILD must be a monadic procedure of at least one argument: the
        ;; source tree.
        ;;
        ;; Note: BUILD can return #f if it does not support %PULL-VERSION.  In
        ;; the future we'll fall back to a previous version of the protocol
        ;; when that happens.
        (build source #:verbose? verbose? #:version commit
               #:pull-version %pull-version))

      ;; Build a set of modules that extend Guix using the standard method.
      (standard-module-derivation name source dependencies)))

(define* (build-channel-instance instance #:optional (dependencies '()))
  "Return, as a monadic value, the derivation for INSTANCE, a channel
instance.  DEPENDENCIES is a list of extensions providing Guile modules that
INSTANCE depends on."
  (build-from-source (symbol->string
                      (channel-name (channel-instance-channel instance)))
                     (channel-instance-checkout instance)
                     #:commit (channel-instance-commit instance)
                     #:dependencies dependencies))

(define (channel-instance-derivations instances)
  "Return the list of derivations to build INSTANCES, in the same order as
INSTANCES."
  (define core-instance
    ;; The 'guix' channel is treated specially: it's an implicit dependency of
    ;; all the other channels.
    (find (lambda (instance)
            (guix-channel? (channel-instance-channel instance)))
          instances))

  (define dependencies
    ;; Dependencies of CORE-INSTANCE.
    ;; FIXME: It would be best not to hard-wire this information here and
    ;; instead query it to CORE-INSTANCE.
    (list (module-ref (resolve-interface '(gnu packages gnupg))
                      'guile-gcrypt)
          (module-ref (resolve-interface '(gnu packages guile))
                      'guile-git)
          (module-ref (resolve-interface '(gnu packages guile))
                      'guile-bytestructures)))

  (mlet %store-monad ((core (build-channel-instance core-instance)))
    (mapm %store-monad
          (lambda (instance)
            (if (eq? instance core-instance)
                (return core)
                (build-channel-instance instance
                                        (cons core dependencies))))
          instances)))

(define (whole-package-for-legacy name modules)
  "Return a full-blown Guix package for MODULES, a derivation that builds Guix
modules in the old ~/.config/guix/latest style."
  (define packages
    (resolve-interface '(gnu packages guile)))

  (letrec-syntax ((list (syntax-rules (->)
                          ((_)
                           '())
                          ((_ (module -> variable) rest ...)
                           (cons (module-ref (resolve-interface
                                              '(gnu packages module))
                                             'variable)
                                 (list rest ...)))
                          ((_ variable rest ...)
                           (cons (module-ref packages 'variable)
                                 (list rest ...))))))
    (whole-package name modules

                   ;; In the "old style", %SELF-BUILD-FILE would simply return a
                   ;; derivation that builds modules.  We have to infer what the
                   ;; dependencies of these modules were.
                   (list guile-json guile-git guile-bytestructures
                         (ssh -> guile-ssh) (tls -> gnutls)))))

(define (old-style-guix? drv)
  "Return true if DRV corresponds to a ~/.config/guix/latest style of
derivation."
  ;; Here we rely on a gross historical fact: that derivations produced by the
  ;; "old style" (before commit 8a0d9bc8a3f153159d9e239a151c0fa98f1e12d8,
  ;; dated May 30, 2018) did not depend on "guix-command.drv".
  (not (find (lambda (input)
               (string-suffix? "-guix-command.drv"
                               (derivation-input-path input)))
             (derivation-inputs drv))))

(define (channel-instances->manifest instances)
  "Return a profile manifest with entries for all of INSTANCES, a list of
channel instances."
  (define instance->entry
    (match-lambda
      ((instance drv)
       (let ((commit  (channel-instance-commit instance))
             (channel (channel-instance-channel instance)))
         (with-monad %store-monad
           (return (manifest-entry
                     (name (symbol->string (channel-name channel)))
                     (version (string-take commit 7))
                     (item (if (guix-channel? channel)
                               (if (old-style-guix? drv)
                                   (whole-package-for-legacy
                                    (string-append name "-" version)
                                    drv)
                                   drv)
                               drv))
                     (properties
                      `((source (repository
                                 (version 0)
                                 (url ,(channel-url channel))
                                 (branch ,(channel-branch channel))
                                 (commit ,commit))))))))))))

  (mlet* %store-monad ((derivations (channel-instance-derivations instances))
                       (entries     (mapm %store-monad instance->entry
                                          (zip instances derivations))))
    (return (manifest entries))))

(define (channel-instances->derivation instances)
  "Return the derivation of the profile containing INSTANCES, a list of
channel instances."
  (mlet %store-monad ((manifest (channel-instances->manifest instances)))
    (profile-derivation manifest)))

(define latest-channel-instances*
  (store-lift latest-channel-instances))

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