guix/describe.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 describe)
  20   #:use-module (guix memoization)
  21   #:use-module (guix profiles)
  22   #:use-module (srfi srfi-1)
  23   #:use-module (ice-9 match)
  24   #:export (package-path-entries))
  25
  26 ;;; Commentary:
  27 ;;;
  28 ;;; This module provides supporting code to allow a Guix instance to find, at
  29 ;;; run time, which profile it's in (profiles created by 'guix pull').  That
  30 ;;; allows it to read meta-information about itself (e.g., repository URL and
  31 ;;; commit ID) and to find other channels available in the same profile.  It's
  32 ;;; a bit like ELPA's pkg-info.el.
  33 ;;;
  34 ;;; Code:
  35
  36 (define current-profile
  37   (mlambda ()
  38     "Return the profile (created by 'guix pull') the calling process lives in,
  39 or #f if this is not applicable."
  40     (match (command-line)
  41       ((program . _)
  42        (and (string-suffix? "/bin/guix" program)
  43             ;; Note: We want to do _lexical dot-dot resolution_.  Using ".."
  44             ;; for real would instead take us into the /gnu/store directory
  45             ;; that ~/.config/guix/current/bin points to, whereas we want to
  46             ;; obtain ~/.config/guix/current.
  47             (let ((candidate (dirname (dirname program))))
  48               (and (file-exists? (string-append candidate "/manifest"))
  49                    candidate)))))))
  50
  51 (define current-profile-entries
  52   (mlambda ()
  53     "Return the list of entries in the 'guix pull' profile the calling process
  54 lives in, or #f if this is not applicable."
  55     (match (current-profile)
  56       (#f '())
  57       (profile
  58        (let ((manifest (profile-manifest profile)))
  59          (manifest-entries manifest))))))
  60
  61 (define package-path-entries
  62   (mlambda ()
  63     "Return a list of package path entries to be added to the package search
  64 path.  These entries are taken from the 'guix pull' profile the calling
  65 process lives in, when applicable."
  66     ;; Filter out Guix itself.
  67     (filter-map (lambda (entry)
  68                   (and (not (string=? (manifest-entry-name entry)
  69                                       "guix"))
  70                        (string-append (manifest-entry-item entry)
  71                                       "/share/guile/site/"
  72                                       (effective-version))))
  73                 (current-profile-entries))))