;;;; 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 value-compaction)
  #:use-module (jsonld context)
  #:use-module (jsonld iri-compaction)
  #:use-module (jsonld json)
  #:export (value-compaction
            container-mapping))

(define (container-mapping active-context active-property)
  (let* ((def (term-definition-ref active-context active-property))
         (container-mapping
           (if def (or (term-definition-container def) #()) #())))
    (if (json-array? container-mapping)
        (array->list container-mapping)
        (list container-mapping))))

(define (value-compaction active-context inverse-context active-property value
                          processing-mode)
  (let* ((result value)
         (active-def (term-definition-ref active-context active-property))
         ;; 2
         (language (if active-def (term-definition-language active-def) #f))
         ;; 3
         (direction (if active-def (term-definition-direction active-def) #f)))
    (when (equal? language #f)
      (set! language (active-context-language active-context)))
    (when (equal? direction #f)
      (set! direction (active-context-direction active-context)))
    (cond
      ;; 4
      ((and (json-has-key? value "@id")
            (null? (filter
                     (lambda (kv)
                       (not (member (car kv) '("@id" "@index"))))
                     value)))
       (cond
         ((and active-def (equal? (term-definition-type active-def) "@id"))
          (set! result (iri-compaction active-context inverse-context
                                       (assoc-ref value "@id") #:vocab? #f
                                       #:processing-mode processing-mode)))
         ((and active-def (equal? (term-definition-type active-def) "@vocab"))
          (set! result (iri-compaction active-context inverse-context
                                       (assoc-ref value "@id") #:vocab? #t
                                       #:processing-mode processing-mode)))))
      ;; 5
      ((and (json-has-key? value "@type")
            active-def
            (equal? (assoc-ref value "@type")
                    (term-definition-type active-def)))
       (set! result (assoc-ref value "@value")))
      ;; 6
      ((or (and active-def (equal? (term-definition-type active-def) "@none"))
           (json-has-key? value "@type"))
       (when (json-has-key? result "@type")
         (let ((type (iri-compaction active-context inverse-context
                                                    (assoc-ref result "@type")
                                                    #:vocab? #t
                                                    #:processing-mode
                                                    processing-mode)))
           (set! result
             (alist-set result "@type"
                        (if (json-array? type)
                            (if (= (array-length type) 1)
                                (car (array->list type))
                                type)
                            type))))))
      ;; 7
      ((and
         (json-has-key? value "@value")
         (not (string? (assoc-ref value "@value"))))
       (when (or (and (json-has-key? value "@index")
                      active-def
                      (member "@index" (container-mapping active-context
                                                          active-property)))
                 (not (json-has-key? value "@index")))
         (set! result (assoc-ref value "@value"))))
      ;; 8
      ((and (or (and language (equal? language (assoc-ref value "@language")))
                (and (not language)
                     (not (json-has-key? value "@language"))))
            (or (and direction (equal? direction (assoc-ref value "@direction")))
                (and (not direction)
                     (not (json-has-key? value "@direction")))))
       (when (or (and (json-has-key? value "@index")
                      active-def
                      (member "@index" (container-mapping
                                         active-context active-property)))
                 (not (json-has-key? value "@index")))
         (when (json-has-key? value "@value")
           (set! result (assoc-ref value "@value"))))))
    ;; 9
    (when (json-object? result)
      (set! result
        (map
          (lambda (kv)
            (cons
              (iri-compaction active-context inverse-context (car kv)
                             #:vocab? #t)
              (cdr kv)))
          result)))
    ;; 10
    result))