06/09: website: media: Do not localize video page URLs.

[Florian Pelz]

pelzflorian pushed a commit to branch wip-i18n
in repository guix-artwork.

commit 9fa239c0d5c3148869f6253495eb969b6538ffee
Author: Florian Pelz <pelzflorian@pelzflorian.de>
AuthorDate: Fri Nov 1 11:07:24 2019 +0100

    website: media: Do not localize video page URLs.
    
    * website/apps/media/types.scm (<video>, video):
    Add new field for the page URL subpath.
    * website/apps/media/data.scm (playlists): Use it.
    * website/apps/media/utils.scm (video->url): Compute page URL from it.
---
 website/apps/media/data.scm  |  7 +++++++
 website/apps/media/types.scm | 16 ++++++++++++----
 website/apps/media/utils.scm |  5 +----
 3 files changed, 20 insertions(+), 8 deletions(-)

diff --git a/website/apps/media/data.scm b/website/apps/media/data.scm
index 65f1074..76af25d 100644
--- a/website/apps/media/data.scm
+++ b/website/apps/media/data.scm
@@ -23,6 +23,7 @@
    (list
     (video
      #:title (C_ "video title" "Installation from Script")
+     #:page-subpath "installation-from-script"
      #:description
      (G_ '(p "Explains how to install Guix on distributions not running
 GNU Guix."))
@@ -32,6 +33,7 @@ GNU Guix."))
    (list
     (video
      #:title (C_ "video title" "Everyday use of GNU Guix, Part One")
+     #:page-subpath "everyday-use-of-gnu-guix,-part-one"
      #:description
      (G_ '(p "How to install packages and how to manage software package
 generations."))
@@ -40,6 +42,7 @@ generations."))
      #:last-updated (string->date "2020-03-28T16:00:00" "~Y-~m-~dT~H:~M:~S"))
     (video
      #:title (C_ "video title" "Everyday use of GNU Guix, Part Two")
+     #:page-subpath "everyday-use-of-gnu-guix,-part-two"
      #:description
      (G_ '(p "How to upgrade software and how to reclaim storage space."))
      #:url "https://guix.gnu.org/guix-videos/02-everyday-use-part-two.webm";
@@ -48,6 +51,7 @@ generations."))
    (list
     (video
      #:title (C_ "video title" "Asking for help")
+     #:page-subpath "asking-for-help"
      #:description
      (G_ '(p "How to get help from the Guix community."))
      #:url "https://guix.gnu.org/guix-videos/03-help.webm";
@@ -56,6 +60,7 @@ generations."))
    (list
     (video
      #:title (C_ "video title" "Packaging, Part One")
+     #:page-subpath "packaging,-part-one"
      #:description
      (G_ '(p "How to set up a development environment for GNU Guix."))
      #:url "https://guix.gnu.org/guix-videos/04-packaging-part-one.webm";
@@ -63,6 +68,7 @@ generations."))
      #:last-updated (string->date "2020-03-28T16:00:00" "~Y-~m-~dT~H:~M:~S"))
     (video
      #:title (C_ "video title" "Packaging, Part Two")
+     #:page-subpath "packaging,-part-two"
      #:description
      (G_ '(p "How to create a package recipe for not yet packaged software."))
      #:url "https://guix.gnu.org/guix-videos/04-packaging-part-two.webm";
@@ -70,6 +76,7 @@ generations."))
      #:last-updated (string->date "2020-03-28T16:00:00" "~Y-~m-~dT~H:~M:~S"))
                     (video
      #:title (C_ "video title" "Packaging, Part Three")
+     #:page-subpath "packaging,-part-three"
      #:description
      (G_ '(p "How to submit a package for inclusion in the GNU Guix
 distribution."))
diff --git a/website/apps/media/types.scm b/website/apps/media/types.scm
index 7ad988f..50c0989 100644
--- a/website/apps/media/types.scm
+++ b/website/apps/media/types.scm
@@ -22,6 +22,7 @@
             video?
             video-description
             video-last-updated
+            video-page-subpath
             video-poster
             video-title
             video-url))
@@ -144,6 +145,12 @@
 ;;; url (string)
 ;;;   A URL to the video file.
 ;;;
+;;; page-subpath (string)
+;;;   The subpath to the webpage for this video.  It should correspond
+;;;   to the English video title converted to lower case with spaces
+;;;   replaced by hyphens.  For example:
+;;;   'everyday-use-of-gnu-guix,-part-one'.
+;;;
 ;;; poster (string)
 ;;;   A URL to a representative preview image for the video.
 ;;;
@@ -157,18 +164,19 @@
 ;;;   possibly become outdated over time such as documentation videos.
 ;;;
 (define-record-type <video>
-  (make-video title description url poster tracks last-updated)
+  (make-video title description url page-subpath poster tracks last-updated)
   video?
   (title video-title)
   (description video-description)
   (url video-url)
+  (page-subpath video-page-subpath)
   (poster video-poster)
   (tracks video-tracks)
   (last-updated video-last-updated))
 
 ;;; Helper procedures.
 
-(define* (video #:key (title "") (description "")
-                (url "") (poster "") (tracks '()) (last-updated #f))
+(define* (video #:key (title "") (description "") (url #f) (page-subpath #f)
+                (poster "") (tracks '()) (last-updated #f))
   "Return a <video> object with the given attributes."
-  (make-video title description url poster tracks last-updated))
+  (make-video title description url page-subpath poster tracks last-updated))
diff --git a/website/apps/media/utils.scm b/website/apps/media/utils.scm
index 129b085..1c909a5 100644
--- a/website/apps/media/utils.scm
+++ b/website/apps/media/utils.scm
@@ -6,14 +6,11 @@
 (define-module (apps media utils)
   #:use-module (apps aux web)
   #:use-module (apps media types)
-  #:use-module (ice-9 regex)
   #:export (video->url))
 
 
 (define (video->url video)
   (url-path-join
    "videos"
-   (string-downcase
-    (regexp-substitute/global #f "[ \t]+" (video-title video)
-                              'pre "-" 'post))
+   (video-page-subpath video)
    "index.html"))