website: Incorporate sirgazil's major update.

Copied by Ludovic from https://bitbucket.org/sirgazil/guixsd-website
hg changeset 209:ce9d62df07f2.

11 files changed, 678 insertions, 0 deletions

diff --git a/website/tests/README.org b/website/tests/README.org
new file mode 100644
index 0000000..9e1f0e3
--- /dev/null
+++ b/website/tests/README.org
@@ -0,0 +1,31 @@
+#+TITLE: Web site test suite
+
+
+* Introduction
+
+Guile comes with support for [[https://www.gnu.org/software/guile/manual/html_node/SRFI_002d64.html#SRFI_002d64][SRFI-64]], which is a Scheme API for test
+suites. That's what it's used in this directory for testing.
+
+
+* Running the test suite
+
+To run the complete test suite:
+
+#+BEGIN_EXAMPLE
+$ cd path/to/project
+$ export GUILE_LOAD_PATH="$GUILE_LOAD_PATH:$PWD"
+$ guile tests/all.scm
+#+END_EXAMPLE
+
+
+To run the test suite for a particular module:
+
+#+BEGIN_EXAMPLE
+$ cd path/to/project
+$ export GUILE_LOAD_PATH="$GUILE_LOAD_PATH:$PWD"
+$ guile tests/MODULE_NAME.scm
+#+END_EXAMPLE
+
+Note that running tests will generate log files named
+~SUITE_NAME.log~.  These files will be written in the current working
+directory, and give more details about the tests.
diff --git a/website/tests/all.scm b/website/tests/all.scm
new file mode 100644
index 0000000..642b6e0
--- /dev/null
+++ b/website/tests/all.scm
@@ -0,0 +1,14 @@
+;;; GuixSD website --- GNU's advanced distro website
+;;; Initially written by sirgazil who waves all
+;;; copyright interest on this file.
+
+;;; XXX: This module is just a provisional way to run all the tests at once.
+(use-modules (tests apps aux lists)
+	     (tests apps aux numbers)
+	     (tests apps aux strings)
+	     (tests apps aux sxml)
+	     (tests apps aux system)
+	     (tests apps aux web)
+	     (tests apps base types)
+	     (tests apps blog utils)
+	     (tests apps packages utils))
diff --git a/website/tests/apps/aux/lists.scm b/website/tests/apps/aux/lists.scm
new file mode 100644
index 0000000..724f184
--- /dev/null
+++ b/website/tests/apps/aux/lists.scm
@@ -0,0 +1,97 @@
+;;; GuixSD website --- GNU's advanced distro website
+;;; Initially written by sirgazil who waves all
+;;; copyright interest on this file.
+
+(define-module (tests apps aux lists)
+  #:use-module (apps aux lists)
+  #:use-module (srfi srfi-64))
+
+
+;;;
+;;; Constants.
+;;;
+
+(define SUITE_NAME "apps-aux-lists")
+
+
+;;;
+;;; Helper variables.
+;;;
+
+(define fruit-bag (list "uva" "mora" "mango" "kiwi"))
+
+
+;;;
+;;; Test suite.
+;;;
+
+(test-begin SUITE_NAME)
+
+(test-group
+ "[procedure] list-group"
+ (test-equal
+  "Grouping elements of an empty list results in an empty list."
+  (list-group (list) 5)
+  (list))
+ (test-equal
+  "Group a list of four in sets of two."
+  (list-group (list "Onnet" "Twoson" "Threed" "Summers") 2)
+  (list (list "Onnet" "Twoson") (list "Threed" "Summers")))
+ (test-equal
+  "Group a list of five in sets of three."
+  (list-group (list "Onnet" "Twoson" "Threed" "Summers" "Scaraba") 3)
+  (list (list "Onnet" "Twoson" "Threed") (list "Summers" "Scaraba"))))
+
+
+(test-group
+ "[procedure] list-slice"
+ (test-equal
+  "Slice from index A to index B."
+  (list-slice fruit-bag 0 2)
+  (list "uva" "mora"))
+ (test-equal
+  "Slice from index A to index B out of range."
+  (list-slice fruit-bag 1 7)
+  (list "mora" "mango" "kiwi"))
+ (test-equal
+  "Slice from index A."
+  (list-slice fruit-bag 2)
+  (list "mango" "kiwi")))
+
+
+(test-group
+ "[procedure] rest"
+ (test-equal
+  "Empty list results in itself."
+  (rest (list))
+  (list))
+ (test-equal
+  "Rest of single-element list is empty list."
+  (rest (list "Hello"))
+  (list))
+ (test-equal
+  "Rest of list of elements is the list but its first element."
+  (rest (list "Hello" "Hola" "Ei"))
+  (list "Hola" "Ei")))
+
+
+(test-group
+ "[procedure] separate"
+
+ (test-equal
+  "Don't add separators to empty lists."
+  (separate (list) "|")
+  (list))
+
+ (test-equal
+  "Don't add separators to one-element lists."
+  (separate (list "mango") "|")
+  (list "mango"))
+
+ (test-equal
+  "Separate the elements of a list."
+  (separate (list "mango" "kiwi" "papaya" "lemon") "|")
+  (list "mango" "|" "kiwi" "|" "papaya" "|" "lemon")))
+
+
+(test-end SUITE_NAME)
diff --git a/website/tests/apps/aux/numbers.scm b/website/tests/apps/aux/numbers.scm
new file mode 100644
index 0000000..7f3b8c7
--- /dev/null
+++ b/website/tests/apps/aux/numbers.scm
@@ -0,0 +1,52 @@
+;;; GuixSD website --- GNU's advanced distro website
+;;; Initially written by sirgazil who waves all
+;;; copyright interest on this file.
+
+(define-module (tests apps aux numbers)
+  #:use-module (apps aux numbers)
+  #:use-module (srfi srfi-64))
+
+
+;;;
+;;; Constants.
+;;;
+
+(define SUITE_NAME "apps-aux-numbers")
+
+
+;;;
+;;; Test suite.
+;;;
+
+(test-begin SUITE_NAME)
+
+(test-group
+ "[procedure] minus-one"
+ (test-equal "0 minus 1" (minus-one 0) -1)
+ (test-equal "6 minus 1" (minus-one 6) 5))
+
+
+(test-group
+ "[procedure] plus-one"
+ (test-equal "0 plus one." (plus-one 0) 1)
+ (test-equal "5 plus one." (plus-one 5) 6))
+
+
+(test-group
+ "[procedure] range"
+ (test-equal
+  "Range with equal start and end."
+  (range 8 8) (list 8))
+ (test-equal
+  "Range of positive integers."
+  (range 0 5) (list 0 1 2 3 4 5))
+ (test-equal
+  "Range of negative integers."
+  (range -5 0) (list -5 -4 -3 -2 -1 0))
+ (test-equal
+  "Range of negative and positive integers."
+  (range -5 5) (list -5 -4 -3 -2 -1 0 1 2 3 4 5))
+ )
+
+
+(test-end SUITE_NAME)
diff --git a/website/tests/apps/aux/strings.scm b/website/tests/apps/aux/strings.scm
new file mode 100644
index 0000000..60f7edd
--- /dev/null
+++ b/website/tests/apps/aux/strings.scm
@@ -0,0 +1,48 @@
+;;; GuixSD website --- GNU's advanced distro website
+;;; Initially written by sirgazil who waves all
+;;; copyright interest on this file.
+
+(define-module (tests apps aux strings)
+  #:use-module (apps aux strings)
+  #:use-module (srfi srfi-64))
+
+
+;;;
+;;; Constants.
+;;;
+
+(define SUITE_NAME "apps-aux-strings")
+
+
+
+;;;
+;;; Test suite.
+;;;
+
+(test-begin SUITE_NAME)
+
+
+(test-group
+ "[procedure] string-summarize"
+
+ (test-equal
+  "Return an empty string if there are no words."
+  (string-summarize "" 10)
+  "")
+
+ (test-equal
+  "Return the orginal string when there are less words than the required number."
+  (string-summarize
+   "GNU Guix will be present at FOSDEM next month with talks on a number of areas of active development."
+   40)
+  "GNU Guix will be present at FOSDEM next month with talks on a number of areas of active development.")
+
+ (test-equal
+  "Return an extract with the required number of words."
+  (string-summarize
+   "Last week we were celebrating the release of GNU Guile 2.2.0, the Scheme implementation that powers Guix. This is a major milestone and Guile developers naturally wanted to make it easy for users to discover all the goodies of 2.2.0 as soon as possible. One of the major roadblocks to that, as for any non-trivial piece of software, is deployment: because your distro is unlikely to have Guile 2.2.0 packaged on Day 1, you have to build it by yourself, which means getting the right dependencies installed and then building Guile itself. That’s not difficult for a developer, but it’s certainly cumbersome."
+   30)
+  "Last week we were celebrating the release of GNU Guile 2.2.0, the Scheme implementation that powers Guix. This is a major milestone and Guile developers naturally wanted to make it"))
+
+
+(test-end SUITE_NAME)
diff --git a/website/tests/apps/aux/sxml.scm b/website/tests/apps/aux/sxml.scm
new file mode 100644
index 0000000..f637d61
--- /dev/null
+++ b/website/tests/apps/aux/sxml.scm
@@ -0,0 +1,40 @@
+;;; GuixSD website --- GNU's advanced distro website
+;;; Initially written by sirgazil who waves all
+;;; copyright interest on this file.
+
+(define-module (tests apps aux sxml)
+  #:use-module (apps aux sxml)
+  #:use-module (srfi srfi-64))
+
+
+;;;
+;;; Constants.
+;;;
+
+(define SUITE_NAME "apps-aux-sxml")
+
+
+
+;;;
+;;; Test suite.
+;;;
+
+(test-begin SUITE_NAME)
+
+
+(test-group
+ "[procedure] sxml->string*"
+
+ (test-equal
+  "Converting an empty SXML tree results in an empty string."
+  (sxml->string* '())
+  "")
+
+ (test-equal
+  "Convert non-empty SXML tree to string."
+  (sxml->string*
+   '(p "Hello " (span (@ (class "planet")) "Earth") ". We are writing from " (a (@ (href "https://mars.org/")) "Mars") "."))
+  "Hello Earth. We are writing from Mars."))
+
+
+(test-end SUITE_NAME)
diff --git a/website/tests/apps/aux/system.scm b/website/tests/apps/aux/system.scm
new file mode 100644
index 0000000..672e57f
--- /dev/null
+++ b/website/tests/apps/aux/system.scm
@@ -0,0 +1,52 @@
+;;; GuixSD website --- GNU's advanced distro website
+;;; Initially written by sirgazil who waves all
+;;; copyright interest on this file.
+
+(define-module (tests apps aux system)
+  #:use-module (apps aux system)
+  #:use-module (srfi srfi-64))
+
+
+;;;
+;;; Constants.
+;;;
+
+(define SUITE_NAME "apps-aux-system")
+
+
+
+;;;
+;;; Test suite.
+;;;
+
+(test-begin SUITE_NAME)
+
+
+(test-group
+ "[procedure] path-join"
+
+ (test-equal
+  "Build a relative path to a file."
+  (path-join "docs" "essays" "humanity.odt")
+  (string-join (list "docs" "essays" "humanity.odt")
+	       file-name-separator-string))
+
+ (test-equal
+  "Build an absolute path to a directory."
+  (path-join "" "en" "docs" "manual")
+  (string-join (list "" "en" "docs" "manual")
+	       file-name-separator-string))
+
+ (test-equal
+  "Append a slash to the end of the path when specified."
+  (path-join "" "docs" "manual" "")
+  (string-join (list "" "docs" "manual" "")
+	       file-name-separator-string))
+
+ (test-equal
+  "Build path to the root directory."
+  (path-join "")
+  file-name-separator-string))
+
+
+(test-end SUITE_NAME)
diff --git a/website/tests/apps/aux/web.scm b/website/tests/apps/aux/web.scm
new file mode 100644
index 0000000..fb40834
--- /dev/null
+++ b/website/tests/apps/aux/web.scm
@@ -0,0 +1,70 @@
+;;; GuixSD website --- GNU's advanced distro website
+;;; Initially written by sirgazil who waves all
+;;; copyright interest on this file.
+
+(define-module (tests apps aux web)
+  #:use-module (apps aux web)
+  #:use-module (srfi srfi-64))
+
+
+;;;
+;;; Constants.
+;;;
+
+(define SUITE_NAME "apps-aux-web")
+
+
+
+;;;
+;;; Test suite.
+;;;
+
+(test-begin SUITE_NAME)
+
+
+(test-group
+ "[procedure] slugify"
+
+ (test-assert
+  "Text is lowercase."
+  (equal? (slugify "Biology") "biology"))
+
+ (test-assert
+  "Separate words with a hyphen."
+  (equal? (slugify "Human anatomy") "human-anatomy"))
+
+ (test-assert
+  "Remove reserved characters for IRIs."
+  (equal? (slugify ":/?#[]@!$&'()*+,;=") ""))
+
+ (test-assert
+  "Remove reserved characters for file names."
+  (equal? (slugify ":/?*\\%\"|<>") "")))
+
+
+
+(test-group
+ "[procedure] url-path-join"
+
+ (test-equal
+  "Build a relative path to a web resource."
+  (url-path-join "blog" "tags" "index.html")
+  "blog/tags/index.html")
+
+ (test-equal
+  "Build an absolute path to a directory."
+  (url-path-join "" "en" "docs" "manual")
+  "/en/docs/manual")
+
+ (test-equal
+  "Append a slash to the end of the path when specified."
+  (url-path-join "" "docs" "manual" "")
+  "/docs/manual/")
+
+ (test-equal
+  "Build a path to the root directory."
+  (url-path-join "")
+  "/"))
+
+
+(test-end SUITE_NAME)
diff --git a/website/tests/apps/base/types.scm b/website/tests/apps/base/types.scm
new file mode 100644
index 0000000..df17f3c
--- /dev/null
+++ b/website/tests/apps/base/types.scm
@@ -0,0 +1,34 @@
+;;; GuixSD website --- GNU's advanced distro website
+;;; Initially written by sirgazil who waves all
+;;; copyright interest on this file.
+
+(define-module (tests apps base types)
+  #:use-module (apps base types)
+  #:use-module (srfi srfi-64))
+
+
+;;;
+;;; Constants.
+;;;
+
+(define SUITE_NAME "apps-base-types")
+
+
+
+;;;
+;;; Test suite.
+;;;
+
+(test-begin SUITE_NAME)
+
+
+(test-group
+ "[procedure] context-datum"
+
+ (test-equal
+  "Return the appropriate value for the given key in the context."
+  (context-datum '(("HEALTH" . 82) ("COOKIE" . "lemon")) "COOKIE")
+  "lemon"))
+
+
+(test-end SUITE_NAME)
diff --git a/website/tests/apps/blog/utils.scm b/website/tests/apps/blog/utils.scm
new file mode 100644
index 0000000..c023886
--- /dev/null
+++ b/website/tests/apps/blog/utils.scm
@@ -0,0 +1,133 @@
+;;; GuixSD website --- GNU's advanced distro website
+;;; Initially written by sirgazil who waves all
+;;; copyright interest on this file.
+
+(define-module (tests apps blog utils)
+  #:use-module (apps blog utils)
+  #:use-module (haunt skribe utils)
+  #:use-module (haunt post)
+  #:use-module (srfi srfi-19)
+  #:use-module (srfi srfi-64))
+
+
+;;;
+;;; Constants.
+;;;
+
+(define SUITE_NAME "apps-blog-utils")
+
+
+
+;;;
+;;; Test suite.
+;;;
+
+(test-begin SUITE_NAME)
+
+
+(test-group
+ "[procedure] post-groups->tag-list"
+
+ (test-equal
+  "Return an empty list if there are no grouped posts."
+  (post-groups->tag-list '())
+  '())
+
+ (test-equal
+  "Return the list of tag names from the grouped posts."
+  (post-groups->tag-list
+   (list
+    (cons "Scheme API" '())
+    (cons "Unit tests" '())
+    (cons "Releases" '())))
+  '("Scheme API" "Unit tests" "Releases")))
+
+
+(test-group
+ "[procedure] post-url-path"
+
+ (test-equal
+  "Return the correct URL path to the post."
+  (post-url-path (make-post "hello.md"
+			    `((title . "Hello World!")
+			      (date . ,(make-date* 2017 03 21))) '()))
+  "blog/2017/hello-world"))
+
+
+(test-group
+ "[procedure] posts/latest"
+
+ (test-equal
+  "Return an empty list when there are no posts."
+  (posts/latest '() 5)
+  '())
+
+ (test-equal
+  "Return all posts when there are less posts than the required number."
+  (length (posts/latest (list (make-post "hello.md" '() '())) 3))
+  1)
+
+ (test-equal
+  "Return the required number of posts."
+  (length (posts/latest
+	   (list
+	    (make-post "hello.md" `((date . ,(make-date* 2017 03 21))) '())
+	    (make-post "hola.md" `((date . ,(make-date* 2017 03 21))) '())
+	    (make-post "konchiwa.md" `((date . ,(make-date* 2017 03 21))) '())
+	    (make-post "bye.md" `((date . ,(make-date* 2017 03 21))) '()))
+	   2))
+  2)
+
+ (test-equal
+  "Return all posts when there are less posts than the required number."
+  (length (posts/latest (list (make-post "hello.md" '() '())) 3))
+  1)
+
+ (test-equal
+  "Return the required number of posts sorted in reverse chronological order."
+  (posts/latest
+   (list
+    (make-post "hello.md" `((date . ,(make-date* 2015 12 01))) '())
+    (make-post "hola.md" `((date . ,(make-date* 2017 01 17))) '())
+    (make-post "konchiwa.md" `((date . ,(make-date* 2017 03 09))) '())
+    (make-post "bye.md" `((date . ,(make-date* 2017 03 20))) '()))
+   3)
+  (list
+   (make-post "bye.md" `((date . ,(make-date* 2017 03 20))) '())
+   (make-post "konchiwa.md" `((date . ,(make-date* 2017 03 09))) '())
+   (make-post "hola.md" `((date . ,(make-date* 2017 01 17))) '()))))
+
+
+(test-group
+ "[procedure] tag-first?"
+
+ (test-equal
+  "The tag 'Alpha' goes before 'Gamma'."
+  (tag-first? "Alpha" "Gamma")
+  #true)
+
+ (test-equal
+  "The tag 'Zapato' does not go before 'Abeja'."
+  (tag-first? "Zapato" "Abeja")
+  #false))
+
+
+(test-group
+ "[procedure] tag-system-path"
+
+ (test-equal
+  "Return the system path to the tag relative to the website dir."
+  (tag-system-path "Programming interfaces")
+  "blog/tags/programming-interfaces"))
+
+
+(test-group
+ "[procedure] tag-url-path"
+
+ (test-equal
+  "Return the URL path to the tag."
+  (tag-url-path "Scheme API")
+  "blog/tags/scheme-api"))
+
+
+(test-end SUITE_NAME)
diff --git a/website/tests/apps/packages/utils.scm b/website/tests/apps/packages/utils.scm
new file mode 100644
index 0000000..63860ae
--- /dev/null
+++ b/website/tests/apps/packages/utils.scm
@@ -0,0 +1,107 @@
+;;; GuixSD website --- GNU's advanced distro website
+;;; Initially written by sirgazil who waves 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)