;;;; Copyright (C) 2020 Julien Lepiller <julien@lepiller.eu>
;;;; 
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
;;;; License as published by the Free Software Foundation; either
;;;; version 3 of the License, or (at your option) any later version.
;;;; 
;;;; This library 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
;;;; Lesser General Public License for more details.
;;;; 
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
;;;; 

(define-module (jsonld inverse-context-creation)
  #:use-module (jsonld context)
  #:use-module (jsonld json)
  #:use-module (ice-9 match)
  #:export (inverse-context-creation))

(define (sort-size-lexico e1 e2)
  "A <=? implementation between two elements of an alist that sort according
to key size first, breaking ties by selecting the lexicographically least one."
  (match `(,e1 . ,e2)
    (((k1 . v1) . (k2 . v2))
     (let ((l1 (string-length k1))
           (l2 (string-length k2)))
       (if (= l1 l2)
         (string<=? k1 k2)
         (< l1 l2))))))

(define* (inverse-context-creation active-context)
  (let ((result '())
        (default-language "@none"))
    ;; 2
    (when (active-context-language active-context)
      (set! default-language (string-downcase (active-context-language
                                                active-context))))
    ;; 3
    (for-each-pair
      (lambda (term term-definition)
        ;; 3.1
        (unless (equal? term-definition #nil)
          ;; 3.2
          (let ((container "@none")
                ;; 3.3
                (var (term-definition-iri term-definition))
                ;; 3.5
                (container-map #f)
                ;; 3.7
                (type/language-map #f)
                ;; 3.8
                (type-map #f)
                ;; 3.10
                (language-map '()))
            (when (term-definition-container term-definition)
              (let ((mapping (term-definition-container term-definition)))
                (set! container
                  (apply string-append
                         (sort
                           (if (json-array? mapping)
                               (array->list mapping)
                               (list mapping))
                           string<=?)))))
            ;; 3.4
            (unless (json-has-key? result var)
              (set! result (alist-set result var '())))
            ;; 3.5
            (set! container-map (assoc-ref result var))
            ;; 3.6
            (unless (json-has-key? container-map container)
              (set! container-map
                (alist-set
                  container-map
                  container
                  `(("@language" . ())
                    ("@type" . ())
                    ("@any" . (("@none" . ,term)))))))
            ;; 3.7
            (set! type/language-map (assoc-ref container-map container))
            ;; 3.12
            (set! language-map (assoc-ref type/language-map "@language"))
            ;; 3.8
            (set! type-map (assoc-ref type/language-map "@type"))
            ;; 3.9
            (cond
              ((term-definition-reverse? term-definition)
               (unless (json-has-key? type-map "@reverse")
                 (set! type-map (alist-set type-map "@reverse" term))))
              ;; 3.10
              ((equal? (term-definition-type term-definition) "@none")
               (set! language-map (assoc-ref type/language-map "@language"))
               (unless (json-has-key? language-map "@any")
                 (set! language-map (alist-set language-map "@any" term)))
               (unless (json-has-key? type-map "@any")
                 (set! type-map (alist-set type-map "@any" term))))
              ;; 3.11
              ((term-definition-type term-definition)
               (unless (json-has-key? type-map
                                      (term-definition-type term-definition))
                 (set! type-map
                   (alist-set type-map (term-definition-type term-definition)
                              term))))
              ;; 3.13
              ((and (not (equal? (term-definition-language term-definition) #f))
                    (not (equal? (term-definition-direction term-definition) #f)))
               (let ((lang-dir #f))
                 (cond
                   ((and (term-definition-language term-definition)
                         (term-definition-direction term-definition))
                    (set! lang-dir
                      (string-downcase
                        (string-append
                          (term-definition-language term-definition)
                          "_"
                          (term-definition-direction term-definition)))))
                   ((term-definition-language term-definition)
                    (set! lang-dir (string-downcase (term-definition-language
                                                      term-definition))))
                   ((term-definition-direction term-definition)
                    (set! lang-dir
                      (string-append
                        "_"
                        (string-downcase (term-definition-language
                                           term-definition)))))
                   (else
                     (set! lang-dir "@null")))
                 (unless (json-has-key? language-map lang-dir)
                   (set! language-map
                     (alist-set language-map lang-dir term)))))
              ;; 3.14
              ((not (equal? (term-definition-language term-definition) #f))
               (let ((language
                       (if (term-definition-language term-definition)
                           (string-downcase
                             (term-definition-language term-definition))
                           "@null")))
                 (unless (json-has-key? language-map language)
                   (set! language-map
                     (alist-set language-map language term)))))
              ;; 3.15
              ((not (equal? (term-definition-direction term-definition) #f))
               (let ((direction
                       (if (term-definition-direction term-definition)
                           (string-append
                             "_"
                             (string-downcase
                               (term-definition-direction term-definition)))
                           "@none")))
                 (unless (json-has-key? language-map direction)
                   (set! language-map
                     (alist-set language-map direction term)))))
              ;; 3.16
              ((not (equal? (active-context-direction active-context) #f))
               (let ((lang-dir
                       (string-downcase
                         (string-append
                           default-language "_"
                           (or (active-context-direction active-context)
                               "")))))
                 (unless (json-has-key? language-map lang-dir)
                   (set! language-map
                     (alist-set language-map lang-dir term)))
                 (unless (json-has-key? language-map "@none")
                   (set! language-map
                     (alist-set language-map "@none" term)))
                 (unless (json-has-key? type-map "@none")
                   (set! type-map
                     (alist-set type-map "@none" term)))))
              ;; 3.17
              (else
                (unless (json-has-key? language-map default-language)
                  (set! language-map
                    (alist-set language-map default-language term)))
                (unless (json-has-key? language-map "@none")
                  (set! language-map
                    (alist-set language-map "@none" term)))
                (unless (json-has-key? type-map "@none")
                  (set! type-map
                    (alist-set type-map "@none" term)))))
            (set! type/language-map (alist-set type/language-map "@language" language-map))
            (set! type/language-map (alist-set type/language-map "@type" type-map))
            (set! container-map (alist-set container-map container type/language-map))
            (set! result (alist-set result var container-map)))))
      (alist-sort-by-key (active-context-definitions active-context)
                         #:less sort-size-lexico))
    ;; 4
    result))