[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
branch master updated: website: Remove most of the packages app.
|
From: |
Ludovic Courtès |
|
Subject: |
branch master updated: website: Remove most of the packages app. |
|
Date: |
Fri, 25 Nov 2022 11:45:27 -0500 |
This is an automated email from the git hooks/post-receive script.
civodul pushed a commit to branch master
in repository guix-artwork.
The following commit(s) were added to refs/heads/master by this push:
new 412ac39 website: Remove most of the packages app.
412ac39 is described below
commit 412ac3958bf288c56fded35d0a632c530e57ef8f
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Fri Nov 25 17:40:28 2022 +0100
website: Remove most of the packages app.
This functionality is now provided by packages.guix.gnu.org, except for
'sources.json' and 'packages.json', which we keep here.
* website/apps/packages/types.scm, website/apps/packages/utils.scm,
website/apps/packages/templates: Remove.
* website/apps/packages/builder.scm (builder): Keep nothing but
'sources-json-builder' and 'packages-json-builder'.
---
website/apps/packages/builder.scm | 102 +-------
website/apps/packages/templates/components.scm | 275 --------------------
website/apps/packages/templates/detailed-index.scm | 66 -----
.../packages/templates/detailed-package-list.scm | 67 -----
website/apps/packages/templates/index.scm | 64 -----
website/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/tests/all.scm | 3 +-
website/tests/apps/packages/utils.scm | 107 --------
11 files changed, 4 insertions(+), 1223 deletions(-)
diff --git a/website/apps/packages/builder.scm
b/website/apps/packages/builder.scm
index b08ba2e..dc40ff6 100644
--- a/website/apps/packages/builder.scm
+++ b/website/apps/packages/builder.scm
@@ -1,5 +1,5 @@
;;; GNU Guix web site
-;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017, 2022 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>
@@ -23,20 +23,9 @@
;;; 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)
@@ -78,13 +67,8 @@
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))))
+ (list (sources-json-builder)
+ (packages-json-builder)))
@@ -92,10 +76,6 @@
;;; 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
@@ -230,79 +210,3 @@
(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/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/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)
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- branch master updated: website: Remove most of the packages app.,
Ludovic Courtès <=