;;; Nani Project website

;;; Copyright © 2019 Julien Lepiller <julien@lepiller.eu>

;;;

;;; This file is part of the Nani Project website.

;;;

;;; The Nani Project website 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 Nani Project website 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 Nani Project website.  If not, see <http://www.gnu.org/licenses/>.

(define-module (tools i18n)

  #:use-module (haunt builder blog)

  #:use-module (haunt html)

  #:use-module (haunt page)

  #:use-module (sxml simple)

  #:use-module (ice-9 match)

  #:export (internationalize languages _ site-locale))

(define language-map

  `(("" . "en_US.UTF-8")

    ("en" . "en_US.UTF-8")

    ("fr" . "fr_FR.UTF-8")))

(define languages

  (map car language-map))

(define (site-locale locale)

  (setlocale LC_ALL

    (assoc-ref language-map locale))

  (bindtextdomain "nani" (string-append (dirname (current-filename)) "/../po"))

  (textdomain "nani"))

(site-locale "fr")

(define (__ tr . args)

  (xml->sxml (apply format #f (format #f "<tr>~a</tr>" (gettext tr)) args)))

(define (_ tr . args)

  (let ((res (apply __ tr args)))

    (match res

      ((*TOP* (tr rest ...)) rest))))

(define (tr body)

  (match body

    (('_ rest ...) (apply _ rest))

    ((tag ('@ opt ...) rest ...) (apply list tag (apply list '@ opt) (map tr rest)))

    ((tag rest ...) (apply list tag (map tr rest)))

    (foo foo)))

(define (make-my-page lang title filename body layout)

  (lambda (site posts)

    (define (my-body)

      (site-locale lang)

      (tr body))

    (make-page (if (equal? lang "")

                 (string-append filename ".html")

                 (string-append filename "." lang ".html"))

               (with-layout (layout lang filename) site title (my-body))

               sxml->html)))

(define (internationalize title filename body layout)

  (map (lambda (lang) (make-my-page lang title filename body layout)) languages))