package.scm 5.51 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92
;;; Copyright © 2016, 2017  Roel Janssen <roel@gnu.org>
;;;
;;; This program is free software: you can redistribute it and/or
;;; modify it under the terms of the GNU Affero General Public License
;;; as published by the Free Software Foundation, either version 3 of
;;; the License, or (at your option) any later version.
;;;
;;; This program 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
;;; Affero General Public License for more details.
;;;
;;; You should have received a copy of the GNU Affero General Public
;;; License along with this program.  If not, see
;;; <http://www.gnu.org/licenses/>.

(define-module (www pages package)
  #:use-module (www pages)
  #:use-module (www config)
  #:use-module (gnu packages)
  #:use-module (guix packages)
  #:use-module (guix utils)
  #:use-module (ice-9 rdelim)
  #:use-module (texinfo)
  #:use-module (texinfo html)
  #:export (page-package))

(define (scheme-variable-name file line)

  (define (search-path* path file)
    "Like 'search-path' but exit if FILE is not found."
    (let ((absolute-file-name (search-path path file)))
      (unless absolute-file-name
        ;; Shouldn't happen unless somebody fiddled with the 'location' field.
        (leave (G_ "file '~a' not found in search path ~s~%")
               file path))
      absolute-file-name))
  
  (define (get-definition port current-line target-line)
    (let ((line (read-line port)))
      (if (< current-line target-line)
          (get-definition port (1+ current-line) target-line)
          (cadr (string-split line #\ )))))

  (let ((file (search-path* %load-path file)))
    (call-with-input-file file
      (lambda (port)
        (get-definition port 2 line)))))

(define (package-description-shtml package)
  "Return an SXML representation of PACKAGE description field with HTML
vocabulary."
  ;; 'texi-fragment->stexi' uses 'call-with-input-string', so make sure
  ;; those string ports are Unicode-capable.
  (with-fluids ((%default-port-encoding "UTF-8"))
    (and=> (package-description package)
           (compose stexi->shtml texi-fragment->stexi))))

(define (page-package request-path)
  (let* ((name (list-ref (string-split request-path #\/) 2))
         (packages (find-packages-by-name name)))
    (if (eqv? packages '())
        (page-root-template "Oops!" request-path
         `((h2 "Uh-oh...")
           (p "The package is gone!")))
        (page-root-template (string-append "Details for " name) request-path
         `((h2 "Package details of " (code (@ (class "h2-title")) ,name))
           (p ,(package-description-shtml (car packages)))
           (p "There " ,(if (> (length packages) 1) "are " "is ") ,(length packages) " version"
              ,(if (> (length packages) 1) "s" "") " available for this package.")
           (hr)
           ,(map (lambda (instance)
                   (let ((location (package-location instance)))
                     `((table (@ (style "width: 100%"))
                        (tr
                         (td (strong "Version"))
                         (td ,(package-version instance)))
                        (tr
                         (td (strong "Defined at"))
                         (td (code (@ (class "nobg"))
                                   ,(string-append (location-file location) ":"
                                                   (number->string
                                                    (location-line location))))))
                        (tr
                         (td (strong "Symbol name"))
                         (td (code (@ (class "nobg"))
                                   ,(scheme-variable-name
                                     (location-file location)
                                     (location-line location)))))
                        (tr
                         (td (@ (style "width: 150pt")) (strong "Installation command"))
                         (td (pre (code (@ (class "bash"))
93
                                        (string-append "guix package -i "
94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114
                                                       ,name ,(if (> (length packages) 1)
                                                                  (string-append
                                                                   "@" (package-version instance)) ""))))))
                        (tr
                         (td (strong "Homepage"))
                         (td (a (@ (href ,(package-home-page instance))) ,(package-home-page instance)))))
                       (hr))))
                 packages)

           (h2 "After installation")
           (p "After running the installation command, your package has been "
              "installed into a profile.  By default, this is your “user” "
              "profile.  You can change the default by appending "
              (code "--profile=/path/to/profile") " to the installation command, "
              "where " (code "/path/to/profile") " can be any filesystem "
              "location.")

           (p "To use the newly installed program, the shell needs to know where "
              "to find the programs in your profile.  This is what we do when we "
              "“load a profile”.")

115 116 117 118 119 120
           (h2 "More information")
           (p "Please refer to "
              (a (@ (href
                     "//www.gnu.org/software/guix/manual/html_node/Invoking-guix-package.html"))
                 "the manual")
              " for more information."))
121 122

         #:dependencies '(highlight)))))