* [bug#59385] [PATCH] website: Link to the new packages browser
2022-11-21 11:05 ` Ludovic Courtès
@ 2022-11-21 16:38 ` Luis Felipe via Guix-patches via
2022-11-25 17:09 ` bug#59385: " Ludovic Courtès
2022-11-25 21:49 ` Ludovic Courtès
1 sibling, 1 reply; 7+ messages in thread
From: Luis Felipe via Guix-patches via @ 2022-11-21 16:38 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: 59385
[-- Attachment #1.1: Type: text/plain, Size: 1725 bytes --]
Hi,
On Monday, November 21st, 2022 at 11:05, Ludovic Courtès <ludo@gnu.org> wrote:
> Hi,
>
> Luis Felipe luis.felipe.la@protonmail.com skribis:
>
> > From ad0effaab60acdb7bd0e533bd544b49a4bee8a2b Mon Sep 17 00:00:00 2001
> > From: Luis Felipe luis.felipe.la@protonmail.com
> > Date: Sat, 19 Nov 2022 08:21:04 -0500
> > Subject: [PATCH] website: Link to the new packages browser.
> >
> > Update all package-related links to point to the newly deployed browser
> > at https://packages.guix.gnu.org/.
> >
> > * website/apps/base/utils.scm (packages-url): New procedure.
> > * website/apps/base/data.scm (contact-media): Use packages-url.
> > * website/apps/base/templates/components.scm (navbar): Likewise.
> > * website/apps/base/templates/contribute.scm (contribute-t): Likewise.
> > * website/apps/base/templates/donate.scm (donate-t): Likewise.
> > * website/apps/base/templates/home.scm (home-t): Likewise.
>
>
> Awesome, pushed!
Thanks :)
> While we’re at it, can we also disable individual package page
> generation? It takes a lot of time to build and uses quite a lot of
> space as well; I’m eager to see them go. :-)
I'm attaching a patch that removes the whole "(apps packages)" module.
> Maybe we can add a redirect from https://guix.gnu.org/en/packages
That would be good.
> If we’re serious about it, we can try to match the package/version in
> URLs like https://guix.gnu.org/en/packages/julia-mappedarrays-0.4.0/
> and redirect to the right one. Not sure if that’s worth the trouble
> though.
I'd say it is not necessary since people were avoiding linking to them because of the version. They were already considered ephemeral.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: 0001-website-Remove-packages-app.patch --]
[-- Type: text/x-patch; filename="0001-website-Remove-packages-app.patch"; name="0001-website-Remove-packages-app.patch", Size: 57117 bytes --]
From 29723b3c711db2316e1fb66d252de769494b4a98 Mon Sep 17 00:00:00 2001
From: Luis Felipe <luis.felipe.la@protonmail.com>
Date: Mon, 21 Nov 2022 11:06:03 -0500
Subject: [PATCH] website: Remove packages app.
There is a new package browser at https://packages.guix.gnu.org/. It
is not necessary to generate a static package catalog anymore.
* website/apps/packages: Remove it.
* website/tests/apps/packages: Likewise.
* website/haunt.scm (site): Remove packages builder.
* website/tests/all.scm: Don't import packages tests.
---
website/apps/packages/builder.scm | 308 ------------------
website/apps/packages/data.scm | 63 ----
.../apps/packages/templates/components.scm | 275 ----------------
.../packages/templates/detailed-index.scm | 66 ----
.../templates/detailed-package-list.scm | 67 ----
website/apps/packages/templates/index.scm | 64 ----
.../apps/packages/templates/package-list.scm | 65 ----
website/apps/packages/templates/package.scm | 87 -----
website/apps/packages/types.scm | 109 -------
website/apps/packages/utils.scm | 282 ----------------
website/haunt.scm | 2 -
website/tests/all.scm | 3 +-
website/tests/apps/packages/utils.scm | 107 ------
13 files changed, 1 insertion(+), 1497 deletions(-)
delete mode 100644 website/apps/packages/builder.scm
delete mode 100644 website/apps/packages/data.scm
delete mode 100644 website/apps/packages/templates/components.scm
delete mode 100644 website/apps/packages/templates/detailed-index.scm
delete mode 100644 website/apps/packages/templates/detailed-package-list.scm
delete mode 100644 website/apps/packages/templates/index.scm
delete mode 100644 website/apps/packages/templates/package-list.scm
delete mode 100644 website/apps/packages/templates/package.scm
delete mode 100644 website/apps/packages/types.scm
delete mode 100644 website/apps/packages/utils.scm
delete mode 100644 website/tests/apps/packages/utils.scm
diff --git a/website/apps/packages/builder.scm b/website/apps/packages/builder.scm
deleted file mode 100644
index b08ba2e..0000000
--- a/website/apps/packages/builder.scm
+++ /dev/null
@@ -1,308 +0,0 @@
-;;; GNU Guix web site
-;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
-;;; Copyright © 2019 Nicolò Balzarotti <nicolo@nixo.xyz>
-;;; Copyright © 2020, 2021 Simon Tournier <zimon.toutoune@gmail.com>
-;;;
-;;; Initially written by sirgazil
-;;; who waives all copyright interest on this file.
-;;;
-;;; This file is part of the GNU Guix web site.
-;;;
-;;; The GNU Guix web site 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.
-;;;
-;;; The GNU Guix web site 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 the GNU Guix web site. If not, see <http://www.gnu.org/licenses/>.
-
-(define-module (apps packages builder)
- #:use-module (apps aux lists)
- #:use-module (apps aux system)
- #:use-module (apps base utils)
- #:use-module (apps packages data)
- #:use-module (apps packages templates detailed-index)
- #:use-module (apps packages templates index)
- #:use-module (apps packages templates detailed-package-list)
- #:use-module (apps packages templates package)
- #:use-module (apps packages templates package-list)
- #:use-module (apps packages types)
- #:use-module (apps packages utils)
- #:use-module (haunt html)
- #:use-module (haunt page)
- #:use-module (haunt utils)
- #:use-module (srfi srfi-1)
- #:use-module (srfi srfi-26)
- #:use-module (guix packages)
- #:use-module (guix download)
- #:use-module (guix git-download)
- #:use-module (guix svn-download)
- #:use-module (guix hg-download)
- #:use-module (guix utils) ;location
- #:use-module ((guix build download) #:select (maybe-expand-mirrors))
- #:use-module ((guix base64) #:select (base64-encode))
- #:use-module ((guix describe) #:select (current-profile))
- #:use-module ((guix config) #:select (%guix-version))
- #:use-module (guix gexp)
- #:use-module (json)
- #:use-module (ice-9 match)
- #:use-module ((web uri) #:select (string->uri uri->string))
- #:export (builder))
-
-;;; Required by 'origin->json' for 'computed-origin-method' corner cases
-(define gexp-references (@@ (guix gexp) gexp-references))
-
-;;;
-;;; Application builder.
-;;;
-
-(define (builder site posts)
- "Return the list of web resources that compose the app.
-
- This procedure is a Haunt builder procedure.
-
- SITE (<site>)
- A site object that defines all the properties of the website. See
- Haunt <site> objects for more information.
-
- POSTS (list of <post>)
- A list of post objects that represent articles from the blog. See
- Haunt <post> objects for more information.
-
- RETURN (list of <page>)
- A list of page objects that represent the web resources of the
- application. See Haunt <page> objects for more information."
- (flatten
- (list
- (index-builder)
- (sources-json-builder)
- (packages-json-builder)
- (packages-builder)
- (package-list-builder))))
-
-
-
-;;;
-;;; Helper builders.
-;;;
-
-(define %max-packages-on-index
- ;; Maximum number of packages shown on /packages.
- 30)
-
-(define (origin->json origin)
- "Return a JSON representation (an alist) of ORIGIN."
- (define method
- (origin-method origin))
-
- (define uri
- (origin-uri origin))
-
- (define (resolve urls)
- (map uri->string
- (append-map (cut maybe-expand-mirrors <> %mirrors)
- (map string->uri urls))))
-
- (if (eq? method (@@ (guix packages) computed-origin-method))
- ;; Packages in gnu/packages/gnuzilla.scm and gnu/packages/linux.scm
- ;; represent their 'uri' as 'promise'.
- (match uri
- ((? promise? promise)
- (match (force promise)
- ((? gexp? g)
- (append-map origin->json
- (filter-map (match-lambda
- ((? gexp-input? thing)
- (match (gexp-input-thing thing)
- ((? origin? o) o)
- (_ #f)))
- (_ #f))
- (gexp-references g))))
- (_ `((type . #nil))))))
- ;;Regular packages represent 'uri' as string.
- `(((type . ,(cond ((or (eq? url-fetch method)
- (eq? url-fetch/tarbomb method)
- (eq? url-fetch/zipbomb method)) 'url)
- ((eq? git-fetch method) 'git)
- ((or (eq? svn-fetch method)
- (eq? svn-multi-fetch method)) 'svn)
- ((eq? hg-fetch method) 'hg)
- (else #nil)))
- ,@(cond ((or (eq? url-fetch method)
- (eq? url-fetch/tarbomb method)
- (eq? url-fetch/zipbomb method))
- `(("urls" . ,(list->vector
- (resolve
- (match uri
- ((? string? url) (list url))
- ((urls ...) urls)))))))
- ((eq? git-fetch method)
- `(("git_url" . ,(git-reference-url uri))))
- ((eq? svn-fetch method)
- `(("svn_url" . ,(svn-reference-url uri))))
- ((eq? svn-multi-fetch method)
- `(("svn_url" . ,(svn-multi-reference-url uri))))
- ((eq? hg-fetch method)
- `(("hg_url" . ,(hg-reference-url uri))))
- (else '()))
- ,@(if (or (eq? url-fetch method)
- (eq? url-fetch/tarbomb method)
- (eq? url-fetch/zipbomb method))
- (let* ((content-hash (origin-hash origin))
- (hash-value (content-hash-value content-hash))
- (hash-algorithm (content-hash-algorithm content-hash))
- (algorithm-string (symbol->string hash-algorithm)))
- `(("integrity" . ,(string-append algorithm-string "-"
- (base64-encode hash-value)))))
- '())
- ,@(if (eq? method git-fetch)
- `(("git_ref" . ,(git-reference-commit uri)))
- '())
- ,@(if (eq? method svn-fetch)
- `(("svn_revision" . ,(svn-reference-revision uri)))
- '())
- ,@(if (eq? method svn-multi-fetch)
- `(("svn_revision" . ,(svn-multi-reference-revision uri)))
- '())
- ,@(if (eq? method hg-fetch)
- `(("hg_changeset" . ,(hg-reference-changeset uri)))
- '())))))
-
-(define (packages-json-builder)
- "Return a JSON page listing all packages."
- (define (package->json package)
- (define cpe-name
- (assoc-ref (package-properties package) 'cpe-name))
- (define cpe-version
- (assoc-ref (package-properties package) 'cpe-version))
-
- `(("name" . ,(package-name package))
- ("version" . ,(package-version package))
- ,@(if cpe-name `(("cpe_name" . ,cpe-name)) '())
- ,@(if cpe-version `(("cpe_version" . ,cpe-version)) '())
- ,@(if (origin? (package-source package))
- `(("source" . ,(list->vector
- (origin->json (package-source package)))))
- '())
- ("synopsis" . ,(package-synopsis package))
- ,@(if (package-home-page package)
- `(("homepage" . ,(package-home-page package)))
- '())
- ,@(match (package-location package)
- ((? location? location)
- `(("location"
- . ,(string-append (location-file location) ":"
- (number->string
- (+ 1 (location-line location)))))))
- (#f
- '()))))
-
- (make-page "packages.json"
- (list->vector (map package->json (all-packages)))
- scm->json))
-
-(define (sources-json-builder)
- "Return a JSON page listing all the sources."
- ;; The Software Heritage format is described here:
- ;; https://forge.softwareheritage.org/source/swh-loader-core/browse/master/swh/loader/package/nixguix/tests/data/https_nix-community.github.io/nixpkgs-swh_sources.json
- ;; And the loader is implemented here:
- ;; https://forge.softwareheritage.org/source/swh-loader-core/browse/master/swh/loader/package/nixguix/
- (define (package->json package)
- `(,@(if (origin? (package-source package))
- (origin->json (package-source package))
- `(((type . "no-origin")
- ("name" . ,(package-name package)))))))
-
- (make-page "sources.json"
- `(("sources" . ,(list->vector (append-map package->json (all-packages))))
- ("version" . "1")
- ("revision" .
- ,(match (current-profile)
- (#f %guix-version) ;for lack of a better ID
- (profile
- (let ((channel (find guix-channel? (profile-channels profile))))
- (channel-commit channel))))))
- scm->json))
-
-(define (index-builder)
- "Return a Haunt page listing some random packages."
- (define (sample n from)
- (map (lambda (id) (list-ref from id))
- (list-tabulate n (lambda _ (random (length from))))))
- (let ((context (list (cons "packages"
- (sample %max-packages-on-index
- (all-packages)))
- (cons "total"
- (length (all-packages))))))
- (make-page "packages/index.html" (index-t context) sxml->html)))
-
-
-(define (detailed-index-builder)
- "Return a Haunt page listing some random packages."
- ;; TODO: Pass ~30 random Guix packages.
- (let ((context (list (cons "packages"
- (take-at-most (all-packages)
- %max-packages-on-index)))))
- (make-page "packages/index.html"
- (detailed-index-t context (length (all-packages)))
- sxml->html)))
-
-
-(define (detailed-package-list-builder)
- "Return a list of grouped Haunt pages listing Guix packages.
-
- Each group is a list of page objects corresponding to paginated
- packages starting with a specific letter."
- (let ((package-groups (packages/group-by-letter (all-packages))))
- (map
- (lambda (package-group)
- (let* ((letter (car package-group))
- (context
- (list
- (cons "letter" letter))))
- (paginate #:dataset (cdr package-group)
- #:limit 100
- #:base-path (path-join "packages" letter)
- #:template detailed-package-list-t
- #:context context
- #:writer sxml->html)))
- package-groups)))
-
-
-(define (packages-builder)
- "Return a list of Haunt pages for each Guix package."
- (map
- (lambda (package)
- (let ((context (list (cons "package" package))))
- (make-page
- (path-join (package-url-path package) "index.html")
- (package-t context)
- sxml->html)))
- (all-packages)))
-
-
-(define (package-list-builder)
- "Return a list of grouped Haunt pages listing Guix packages.
-
- Each group is a list of page objects corresponding to paginated
- packages starting with a specific letter."
- (let ((package-groups (packages/group-by-letter (all-packages))))
- (map
- (lambda (package-group)
- (let* ((letter (car package-group))
- (context
- (list
- (cons "letter" letter))))
- (paginate #:dataset (cdr package-group)
- #:limit 100
- #:base-path (path-join "packages" letter)
- #:template package-list-t
- #:context context
- #:writer sxml->html)))
- package-groups)))
diff --git a/website/apps/packages/data.scm b/website/apps/packages/data.scm
deleted file mode 100644
index c80d979..0000000
--- a/website/apps/packages/data.scm
+++ /dev/null
@@ -1,63 +0,0 @@
-;;; GNU Guix web site
-;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2021 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2015 Mathieu Lirzin <mthl@openmailbox.org>
-;;; Copyright © 2013 Alex Sassmannshausen <alex.sassmannshausen@gmail.com>
-;;; Copyright © 2017 Eric Bavier <bavier@member.fsf.org>
-;;; Initially written by sirgazil who waives all copyright interest on this
-;;; file.
-;;;
-;;; This file is part of the GNU Guix web site.
-;;;
-;;; The GNU Guix web site 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.
-;;;
-;;; The GNU Guix web site 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 the GNU Guix web site. If not, see <http://www.gnu.org/licenses/>.
-
-
-(define-module (apps packages data)
- #:use-module (gnu packages)
- #:use-module (guix packages)
- #:export (all-packages
- alphabet))
-
-
-(define alphabet
- (list "0-9" "A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M"
- "N" "O" "P" "Q" "R" "S" "T" "U" "V" "W" "X" "Y" "Z"))
-
-
-(define %package-list
- (delay
- ;; Note: Dismiss packages found in $GUIX_PACKAGE_PATH.
- (let ((packages
- (sort (parameterize ((%package-module-path (last-pair
- (%package-module-path))))
- (fold-packages (lambda (package lst)
- (if (or (package-superseded package)
- (package-replacement package))
- lst
- (cons package lst)))
- '()))
- (lambda (p1 p2)
- (string<? (package-name p1)
- (package-name p2))))))
- (cond ((null? packages) '())
- ((string=? "yes"
- (or (getenv "GUIX_WEB_SITE_LOCAL") "no"))
- (list-head packages 300))
- (else packages)))))
-
-(define (all-packages)
- "Return the list of all Guix package objects, sorted by name.
-
- If GUIX_WEB_SITE_LOCAL=yes, return only 300 packages for
- testing the website."
- (force %package-list))
diff --git a/website/apps/packages/templates/components.scm b/website/apps/packages/templates/components.scm
deleted file mode 100644
index 767dc49..0000000
--- a/website/apps/packages/templates/components.scm
+++ /dev/null
@@ -1,275 +0,0 @@
-;;; GNU Guix web site
-;;; Initially written by sirgazil who waives all
-;;; copyright interest on this file.
-
-(define-module (apps packages templates components)
- #:use-module (apps aux lists)
- #:use-module (apps aux strings)
- #:use-module (apps aux web)
- #:use-module (apps base templates components)
- #:use-module (apps base utils)
- #:use-module (apps i18n)
- #:use-module (apps packages data)
- #:use-module (apps packages types)
- #:use-module (apps packages utils)
- #:use-module (guix licenses)
- #:use-module (guix packages)
- #:use-module ((guix i18n) #:select (P_))
- #:use-module (guix gnu-maintenance)
- #:use-module (srfi srfi-1)
- #:use-module (srfi srfi-26)
- #:use-module (texinfo)
- #:use-module (texinfo plain-text)
- #:export (detailed-package-preview
- issue-count->shtml
- letter-selector
- license->shtml
- lint-issue->shtml
- location->shtml
- package-preview
- patches->shtml
- sidebar
- supported-systems->shtml))
-
-
-;;;
-;;; Components.
-;;;
-
-(define (detailed-package-preview package)
- "Return an SHTML div element representing the given PACKAGE object.
-
- PACKAGE (<package>)
- A package object as defined in the GNU Guix API reference."
- `(div
- (@ (class "package-preview"))
- (h3
- (@ (class "package-name"))
- ,(package-name package) " " ,(package-version package) " "
- ,(if (package-issues? package) '(span (@ (class "red-tag")) "") " ")
- (span
- (@ (class "package-synopsis"))
- " — "
- ,(package-synopsis-shtml package)))
-
- (div
- (@ (class "package-description"))
-
- ;; 'gnu-package?' might fetch stuff from the network. Assume #f if that
- ;; doesn't work.
- ,(if (false-if-exception (gnu-package? package))
- `(p (i ,(G_ "This is a GNU package. ")))
- "")
-
- ,(package-description-shtml package))
-
- (ul
- (@ (class "package-info"))
- ,(G_ `(li ,(G_ `(b "License:")) " "
- ,(license->shtml (package-license package))
- "."))
-
- ,(G_ `(li ,(G_ `(b "Website:")) " "
- ,(link-subtle #:label (package-home-page package)
- #:url (package-home-page package)) "."))
-
- ,(G_ `(li ,(G_ `(b "Package source:")) " "
- ,(location->shtml (package-location package))
- "."))
-
- ,(G_ `(li ,(G_ `(b "Patches:")) " "
- ,(patches->shtml (package-patches package))
- "."))
-
- ,(G_ `(li ,(G_ `(b "Lint issues:")) " "
- ,(if (null? (package-lint-issues package))
- (G_ "No")
- (link-subtle #:label (G_ "Yes")
- #:url (guix-url "packages/issues/")))
- "."))
-
- ,(G_ `(li ,(G_ `(b "Builds:")) " "
- ,(supported-systems->shtml package) "."))
- "\n")))
-
-
-(define (issue-count->shtml count)
- "Return an SHTML representation of COUNT in the form 'X issue(s)'.
-
- COUNT (natural)
- A natural number.
-
- RETURN (shtml)
- A span element if the count is 0. A mark element otherwise."
- `(,(if (> count 0) 'mark 'span)
- ,(number->string count)
- ,(N_ " issue" " issues" count)))
-
-
-(define* (letter-selector #:optional (active-letter ""))
- "Return an SHTML section element representing a widget to list
- packages by initial.
-
- ACTIVE-LETTER (string)
- The letter that should be displayed as active."
- `(section
- (@ (class "letter-selector"))
- ,(G_ `(h3 (@ (class "a11y-offset")) "Packages menu: "))
-
- ,(G_ `(h4 (@ (class "selector-title selector-title-top"))
- "Browse alphabetically"))
- (div
- (@ (class "selector-box-padded"))
- ,@(map
- (lambda (letter)
- (list
- (button-little
- #:label letter
- #:url (guix-url (url-path-join "packages" letter ""))
- #:active (string=? letter active-letter))
- " ")) ; NOTE: Force space for readability in non-CSS browsers.
- alphabet))))
-
-
-(define (license->shtml license)
- "Return an SHTML representation of the LICENSE.
-
- LICENSE (itemization)
- One of two types of object:
- — A <license> object as defined in the (apps packages types)
- module.
- — A list of <license> objects.
-
- RETURN (shtml)
- One or more links to the licenses."
- (cond ((license? license)
- (link-subtle #:label (license-name license)
- #:url (license-uri license)))
- (else
- (separate
- (map (lambda (l) ; a license object.
- (link-subtle #:label (license-name l)
- #:url (license-uri l)))
- license)
- ", "))))
-
-
-(define (lint-issue->shtml issue)
- "Return an SHTML div element representing the given ISSUE object.
-
- ISSUE (<lint-issue>)
- A lint issue object as defined in the (apps packages types) module."
- `(div
- (@ (class "lint-issue"))
- (p (@ (class "lint-issue-type")) ,(lint-issue-type issue) ":")
- (pre ,(lint-issue-description issue))))
-
-
-(define (location->shtml loc)
- "Return an SHTML a element representing the given location LOC.
-
- LOC (<location>)
- A location object as defined in the GNU Guix API reference."
- (let ((ilink (location->ilink loc)))
- (link-subtle #:label (ilink-name ilink)
- #:url (ilink-url ilink))))
-
-
-(define (package-preview package)
- "Return an SHTML a element representing the given PACKAGE object.
-
- PACKAGE (<package>)
- A package object as defined in the GNU Guix API reference."
- `(a
- (@ (class "item-preview")
- (href ,(guix-url (url-path-join (package-url-path package) ""))))
- (h3 ,(package-name package) " " ,(package-version package))
- (p
- (@ (class "item-summary"))
- ,(string-summarize
- (stexi->plain-text
- (texi-fragment->stexi (P_ (package-description package))))
- 30)
- "…")))
-
-
-(define (patches->shtml patches)
- "Return an SHTML representation of PATCHES.
-
- PATCHES (list)
- A list of <link> objects as defined in (apps packages types)
- module.
-
- RETURN (shtml)
- If the list of patches is empty, return the string 'None'.
- Otherwise, return a list of links to patches."
- (if (null? patches)
- (C_ "patches" "None")
- (separate
- (map (lambda (patch)
- (link-subtle #:label (ilink-name patch)
- #:url (ilink-url patch)))
- patches)
- ", ")))
-
-
-(define* (sidebar #:optional (active-letter ""))
- "Return an SHTML section element representing the sidebar of the
- package list.
-
- ACTIVE-LETTER (string)
- The letter in which the current packages are listed."
- `(section
- (@ (class "side-bar"))
- ,(G_ `(h3 (@ (class "a11y-offset")) "Packages menu: "))
-
- ,(G_ `(h4 (@ (class "bar-title bar-title-top")) "Browse alphabetically"))
- (div
- (@ (class "bar-box-padded"))
- ,@(map
- (lambda (letter)
- (list
- (button-little
- #:label letter
- #:url (guix-url (url-path-join "packages" letter ""))
- #:active (string=? letter active-letter))
- " ")) ; NOTE: Force space for readability in non-CSS browsers.
- alphabet))
-
- ;; FIXME: This is currently too costly to produce so we just disable it.
-
- ;; ,(G_ `(h4 (@ (class "bar-title")) "Packages Issues"))
- ;; (ul
- ;; (@ (class "bar-list"))
- ;; (li (@ (class "bar-item"))
- ;; ,(G_ `(a (@ (class "bar-link")
- ;; (href ,(guix-url "packages/issues/lint/"))) "Lint")))
- ;; (li (@ (class "bar-item"))
- ;; ,(G_ `(a (@ (class "bar-link")
- ;; (href ,(guix-url "packages/issues/reproducibility/")))
- ;; "Reproducibility"))))
- ))
-
-
-(define (supported-systems->shtml package)
- "Return a list of SHTML a links to SYSTEMS builds.
-
- SYSTEMS (<package>)
- A package object as defined in Guix API.
-
- RETURN (shtml)
- If the list of supported systems of the package is empty, return
- the string 'None'. Otherwise, return a list of links to systems
- builds in hydra."
- (let ((build-url "https://ci.guix.gnu.org/job/gnu/master/")
- (package-id (string-append (package-name package)
- "-"
- (package-version package)))
- (systems (filter (cut supported-package? package <>)
- %cuirass-supported-systems)))
- (if (null? systems)
- (C_ "systems" "None")
- ;; TODO: There's currently no way to refer to a job like
- ;; 'coreutils-8.32' in the Cuirass web UI. Add such a link once it's
- ;; become available.
- (separate systems ", "))))
diff --git a/website/apps/packages/templates/detailed-index.scm b/website/apps/packages/templates/detailed-index.scm
deleted file mode 100644
index 698aac5..0000000
--- a/website/apps/packages/templates/detailed-index.scm
+++ /dev/null
@@ -1,66 +0,0 @@
-;;; GNU Guix web site
-;;; Initially written by sirgazil who waives all
-;;; copyright interest on this file.
-
-(define-module (apps packages templates detailed-index)
- #:use-module (apps aux web)
- #:use-module (apps base templates components)
- #:use-module (apps base templates theme)
- #:use-module (apps base types)
- #:use-module (apps base utils)
- #:use-module (apps i18n)
- #:use-module (apps packages templates components)
- #:use-module (srfi srfi-19)
- #:export (detailed-index-t))
-
-
-(define* (detailed-index-t context #:optional total)
- "Return SHTML index page for the package app. TOTAL is the total number of
-packages to advertise."
- (let ((packages (context-datum context "packages")))
- (theme
- #:title (C_ "webpage title" (list "Packages"))
- #:description
- (G_ "List of packages available through GNU Guix.")
- #:keywords
- (string-split ;TRANSLATORS: |-separated list of webpage keywords
- (G_ "GNU|Linux|Unix|Free software|Libre software|Operating \
-system|GNU Hurd|GNU Guix package manager|GNU Guile|Guile \
-Scheme|Transactional upgrades|Functional package \
-management|Reproducibility") #\|)
- #:active-menu-item (C_ "website menu" "Packages")
- #:css
- (list (guix-url "static/base/css/page.css")
- (guix-url "static/base/css/item-preview.css")
- (guix-url "static/packages/css/letter-selector.css")
- (guix-url "static/packages/css/package-list.css"))
- #:crumbs
- (list (crumb (C_ "website menu" "Packages") (guix-url "packages/")))
- #:content
- `(main
- (section
- (@ (class "page centered-text"))
- ,(G_ `(h2 "Packages"))
-
- ,(G_
- `(p
- (@ (class "limit-width centered-block"))
- "GNU Guix provides " ,(number* (or total (length packages)))
- " packages transparently "
- ,(G_
- `(a (@ (href "https://www.gnu.org/software/guix/manual/en/html_node/Substitutes.html"))
- "available as pre-built binaries"))
- ". These pages provide a complete list of the packages. Our "
- ,(G_
- `(a (@ (href "https://ci.guix.gnu.org/jobset/master"))
- "continuous integration system"))
- " shows their current build status "
- "(updated " ,(date->string (current-date)
- (C_ "SRFI-19 date->string format"
- "~B ~e, ~Y")) ")."))
-
- (div
- (@ (class "sheet sheet-padded justify-left"))
- ,(letter-selector)
- ,@(map detailed-package-preview packages)
- ,(letter-selector)))))))
diff --git a/website/apps/packages/templates/detailed-package-list.scm b/website/apps/packages/templates/detailed-package-list.scm
deleted file mode 100644
index 1332c98..0000000
--- a/website/apps/packages/templates/detailed-package-list.scm
+++ /dev/null
@@ -1,67 +0,0 @@
-;;; GNU Guix web site
-;;; Initially written by sirgazil who waives all
-;;; copyright interest on this file.
-
-(define-module (apps packages templates detailed-package-list)
- #:use-module (apps aux web)
- #:use-module (apps base templates components)
- #:use-module (apps base templates theme)
- #:use-module (apps base types)
- #:use-module (apps base utils)
- #:use-module (apps i18n)
- #:use-module (apps packages templates components)
- #:export (detailed-package-list-t))
-
-
-(define (detailed-package-list-t context)
- "Return an SHTML page listing the packages in the CONTEXT."
- (let ((letter (context-datum context "letter"))
- (page-number
- (number->string (context-datum context "page-number")))
- (total-pages
- (number->string (context-datum context "total-pages"))))
- (theme
- #:title (list (G_ (string-append "Page " page-number ""))
- letter (C_ "webpage title" "Packages"))
- #:description
- (G_ "List of packages available through GNU Guix.")
- #:keywords
- (string-split ;TRANSLATORS: |-separated list of webpage keywords
- (G_ "GNU|Linux|Unix|Free software|Libre software|Operating \
-system|GNU Hurd|GNU Guix package manager|GNU Guile|Guile \
-Scheme|Transactional upgrades|Functional package \
-management|Reproducibility") #\|)
- #:active-menu-item (C_ "website menu" "Packages")
- #:css
- (list (guix-url "static/base/css/page.css")
- (guix-url "static/base/css/item-preview.css")
- (guix-url "static/packages/css/letter-selector.css")
- (guix-url "static/packages/css/package-list.css"))
- #:scripts
- (list (guix-url "static/packages/js/build-status.js"))
- #:crumbs
- (list (crumb (C_ "website menu" "Packages") (guix-url "packages/"))
- (crumb letter (guix-url (url-path-join "packages"
- letter
- "")))
- (crumb (G_ (string-append "Page " page-number ""))
- (guix-url (url-path-join "packages"
- "page"
- page-number
- ""))))
- #:content
- `(main
- (section
- (@ (class "page centered-text"))
- (h2 (G_ "Packages — ") ,letter
- ,(page-indicator (string->number page-number)
- (string->number total-pages)))
-
- (div
- (@ (class "sheet sheet-padded justify-left"))
- ,(letter-selector letter)
- ,@(map detailed-package-preview (context-datum context "items"))
- ,(letter-selector letter)
- ,(page-selector (string->number total-pages)
- (string->number page-number)
- (guix-url (url-path-join "packages" letter)))))))))
diff --git a/website/apps/packages/templates/index.scm b/website/apps/packages/templates/index.scm
deleted file mode 100644
index feec755..0000000
--- a/website/apps/packages/templates/index.scm
+++ /dev/null
@@ -1,64 +0,0 @@
-;;; GNU Guix web site
-;;; Initially written by sirgazil who waives all
-;;; copyright interest on this file.
-
-(define-module (apps packages templates index)
- #:use-module (apps aux web)
- #:use-module (apps base templates components)
- #:use-module (apps base templates theme)
- #:use-module (apps base types)
- #:use-module (apps base utils)
- #:use-module (apps i18n)
- #:use-module (apps packages templates components)
- #:use-module (srfi srfi-19)
- #:export (index-t))
-
-
-(define (index-t context)
- "Return an SHTML representation of the index page."
- (let ((packages (context-datum context "packages"))
- (total (context-datum context "total")))
- (theme
- #:title (C_ "webpage title" (list "Packages"))
- #:description
- (G_ "List of packages available through GNU Guix.")
- #:keywords
- (string-split ;TRANSLATORS: |-separated list of webpage keywords
- (G_ "GNU|Linux|Unix|Free software|Libre software|Operating \
-system|GNU Hurd|GNU Guix package manager|GNU Guile|Guile \
-Scheme|Transactional upgrades|Functional package \
-management|Reproducibility") #\|)
- #:active-menu-item (C_ "website menu" "Packages")
- #:css
- (list (guix-url "static/base/css/page.css")
- (guix-url "static/base/css/item-preview.css")
- (guix-url "static/packages/css/letter-selector.css"))
- #:crumbs
- (list (crumb (C_ "website menu" "Packages") (guix-url "packages/")))
- #:content
- `(main
- (section
- (@ (class "page centered-text"))
- ,(G_ `(h2 "Packages"))
-
- ,(G_
- `(p
- (@ (class "limit-width centered-block"))
- "GNU Guix provides " ,(number* total) " packages transparently "
- ,(G_
- `(a (@ (href "https://www.gnu.org/software/guix/manual/en/html_node/Substitutes.html"))
- "available as pre-built binaries"))
- ". These pages provide a complete list of the packages. Our "
- ,(G_
- `(a (@ (href "https://ci.guix.gnu.org/jobset/master"))
- "continuous integration system"))
- " shows their current build status "
- "(updated " ,(date->string (current-date)
- (C_ "SRFI-19 date->string format"
- "~B ~e, ~Y")) ")."))
-
- (div
- (@ (class "sheet"))
- ,(letter-selector)
- ,@(map package-preview packages)
- ,(letter-selector)))))))
diff --git a/website/apps/packages/templates/package-list.scm b/website/apps/packages/templates/package-list.scm
deleted file mode 100644
index eca8a5e..0000000
--- a/website/apps/packages/templates/package-list.scm
+++ /dev/null
@@ -1,65 +0,0 @@
-;;; GNU Guix web site
-;;; Initially written by sirgazil who waives all
-;;; copyright interest on this file.
-
-(define-module (apps packages templates package-list)
- #:use-module (apps aux web)
- #:use-module (apps base templates components)
- #:use-module (apps base templates theme)
- #:use-module (apps base types)
- #:use-module (apps base utils)
- #:use-module (apps i18n)
- #:use-module (apps packages templates components)
- #:export (package-list-t))
-
-
-(define (package-list-t context)
- "Return a list of packages in SHTML with the data in CONTEXT."
- (let ((letter (context-datum context "letter"))
- (page-number
- (number->string (context-datum context "page-number")))
- (total-pages
- (number->string (context-datum context "total-pages"))))
- (theme
- #:title (list (G_ (string-append "Page " page-number ""))
- letter (C_ "webpage title" "Packages"))
- #:description
- "List of packages available through GNU Guix."
- #:keywords
- (string-split ;TRANSLATORS: |-separated list of webpage keywords
- (G_ "GNU|Linux|Unix|Free software|Libre software|Operating \
-system|GNU Hurd|GNU Guix package manager|GNU Guile|Guile \
-Scheme|Transactional upgrades|Functional package \
-management|Reproducibility") #\|)
- #:index? #false
- #:active-menu-item (C_ "website menu" "Packages")
- #:css
- (list (guix-url "static/base/css/page.css")
- (guix-url "static/base/css/item-preview.css")
- (guix-url "static/packages/css/letter-selector.css"))
- #:crumbs
- (list (crumb (C_ "website menu" "Packages") (guix-url "packages/"))
- (crumb letter (guix-url (url-path-join "packages"
- letter
- "")))
- (crumb (G_ (string-append "Page " page-number ""))
- (guix-url (url-path-join "packages"
- "page"
- page-number
- ""))))
- #:content
- `(main
- (section
- (@ (class "page centered-text"))
- (h2 (G_ "Packages — ") ,letter
- ,(page-indicator (string->number page-number)
- (string->number total-pages)))
-
- (div
- (@ (class "sheet"))
- ,(letter-selector letter)
- ,@(map package-preview (context-datum context "items"))
- ,(letter-selector letter)
- ,(page-selector (string->number total-pages)
- (string->number page-number)
- (guix-url (url-path-join "packages" letter)))))))))
diff --git a/website/apps/packages/templates/package.scm b/website/apps/packages/templates/package.scm
deleted file mode 100644
index aa3dcf0..0000000
--- a/website/apps/packages/templates/package.scm
+++ /dev/null
@@ -1,87 +0,0 @@
-;;; GNU Guix web site
-;;; Initially written by sirgazil who waives all
-;;; copyright interest on this file.
-
-(define-module (apps packages templates package)
- #:use-module (apps aux web)
- #:use-module (apps base templates components)
- #:use-module (apps base templates theme)
- #:use-module (apps base types)
- #:use-module (apps base utils)
- #:use-module (apps i18n)
- #:use-module (apps packages templates components)
- #:use-module (apps packages types)
- #:use-module (apps packages utils)
- #:use-module (guix gnu-maintenance)
- #:use-module (guix packages)
- #:export (package-t))
-
-
-(define (package-t context)
- "Return an SHTML representation of a package page."
- (let* ((package (context-datum context "package"))
- (package-id (string-append (package-name package)
- " "
- (package-version package)))
- (lint-issues (package-lint-issues package)))
- (theme
- #:title (C_ "webpage title" (list package-id "Packages"))
- #:description (package-synopsis-shtml package)
- #:keywords
- (string-split ;TRANSLATORS: |-separated list of webpage keywords
- (G_ "GNU|Linux|Unix|Free software|Libre software|Operating \
-system|GNU Hurd|GNU Guix package manager|GNU Guile|Guile \
-Scheme|Transactional upgrades|Functional package \
-management|Reproducibility") #\|)
- #:active-menu-item (C_ "website menu" "Packages")
- #:css
- (list (guix-url "static/base/css/page.css")
- (guix-url "static/packages/css/package.css"))
- #:crumbs
- (list (crumb (C_ "website menu" "Packages") (guix-url "packages/"))
- (crumb package-id
- (guix-url (package-url-path package))))
- #:content
- `(main
- (article
- (@ (class "page centered-block limit-width"))
- (h2 ,package-id " "
- (span
- (@ (class "synopsis"))
- ,(package-synopsis-shtml package)))
-
- ;; 'gnu-package?' might fetch stuff from the network. Assume #f if
- ;; that doesn't work.
- (p ,(if (false-if-exception (gnu-package? package))
- (G_ '(it "This is a GNU package. "))
- "")
- ,(package-description-shtml package))
-
- (ul
- (@ (class "package-info"))
- ,(G_ `(li ,(G_ `(b "Website: "))
- (a (@ (href ,(package-home-page package)))
- ,(package-home-page package))))
- ,(G_ `(li ,(G_ `(b "License: "))
- ,(license->shtml (package-license package))))
- ,(G_ `(li ,(G_ `(b "Package source: "))
- ,(location->shtml (package-location package))))
- ,(G_ `(li ,(G_ `(b "Patches: "))
- ,(patches->shtml (package-patches package))))
- ,(G_ `(li ,(G_ `(b "Builds: "))
- ,(supported-systems->shtml package))))
-
- ;; Lint issues.
- ,(if (null? lint-issues)
- ""
- (G_ `(,(G_ `(h3 "Lint issues"))
- ,(G_
- `(p
- ""
- ,(issue-count->shtml
- (length lint-issues))
- ". "
- "See " ,(G_ `(a (@ (href "#")) "package definition"))
- " in Guix source code."))
-
- ,@(map lint-issue->shtml lint-issues)))))))))
diff --git a/website/apps/packages/types.scm b/website/apps/packages/types.scm
deleted file mode 100644
index 2b777bf..0000000
--- a/website/apps/packages/types.scm
+++ /dev/null
@@ -1,109 +0,0 @@
-;;; GNU Guix web site
-;;; Initially written by sirgazil who waives all
-;;; copyright interest on this file.
-
-(define-module (apps packages types)
- #:use-module (srfi srfi-9)
- #:export (ilink
- ilink?
- ilink-name
- ilink-url
- lint-issue
- lint-issue?
- lint-issue-type
- lint-issue-description))
-
-
-;;;
-;;; Data types.
-;;;
-
-;;; License (record type)
-;;; ---------------------
-;;;
-;;; A license object represents a copyright license or public domain
-;;; dedication.
-;;;
-;;; Objects of this type can be created with the "license" procedure
-;;; as well (see Helper procedures below).
-;;;
-;;; Fields:
-;;;
-;;; name (string)
-;;; The human readable name of the license. For example: "GPL 2+",
-;;; "CC-BY-SA 3.0", etc.
-;;;
-;;; uri (string)
-;;; The URL to the definition of the license on the web.
-;;;
-;;; comment (string)
-;;; A comment about the license?
-;;;
-(define-record-type <license>
- (make-license name uri comment)
- license?
- (name license-name)
- (uri license-uri)
- (comment license-comment))
-
-;;; Helper procedures.
-
-(define* (license #:key name uri (comment ""))
- "Return a <license> object with the given attributes."
- (make-license name uri comment))
-
-
-
-;;; ILink (record type)
-;;; -------------------
-;;;
-;;; A link to a web resource.
-;;;
-;;; Fields:
-;;;
-;;; name (string)
-;;; A descriptive name for the link. For example:
-;;; "i686 build", "graphics.scm", etc.
-;;;
-;;; url (string)
-;;; The URL to the web resource.
-;;;
-(define-record-type <ilink>
- (ilink name url)
- ilink?
- (name ilink-name)
- (url ilink-url))
-
-
-
-;;; Lint Issue (record type)
-;;; ------------------------
-;;;
-;;; A lint issue object represents an issue reported by any of the lint
-;;; checkers available for GNU Guix (see `guix lint --list-checkers`).
-;;;
-;;; Objects of this type can be created with the "lint-issue" procedure
-;;; as well (see Helper procedures below).
-;;;
-;;; Fields:
-;;;
-;;; type (string)
-;;; The name of the checker the issue belongs to. For example:
-;;; "home-page", "license", "source", etc.
-;;;
-;;; See `guix lint --list-checkers` for all the names of the checkers.
-;;;
-;;; description (string)
-;;; The details of the issue.
-;;;
-(define-record-type <lint-issue>
- (make-lint-issue type description)
- lint-issue?
- (type lint-issue-type)
- (description lint-issue-description))
-
-;;; Helper procedures.
-
-(define (lint-issue type description)
- "Return a <lint-issue> object with the given attributes."
- (make-lint-issue type description))
diff --git a/website/apps/packages/utils.scm b/website/apps/packages/utils.scm
deleted file mode 100644
index 50e56b0..0000000
--- a/website/apps/packages/utils.scm
+++ /dev/null
@@ -1,282 +0,0 @@
-;;; GNU Guix web site
-;;; Copyright © 2017, 2022 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2017 Eric Bavier <bavier@member.fsf.org>
-;;; Copyright © 2020 Ricardo Wurmus <rekado@elephly.net>
-;;;
-;;; Initially written by sirgazil
-;;; who waives all copyright interest on this file.
-;;;
-;;; This file is part of the GNU Guix web site.
-;;;
-;;; The GNU Guix web site 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.
-;;;
-;;; The GNU Guix web site 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 the GNU Guix web site. If not, see <http://www.gnu.org/licenses/>.
-
-(define-module (apps packages utils)
- #:use-module (apps aux web)
- #:use-module (apps base utils)
- #:use-module (apps i18n)
- #:use-module (apps packages data)
- #:use-module (apps packages types)
- #:use-module (guix packages)
- #:use-module ((guix i18n) #:select (P_))
- #:use-module (guix utils)
- #:use-module (guix build utils)
- #:use-module (guix build download)
- #:use-module (guix download)
- #:use-module (srfi srfi-1)
- #:use-module (srfi srfi-26)
- #:use-module (sxml transform)
- #:use-module (texinfo)
- #:use-module (texinfo html)
- #:use-module (ice-9 match)
- #:use-module (ice-9 rdelim)
- #:use-module (ice-9 popen)
- #:use-module (web uri)
- #:export (take-at-most
-
- package-description-shtml
- package-synopsis-shtml
-
- location->ilink
- package-build-issues
- package-issues?
- package-lint-issues
- package-patches
- package-url-path
- packages/group-by-letter))
-
-
-;;;
-;;; Helper procedures.
-;;;
-
-(define (take-at-most lst max)
- "Take up to MAX elements from LST."
- (let loop ((lst lst)
- (result '())
- (total 0))
- (match lst
- (()
- (reverse result))
- ((head . tail)
- (if (>= total max)
- (reverse result)
- (loop tail (cons head result) (+ 1 total)))))))
-
-(define (texinfo->shtml texi)
- "Parse TEXI, a string, and return the corresponding SHTML."
- ;; 'texi-fragment->stexi' uses 'call-with-input-string', so make sure
- ;; those string ports are Unicode-capable.
- (with-fluids ((%default-port-encoding "UTF-8"))
- (let ((shtml (stexi->shtml (texi-fragment->stexi texi))))
- (pre-post-order shtml
- `((*ENTITY*
- . ,(lambda (tag entity)
- (match entity
- ("nbsp" (string #\xa0))
- ("hellip" (string #\x2026))
- (_ " "))))
- (*default*
- . ,(lambda args args))
- (*text*
- . ,(lambda (_ txt) txt)))))))
-
-(define (package-description-shtml package)
- "Return a SXML representation of PACKAGE description field with HTML
-vocabulary."
- (and=> (and=> (package-description package) P_) texinfo->shtml))
-
-(define (package-synopsis-shtml package)
- "Return a SXML representation of PACKAGE synopsis field with HTML
-vocabulary."
- (and=> (and=> (package-synopsis package) P_)
- (lambda (synopsis)
- ;; Strip the paragraph that 'texinfo->shtml' adds.
- (match (texinfo->shtml synopsis)
- (('div ('p text ...))
- text)
- (text ;fishy description
- text)))))
-
-(define git-description
- (delay
- (let* ((guix (find (lambda (p)
- (file-exists? (string-append p "/guix/config.scm")))
- %load-path))
- (pipe (with-directory-excursion guix
- (open-pipe* OPEN_READ "git" "describe")))
- (desc (read-line pipe))
- (git? (close-pipe pipe)))
- (and (zero? git?) desc))))
-
-(define (location->ilink loc)
- "Convert the given location LOC into an Ilink.
-
- LOC (<location>)
- A location object as defined in the GNU Guix API reference.
-
- RETURN (<ilink>)
- An Ilink object as defined in (apps packages types)."
- (ilink (basename (location-file loc))
- (guix-git-tree-url
- (string-append (location-file loc)
- (or (and=> (force git-description)
- (cut string-append "?id=" <>))
- "")
- "#n"
- (number->string (location-line loc))))))
-
-
-;;; TODO: Stub. Implement.
-;;; https://bitbucket.org/sirgazil/guixsd-website/issues/45/
-(define (package-build-issues package)
- "Return the list of build issues for the given PACKAGE.
-
- PACKAGE (<package>)
- A package object as defined in the GNU Guix API reference.
-
- RETURN (list)
- A list of <location> objects as defined in (apps packages types)
- that represent build issues."
- (list))
-
-
-;;; TODO: Add unit tests.
-;;; https://bitbucket.org/sirgazil/guixsd-website/issues/44/
-(define (package-issues? package)
- "Return true if the PACKAGE has lint or build issues.
-
- PACKAGE (<package>)
- A package object as defined in the GNU Guix API reference."
- (or (not (null? (package-lint-issues package)))
- (not (null? (package-build-issues package)))))
-
-
-;;; TODO: Stub. Implement.
-;;; https://bitbucket.org/sirgazil/guixsd-website/issues/43/
-(define (package-lint-issues package)
- "Return the list of lint issues for the given PACKAGE.
-
- PACKAGE (<package>)
- A package object as defined in the GNU Guix API reference.
-
- RETURN (list)
- A list of <lint-issue> objects as defined in (apps packages types)."
- (list))
-
-
-(define (package-patches package)
- "Return the list of patches for the given PACKAGE.
-
- PACKAGE (<package>)
- A package object as defined in the GNU Guix API reference.
-
- RETURN (list)
- A list of <link> objects as defined in (apps packages types)
- representing patches."
- (define patch-url
- (match-lambda
- ((? string? patch)
- (string-append
- "//git.savannah.gnu.org/cgit/guix.git/tree/gnu/packages/patches/"
- (basename patch)))
- ((? origin? patch)
- (uri->string
- (first (maybe-expand-mirrors (string->uri
- (match (origin-uri patch)
- ((? string? uri) uri)
- ((head . tail) head)))
- %mirrors))))
- (_
- ;; It might be a <file-append> or some other file-like object.
- #f)))
-
- (define patch-name
- (match-lambda
- ((? string? patch)
- (basename patch))
- ((? origin? patch)
- (match (origin-file-name patch)
- (#f
- (match (origin-uri patch)
- ((? string? uri) (basename uri))
- ((head . tail) (basename head))))
- (file
- file)))))
-
- (define (snippet-link)
- (let* ((loc (or (package-field-location package 'source)
- (package-location package)))
- (link (location->ilink loc)))
- (ilink "snippet" (ilink-url link))))
-
- (define patches
- (filter-map (lambda (patch)
- (let ((url (patch-url patch)))
- (and url
- (ilink `(span (@ (class "mono")) ,(patch-name patch))
- (patch-url patch)))))
- (match (package-source package)
- (#f '())
- ((? origin? o) (origin-patches o)))))
-
- (define snippet
- (match (package-source package)
- (#f
- #f)
- ((? origin? o)
- (and (origin-snippet o)
- (snippet-link)))))
-
- (if snippet
- (cons snippet patches)
- patches))
-
-
-(define (package-url-path package)
- "Return a URL path for the PACKAGE in the form packages/NAME-VERSION/.
-
- PACKAGE (<package>)
- A package object as defined in the GNU Guix API reference."
- (url-path-join "packages"
- (string-append (package-name package)
- "-"
- (package-version package))))
-
-
-(define (packages/group-by-letter packages)
- "Return a list of alphabetically grouped packages.
-
- PACKAGES (list)
- A list of package objects as defined in the GNU Guix API reference.
-
- RETURN (list)
- A list of lists of packages where each list corresponds to the
- packages whose name starts with a specific letter."
- (define (starts-with-digit? package)
- (char-set-contains? char-set:digit
- (string-ref (package-name package) 0)))
-
- (define (starts-with-letter? letter)
- (let ((letter (string-downcase letter)))
- (lambda (package)
- (string-prefix? letter (package-name package)))))
-
- (map (lambda (letter)
- (match letter
- ("0-9"
- (cons letter (filter starts-with-digit? packages)))
- (_
- (cons letter
- (filter (starts-with-letter? letter) packages)))))
- alphabet))
diff --git a/website/haunt.scm b/website/haunt.scm
index 01e2af7..455bdc8 100644
--- a/website/haunt.scm
+++ b/website/haunt.scm
@@ -7,7 +7,6 @@
((apps download builder) #:prefix download:)
(apps i18n)
((apps media builder) #:prefix media:)
- ((apps packages builder) #:prefix packages:)
(haunt asset)
(haunt builder assets)
(haunt reader)
@@ -25,5 +24,4 @@
blog:builder
download:builder
media:builder
- packages:builder
(static-directory "static"))))
diff --git a/website/tests/all.scm b/website/tests/all.scm
index a984002..ae4fb1d 100644
--- a/website/tests/all.scm
+++ b/website/tests/all.scm
@@ -10,5 +10,4 @@
(tests apps aux system)
(tests apps aux web)
(tests apps base types)
- (tests apps blog utils)
- (tests apps packages utils))
+ (tests apps blog utils))
diff --git a/website/tests/apps/packages/utils.scm b/website/tests/apps/packages/utils.scm
deleted file mode 100644
index 4ee38b2..0000000
--- a/website/tests/apps/packages/utils.scm
+++ /dev/null
@@ -1,107 +0,0 @@
-;;; GNU Guix web site
-;;; Initially written by sirgazil who waives all
-;;; copyright interest on this file.
-
-(define-module (tests apps packages utils)
- #:use-module (apps packages types)
- #:use-module (apps packages utils)
- #:use-module (guix packages)
- #:use-module (srfi srfi-64))
-
-
-;;;
-;;; Constants.
-;;;
-
-(define SUITE_NAME "apps-packages-utils")
-
-
-
-;;;
-;;; Test suite.
-;;;
-
-(test-begin SUITE_NAME)
-
-;;; FIXME: Rewrite with real Guix packages in mind.
-;;;
-;; (test-group
-;; "[procedure] package-issues?"
-
-;; (test-equal
-;; "Return false if the package has no lint nor build issues."
-;; (package-issues? (package #:name "arau"))
-;; #false)
-
-;; (test-equal
-;; "Return true if the package has lint issues."
-;; (package-issues? (package #:name "arau"
-;; #:lint-issues '((lint-issue "A" "...")
-;; (lint-issue "B" "...")
-;; (lint-issue "C" "..."))))
-;; #true)
-
-;; (test-equal
-;; "Return true if the package has build issues."
-;; (package-issues? (package #:name "kiwi" #:build-issues '(""))) ; FIXME: Pass a real issue object.
-;; #true))
-
-
-;;; FIXME: Rewrite with real Guix packages in mind.
-;;;
-;; (test-group
-;; "[procedure] package-url-path"
-
-;; (test-equal
-;; "Return the correct URL path to the package."
-;; (package-url-path (package #:name "arau" #:version "1.0.0"))
-;; "packages/arau-1.0.0"))
-
-
-;;; FIXME: Rewrite with real Guix packages in mind.
-;;;
-;; (test-group
-;; "[procedure] packages/group-by-letter"
-
-;; (test-equal
-;; "Return an empty list if there are no packages."
-;; (packages/group-by-letter '())
-;; '())
-
-;; (test-equal
-;; "Group packages by letter."
-;; (packages/group-by-letter (list (package #:name "agua")
-;; (package #:name "azul")
-;; (package #:name "fuego")
-;; (package #:name "tierra")))
-;; (list
-;; (cons "0-9" '())
-;; (cons "A" (list (package #:name "agua") (package #:name "azul")))
-;; (cons "B" '())
-;; (cons "C" '())
-;; (cons "D" '())
-;; (cons "E" '())
-;; (cons "F" (list (package #:name "fuego")))
-;; (cons "G" '())
-;; (cons "H" '())
-;; (cons "I" '())
-;; (cons "J" '())
-;; (cons "K" '())
-;; (cons "L" '())
-;; (cons "M" '())
-;; (cons "N" '())
-;; (cons "O" '())
-;; (cons "P" '())
-;; (cons "Q" '())
-;; (cons "R" '())
-;; (cons "S" '())
-;; (cons "T" (list (package #:name "tierra")))
-;; (cons "U" '())
-;; (cons "V" '())
-;; (cons "W" '())
-;; (cons "X" '())
-;; (cons "Y" '())
-;; (cons "Z" '()))))
-
-
-(test-end SUITE_NAME)
base-commit: c9b6bc1993cd59648d393b840f116d11903a3184
--
2.38.0
[-- Attachment #1.3: publickey - luis.felipe.la@protonmail.com - 0x12DE1598.asc --]
[-- Type: application/pgp-keys, Size: 1722 bytes --]
[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 509 bytes --]
^ permalink raw reply related [flat|nested] 7+ messages in thread