;;;; 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 (term-definition? def)

               (or (not-null-or-false (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 (term-definition? active-def)

                       (term-definition-language active-def)

                       #f))

         ;; 3

         (direction (if (term-definition? 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 (term-definition? 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 (term-definition? 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")

            (term-definition? active-def)

            (equal? (assoc-ref value "@type")

                    (term-definition-type active-def)))

       (set! result (assoc-ref value "@value")))

      ;; 6

      ((or (and (term-definition? 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")

                      (term-definition? 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 (not-null-or-false language)

                     (equal? language (assoc-ref value "@language")))

                (and (not (not-null-or-false language))

                     (not (json-has-key? value "@language"))))

            (or (and (not-null-or-false direction)

                     (equal? direction (assoc-ref value "@direction")))

                (and (not (not-null-or-false direction))

                     (not (json-has-key? value "@direction")))))

       (when (or (and (json-has-key? value "@index")

                      (term-definition? 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))