;;; 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))