;;; GNU Guix web site ;;; Copyright © 2017, 2019, 2020, 2021, 2023 Ludovic Courtès ;;; Copyright © 2019 Florian Pelz ;;; ;;; 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 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 ;;; General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with the GNU Guix web site. If not, see . ;; Run 'guix build -f .guix.scm' to build the web site. (define this-directory (dirname (current-filename))) ;; Make sure po/LINGUAS will be found in the current working ;; directory. (chdir this-directory) ;; We need %linguas from the (sexp-xgettext) module. ;; Therefore, we add its path to the load path. (set! %load-path (cons this-directory %load-path)) (use-modules (guix) (gnu) (gnu packages guile) (gnu packages guile-xyz) (gnu packages package-management) (guix modules) (guix git-download) (guix gexp) (srfi srfi-1) (srfi srfi-9) (ice-9 match) (ice-9 rdelim) (ice-9 regex) (sexp-xgettext)) (define source (local-file this-directory "guix-web-site" #:recursive? #t #:select? (git-predicate this-directory))) (define po-directory (local-file (string-append this-directory "/po") "guix-web-site-po-files" #:recursive? #t #:select? (git-predicate this-directory))) (define root-path (getenv "GUIX_WEB_SITE_ROOT_PATH")) (define (package+propagated-inputs package) (match (package-transitive-propagated-inputs package) (((labels packages) ...) (cons package packages)))) (define (lingua-mo-files lingua) "Return a directory containing .mo files for LINGUA." (define build (with-imported-modules '((guix build utils)) #~(begin (use-modules (guix build utils)) (define lingua #$lingua) (define msgfmt #+(file-append (specification->package "gettext-minimal") "/bin/msgfmt")) (define (create-mo filename) (invoke msgfmt filename "-o" (string-append #$output "/" lingua "/LC_MESSAGES/" "guix-website.mo"))) (let* ((lingua-file (string-append #$po-directory "/" lingua ".po")) (lang (car (string-split lingua #\_))) (lang-file (string-append #$po-directory "/" lang ".po")) (packages-lingua-mo (string-append #$guix "/share/locale/" lingua "/LC_MESSAGES/guix-packages.mo")) (packages-lang-mo (string-append #$guix "/share/locale/" lang "/LC_MESSAGES/guix-packages.mo"))) (mkdir-p (string-append #$output "/" lingua "/LC_MESSAGES")) (cond ((file-exists? lingua-file) (create-mo lingua-file)) ((file-exists? lang-file) (create-mo lang-file))) (cond ((file-exists? packages-lingua-mo) (copy-file packages-lingua-mo (string-append #$output "/" lingua "/LC_MESSAGES/" "guix-packages.mo"))) ((file-exists? packages-lang-mo) (copy-file packages-lang-mo (string-append #$output "/" lingua "/LC_MESSAGES/" "guix-packages.mo")))))))) (computed-file (string-append "guix-web-site-" lingua "-messages") build #:options '(#:env-vars (("COLUMNS" . "200"))))) (define (lingua-web-site lingua) "Return the web site built for LINGUA." (define build ;; We need Guile-JSON for 'packages-json-builder'. (with-extensions (append (package+propagated-inputs (specification->package "guile-json")) (package+propagated-inputs (specification->package "guile-syntax-highlight"))) (with-imported-modules (source-module-closure '((guix build utils))) #~(begin (use-modules (guix build utils) (ice-9 popen) (ice-9 match)) (define lingua #$lingua) (setvbuf (current-output-port) 'line) (setvbuf (current-error-port) 'line) (setenv "GUIX_WEB_SITE_LOCAL" "no") (copy-recursively #$source ".") ;; Set 'GUILE_LOAD_PATH' so that Haunt find the Guix modules and ;; its dependencies. To find out the load path of Guix and its ;; dependencies, fetch its value over 'guix repl'. (let ((pipe (open-pipe* OPEN_BOTH #+(file-append guix "/bin/guix") "repl" "-t" "machine"))) (pk 'repl-version (read pipe)) (write '(list %load-path %load-compiled-path) pipe) (force-output pipe) (match (read pipe) (('values ('value ((load-path ...) (compiled-path ...)))) (setenv "GUILE_LOAD_PATH" (string-join (append load-path %load-path) ":")) (setenv "GUILE_LOAD_COMPILED_PATH" (string-join (append compiled-path %load-compiled-path) ":")))) (close-pipe pipe)) ;; Make the copy writable so Haunt can overwrite duplicate assets. (for-each make-file-writable (find-files "." ".*" #:directories? #t)) ;; So we can read/write UTF-8 files. (setenv "GUIX_LOCPATH" #+(file-append (specification->package "glibc-locales") "/lib/locale")) ;; Use a sane default. (setenv "XDG_CACHE_HOME" "/tmp/.cache") ;; Use GUIX_WEB_SITE_ROOT_PATH from the environment in which ;; this script was run. (setenv "GUIX_WEB_SITE_ROOT_PATH" #$root-path) ;; Build the website for LINGUA. (apps i18n) calls ;; 'bindtextdomain' on $PWD so provide .mo files right here. (for-each (lambda (lingua mo-directory) (symlink (string-append mo-directory "/" lingua) lingua)) (list #$@%linguas) '#$(map lingua-mo-files %linguas)) (setenv "LC_ALL" (string-append lingua ".utf8")) (format #t "Running 'haunt build' for lingua ~a...~%" lingua) (invoke #+(file-append haunt "/bin/haunt") "build") (mkdir-p #$output) (copy-recursively "/tmp/gnu.org/software/guix" #$output #:log (%make-void-port "w")) (let ((tag (assoc-ref (call-with-input-file "po/ietf-tags.scm" (lambda (port) (read port))) lingua))) (symlink "guix.html" (string-append #$output "/" tag "/index.html"))))))) (computed-file (string-append "guix-web-site-" lingua) build #:guile (specification->package "guile") #:local-build? #f ;this is costly, allow offloading #:options '(#:effective-version "3.0"))) (directory-union "guix-web-site" (map lingua-web-site %linguas) #:copy? #t) ;; Local Variables: ;; eval: (put 'let-package 'scheme-indent-function 1) ;; End: