;; disfluid, implementation of the Solid specification
;; Copyright (C) 2020, 2021  Vivien Kraus

;; This program 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.

;; This program 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 this program.  If not, see <https://www.gnu.org/licenses/>.

(define-module (webid-oidc web-i18n)
  #:use-module (ice-9 i18n)
  #:use-module (ice-9 match)
  #:use-module (ice-9 receive)
  #:use-module (ice-9 threads)
  #:use-module (srfi srfi-26)
  #:use-module (web request)
  #:declarative? #t
  #:export
  (

   web-locale
   
   (web-gettext . W_)
   (sysadmin-gettext . G_)

   ))

(define locale-mutex
  (make-mutex))

(define sort-qlist
  (cute stable-sort <>
        (match-lambda*
          (((px . _) (py . _))
           (> px py)))))

(define get-preferred-language
  (match-lambda
    ((? request?
        (= request-accept-language
           (= sort-qlist
              ((_ . language) _ ...))))
     (get-preferred-language language))
    ((? string?
        (= (cute string-split <> #\-)
           ((? string? lang)
            (? string? region))))
     (format #f "~a_~a.UTF-8" lang region))
    (else "")))

(define web-locale
  (make-parameter
   "en-US"
   get-preferred-language))

(define (disambiguate str out)
  (if (string=? out str)
      ;; No translation, disambiguate
      (car (reverse (string-split str #\|)))
      ;; Translation done, nothing to do
      out))

(define (web-gettext str)
  (let ((out
         (with-mutex locale-mutex
           (let ((previous-locale (setlocale LC_ALL)))
             (dynamic-wind
               (lambda ()
                 (with-exception-handler
                     (lambda (exn)
                       (setlocale LC_ALL "C"))
                   (lambda ()
                     (setlocale LC_ALL (web-locale)))
                   #:unwind? #t))
               (lambda ()
                 (gettext str))
               (lambda ()
                 (setlocale LC_ALL previous-locale)))))))
    (disambiguate str out)))

(define (sysadmin-gettext str)
  (let ((out
         (with-mutex locale-mutex
           (gettext str))))
    (disambiguate str out)))