;;;; 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 node-map-generation)
  #:use-module (jsonld json)
  #:export (get-node-map-generation))

(define (contains-json? array json)
  (when (equal? array #f)
    (set! array #()))
  (unless (json-array? array)
    (set! array `#(,array)))
  (not (null? (filter (lambda (o) (identical-json? o json)) (array->list array)))))

(define (add-to-list array element)
  (when (equal? array #f)
    (set! array #()))
  (unless (json-array? array)
    (set! array `#(,array)))
  (list->array 1 (append
                   (array->list array)
                   (list element))))

(define (append-to-list a1 a2)
  (when (equal? a1 #f)
    (set! a1 #()))
  (unless (json-array? a1)
    (set! a1 `#(,a1)))
  (when (equal? a2 #f)
    (set! a2 #()))
  (unless (json-array? a2)
    (set! a2 `#(,a2)))
  (list->array 1 (append
                   (array->list a1)
                   (array->list a2))))

(define (add-if-not-in object property element)
  (let ((array (assoc-ref object property)))
    (if (contains-json? array element)
        object
        (alist-set
          object property
          (add-to-list array element)))))

(define (append-if-not-in object property elements)
  (if (json-array? elements)
    (set! elements (array->list elements))
    (set! elements (list elements)))
  (let loop ((elements elements) (object object))
    (if (null? elements)
        object
        (loop (cdr elements) (add-if-not-in object property (car elements))))))

(define (get-node-map-generation generate-blank-node)
  (define* (node-map-generation element node-map
                                #:key (active-graph "@default")
                                (active-subject #nil)
                                (active-property #nil)
                                (lst #nil))
    ;; 1
    (if (json-array? element)
      (for-each
        (lambda (item)
          (let ((res (node-map-generation item node-map
                                          #:active-graph active-graph
                                          #:active-subject active-subject
                                          #:active-property  active-property
                                          #:lst lst)))
            (set! node-map (assoc-ref res "node-map"))
            (set! lst (assoc-ref res "list"))))
        (array->list element))
      ;; 2: otherwise
      (let* ((graph (or (assoc-ref node-map active-graph) '()))
             (subject-node (if (equal? active-subject #nil)
                               '()
                               (or (assoc-ref graph active-subject) '())))
             (types (assoc-ref element "@type"))
             (types (if (json-array? types)
                        (array->list types)
                        (if types (list types) '())))
             ;; 3
             (types
               (map
                 (lambda (item)
                   (if (blank-node? item)
                       (generate-blank-node item)
                       item))
                 types)))
        (unless (null? types)
          (if (json-array? (assoc-ref element "@type"))
            (set! element (alist-set element "@type" (list->array 1 types)))
            (set! element (alist-set element "@type" (car types)))))
        ;; 4
        (when (json-has-key? element "@value")
          (if (equal? lst #nil)
              (begin
                ;; 4.1.1
                (unless (json-has-key? subject-node active-property)
                  (set! subject-node
                    (alist-set subject-node active-property `#(,element))))
                ;; 4.1.2
                (set! subject-node
                  (add-if-not-in subject-node active-property element)))
              ;; 4.2
              (set! lst
                (alist-set lst "@list"
                           (add-to-list (assoc-ref lst "@list") element)))))
        ;; 5
        (when (json-has-key? element "@list")
          (let ((result `(("@list" . #()))))
            ;; 5.2
            (let ((res (node-map-generation
                         (assoc-ref element "@list") node-map
                         #:active-graph active-graph
                         #:active-subject active-subject
                         #:active-property active-property
                         #:lst result)))
              (set! result (assoc-ref res "list"))
              (set! node-map (assoc-ref res "node-map"))
              (set! graph (assoc-ref node-map active-graph))
              (set! subject-node (or (assoc-ref graph active-subject) '()))
              (if (equal? lst #nil)
                ;; 5.3
                (begin
                  (set! subject-node
                    (alist-set
                      subject-node
                      active-property
                      (add-to-list (assoc-ref subject-node active-property)
                                   result)))
                  (set! graph (alist-set graph active-subject subject-node))
                  (set! node-map (alist-set node-map active-graph graph)))
                (set! lst
                  (alist-set lst "@list"
                    (add-to-list (assoc-ref lst "@list")
                                 result)))))))
        ;; 6
        (when (node-object? element)
          ;; 6.1
          (let ((id (if (json-has-key? element "@id")
                        (if (blank-node? (assoc-ref element "@id"))
                            (generate-blank-node (assoc-ref element "@id"))
                            (assoc-ref element "@id"))
                        (generate-blank-node #nil))))
            ;; 6.3
            (unless (or (json-has-key? graph id) (not id))
              (set! graph
                (alist-set graph id `(("@id" . ,id))))
              (set! node-map (alist-set node-map active-graph graph)))
            ;; 6.4
            (let ((node (or (assoc-ref graph id) '())))
              (cond
                ;; 6.5
                ((json-object? active-subject)
                 (if (json-has-key? node active-property)
                     ;; 6.5.2
                     (set! node
                       (add-if-not-in node active-property active-subject))
                     ;; 6.5.1
                     (set! node
                       (alist-set node active-property `#(,active-subject))))
                 (when id
                   (set! graph (alist-set graph id node)))
                 (set! node-map (alist-set node-map active-graph graph)))
                ;; 6.6
                ((not (equal? active-property #nil))
                 ;; 6.6.1
                 (let ((reference `(("@id" . ,id))))
                   (if (equal? lst #nil)
                       ;; 6.6.2
                       (begin
                         (if (json-has-key? subject-node active-property)
                             ;; 6.6.2.2
                             (set! subject-node
                               (add-if-not-in subject-node active-property reference))
                             ;; 6.6.2.1
                             (set! subject-node
                               (alist-set subject-node active-property `#(,reference))))
                         (set! graph (alist-set graph active-subject subject-node))
                         (set! node-map (alist-set node-map active-graph graph)))
                       ;; 6.6.3
                       (set! lst
                         (alist-set lst "@list"
                                    (add-to-list (assoc-ref lst "@list")
                                                 reference)))))))
              ;; 6.7
              (when (json-has-key? element "@type")
                (set! node
                  (append-if-not-in node "@type" (assoc-ref element "@type")))
                (when id
                  (set! graph (alist-set graph id node)))
                (set! node-map (alist-set node-map active-graph graph)))
              ;; 6.8
              (when (json-has-key? element "@index")
                (when (json-has-key? node "@index")
                  (throw 'conflicting-indexes))
                (set! node
                  (alist-set node "@index" (assoc-ref element "@index")))
                  (unless (string? id)
                    (throw 'eee))
                (set! graph (alist-set graph id node))
                (set! node-map (alist-set node-map active-graph graph))
                (set! element (alist-remove element "@index")))
              ;; 6.9
              (when (json-has-key? element "@reverse")
                ;; 6.9.1
                (let ((referenced-node `(("@id" . ,id)))
                      ;; 6.9.2
                      (reverse-map (assoc-ref element "@reverse")))
                  ;; 6.9.3
                  (for-each-pair
                    (lambda (property values)
                      (for-each
                        (lambda (value)
                          (let ((res (node-map-generation
                                       value node-map
                                       #:active-graph active-graph
                                       #:active-subject referenced-node
                                       #:active-property property)))
                            (set! node-map (assoc-ref res "node-map"))
                            (set! graph (assoc-ref node-map active-graph))
                            (set! subject-node (or (assoc-ref graph active-subject)
                                                   '()))
                            (when id
                              (set! node (assoc-ref graph id)))))
                        (array->list values)))
                    reverse-map)
                  ;; 6.9.4
                  (set! element (alist-remove element "@reverse"))))
              ;; 6.10
              (when (json-has-key? element "@graph")
                (let ((res (node-map-generation
                             (assoc-ref element "@graph")
                             node-map
                             #:active-graph id)))
                  (set! node-map (assoc-ref res "node-map"))
                  (set! graph (assoc-ref node-map active-graph))
                  (set! subject-node (or (assoc-ref graph active-subject) '()))
                  (when id
                    (set! node (assoc-ref graph id))))
                (set! element (alist-remove element "@graph")))
              ;; 6.11
              (when (json-has-key? element "@included")
                (let ((res (node-map-generation
                             (assoc-ref element "@included")
                             node-map
                             #:active-graph active-graph)))
                  (set! node-map (assoc-ref res "node-map"))
                  (set! graph (assoc-ref node-map active-graph))
                  (set! subject-node (or (assoc-ref graph active-subject) '()))
                  (when id
                    (set! node (assoc-ref graph id))))
                (set! element (alist-remove element "@included")))
              ;; 6.12
              (for-each-pair
                (lambda (property value)
                  ;; 6.12.1
                  (when (blank-node? property)
                    (set! property (generate-blank-node property)))
                  ;; 6.12.2
                  (unless (json-has-key? node property)
                    (set! node (alist-set node property #()))
                    (when id
                      (set! graph (alist-set graph id node)))
                    (set! node-map (alist-set node-map active-graph graph)))
                  ;; 6.12.3
                  (let ((res (node-map-generation
                               value node-map #:active-graph active-graph
                               #:active-subject id
                               #:active-property property)))
                    (set! node-map (assoc-ref res "node-map"))
                    (set! graph (assoc-ref node-map active-graph))
                    (set! subject-node (or (assoc-ref graph active-subject) '()))
                    (when id
                      (set! node (assoc-ref graph id)))))
                (alist-sort-by-key element))
              (when id
                (set! graph (alist-set graph id node))))))
        (when (string? active-subject)
          (set! graph (alist-set graph active-subject subject-node)))
        (set! node-map (alist-set node-map active-graph graph))))
    ;; The algorithm returns nothing, but may have modified these two references
    `(("node-map" . ,node-map) ("list" . ,lst)))
  node-map-generation)