;;; 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 (sxml simple)

  #:use-module (ice-9 match)

  #:export (languages tr _ site-locale translate))

(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 ...)) (car rest)))))

(define (tr body)

  (match body

    (('_ rest) (_ rest))

    (('_ 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 (translate str lang)

  (site-locale lang)

  (tr str))