03/04: website: i18n: Refactor URL manipulation.

[Florian Pelz]

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

commit 9e2c6681b39bbc7c86551ca089db151805e8dc7b
Author: Florian Pelz <address@hidden>
Date:   Thu Oct 31 14:43:18 2019 +0100

    website: i18n: Refactor URL manipulation.
    
    * website/apps/i18n.scm (localize-url): Rename to ...
    (localized-root-path): ... this and make it return only the prefix.
    (builder->localized-builder): Use it here.
    (<asset>): New import.
---
 website/apps/i18n.scm | 43 ++++++++++++++++++++++++-------------------
 1 file changed, 24 insertions(+), 19 deletions(-)

diff --git a/website/apps/i18n.scm b/website/apps/i18n.scm
index 5bc0ddd..d88333a 100644
--- a/website/apps/i18n.scm
+++ b/website/apps/i18n.scm
@@ -17,6 +17,7 @@
 ;;; along with the GNU Guix web site.  If not, see 
<http://www.gnu.org/licenses/>.
 
 (define-module (apps i18n)
+  #:use-module (haunt asset)
   #:use-module (haunt page)
   #:use-module (haunt utils)
   #:use-module (ice-9 match)
@@ -32,7 +33,7 @@
             builder->localized-builder
             builders->localized-builders
             ietf-tags-file-contents
-            localize-url))
+            localized-root-path))
 
 (define %gettext-domain
   "guix-website")
@@ -62,9 +63,6 @@
 
 (set-complex-keywords! '(N_ C_ NC_))
 
-(define <page>
-  (@@ (haunt page) <page>))
-
 (define %current-lingua
   ;; strip the character encoding:
   (car (string-split (setlocale LC_ALL) #\.)))
@@ -83,14 +81,14 @@
 (define %current-lang
   (car (string-split %current-ietf-tag #\-)))
 
-(define* (localize-url url #:key (lingua %current-ietf-tag))
-  "Given a URL as used in a href attribute, transforms it to point to
-the version for LINGUA as produced by builder->localized-builder."
-  (if (and (string-prefix? "/" url)
-           (or (string-suffix? ".html" url)
-               (string-suffix? "/" url)))
-      (string-append "/" lingua url)
-      url))
+(define* (localized-root-path url #:key (lingua %current-ietf-tag))
+  "Given a URL as used in a href attribute, return the URL prefix
+'builder->localized-builder' would use for the URL when called with
+LINGUA."
+  (if (or (string-suffix? ".html" url)
+          (string-suffix? "/" url))
+      (string-append lingua "/")
+      ""))
 
 (define (first-value arg)
   "For some reason the builder returned by static-directory returns
@@ -98,22 +96,29 @@ multiple values.  This procedure is used to retain only the 
first
 return value.  TODO: This should not be necessary."
   arg)
 
+(define <asset>
+  (@@ (haunt asset) <asset>))
+
+(define <page>
+  (@@ (haunt page) <page>))
+
 (define (builder->localized-builder builder)
   "Return a Haunt builder procedure generated from an existing BUILDER
 with translations for the current system locale coming from
 sexp-xgettext."
   (compose
-   (lambda (pages)
+   (lambda (pages-and-assets)
      (map
-      (lambda (page)
-        (match page
+      (lambda (page-or-asset)
+        (match page-or-asset
           (($ <page> file-name contents writer)
-           (let ((new-name (string-append %current-ietf-tag
-                                          "/"
+           (let ((new-name (string-append (localized-root-path file-name)
                                           file-name)))
              (make-page new-name contents writer)))
-          (else page)))
-      pages))
+          (($ <asset> source target)
+           (let ((new-name (string-append (localized-root-path target) 
target)))
+             (make-asset source new-name)))))
+      pages-and-assets))
    (lambda (site posts)
      (first-value (builder site posts)))))