;;;; 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 object-to-rdf)

  #:use-module (ice-9 match)

  #:use-module (ice-9 regex)

  #:use-module (jsonld deserialize-jsonld)

  #:use-module (jsonld iri)

  #:use-module (jsonld json)

  #:use-module (jsonld list-to-rdf)

  #:use-module (json)

  #:use-module ((rdf rdf) #:hide (blank-node?))

  #:use-module (srfi srfi-1)

  #:export (object-to-rdf

            well-formed-language-tag?))

(define (canonical-double value)

  (let ((exponent (inexact->exact (floor (log10 value)))))

    (string-append

      (number->string (exact->inexact (/ value (expt 10 exponent))))

      "E"

      (number->string exponent))))

(define (canonical-json value)

  (cond

    ((member value `(#t #f ,json-null))

     value)

    ((string? value) value)

    ((number? value)

     (if (integer? (inexact->exact value))

         (inexact->exact value)

         value))

    ((list? value)

     (map

       (match-lambda

         ((k . v)

          (cons k (canonical-json v))))

       (alist-sort-by-key value)))

    ((array? value)

     (list->array

       1

       (fold-right

         (lambda (val result)

           (cons (canonical-json val) result))

         '()

         (array->list value))))))

(define (well-formed-language-tag? tag)

  (let ((match (string-match "[a-z]{1,8}(-[0-9a-z]{1,8})*" tag)))

    (if match

        (let* ((match (cadr (array->list match)))

               (fst (car match))

               (snd (cdr match)))

          (and (equal? fst 0)

               (equal? snd (string-length tag))))

        #f)))

(define* (object-to-rdf generate-blank-node rdf-direction item list-triples)

  (let ((result json-null))

    (cond

      ;; 1

      ((and (node-object? item) (not (well-formed? (assoc-ref item "@id"))))

       (set! result json-null))

      ;; 2

      ((node-object? item)

       (set! result (assoc-ref item "@id")))

      ;; 3

      ((list-object? item)

       (let* ((res (list-to-rdf generate-blank-node rdf-direction

                                (array->list (assoc-ref item "@list"))

                                list-triples))

              (lst (assoc-ref res "list-triples"))

              (res (assoc-ref res "result")))

         (set! result res)

         (set! list-triples lst)))

      (else

        ;; 4

        (let ((value (assoc-ref item "@value"))

              (datatype (or (assoc-ref item "@type") json-null)))

          (cond

            ;; 6

            ((and (not (json-null? datatype)) (not (equal? datatype "@json"))

                    (not (well-formed? datatype)))

             (set! result json-null))

            ;; 7

            ((and

               (json-has-key? item "@language")

               (not (well-formed-language-tag? (assoc-ref item "@language"))))

              (set! result json-null))

            (else

              ;; 8

              (when (equal? datatype "@json")

                (set! value (scm->json-string (canonical-json value)))

                (set! datatype (rdf-iri "JSON")))

              (cond

                ;; 9

                ((boolean? value)

                 (when (json-null? datatype)

                   (set! datatype (xsd-iri "boolean")))

                 (set! value (if value "true" "false")))

                ;; 10

                ((and (number? value)

                      (or (not (integer? (inexact->exact value)))

                          (>= (abs value) (expt 10 21))

                          (equal? datatype (xsd-iri "double"))))

                 (when (json-null? datatype)

                   (set! datatype (xsd-iri "double")))

                 (set! value (canonical-double value)))

                ;; 11

                ((number? value)

                 (set! value (number->string (inexact->exact value)))

                 (when (json-null? datatype)

                   (set! datatype (xsd-iri "integer"))))

                ;; 12

                ((json-null? datatype)

                 (set! datatype

                   (if (json-has-key? item "@language")

                       (rdf-iri "langString")

                       (xsd-iri "string")))))

              (if (and (json-has-key? item "@direction") (not (equal? rdf-direction #f)))

                  ;; 13

                  (let* ((language (or (not-null-or-false (assoc-ref item "@language")) ""))

                         (language (string-downcase language)))

                    (if (equal? rdf-direction "i18n-datatype")

                        ;; 13.2

                        (begin

                          (set! datatype

                            (string-append "https://www.w3.org/ns/i18n#" language "_"

                                           (assoc-ref item "@direction")))

                          (set! result

                            (make-rdf-literal value datatype #f)))

                        ;; 13.3

                        (when (equal? rdf-direction "compound-literal")

                          (let ((literal (blank-node->rdf-blank-node

                                           (generate-blank-node json-null))))

                            ;; 13.3.2

                            (set! list-triples

                              (cons

                                ;; XXX: the spec says "of the @value in item as object",

                                ;; but should it be "value" instead?

                                (make-rdf-triple literal (rdf-iri "value")

                                  (make-rdf-literal

                                    (assoc-ref item "@value")

                                    (xsd-iri "string")

                                    #f))

                                list-triples))

                            ;; 13.3.3

                            (when (json-has-key? item "@language")

                              (set! list-triples

                                (cons

                                  (make-rdf-triple literal (rdf-iri "language")

                                    (make-rdf-literal

                                      language

                                      (xsd-iri "string")

                                      #f))

                                  list-triples)))

                            (set! list-triples

                              (cons

                                (make-rdf-triple literal (rdf-iri "direction")

                                  (make-rdf-literal

                                    (assoc-ref item "@direction")

                                    (xsd-iri "string")

                                    #f))

                                list-triples))

                            (set! result literal)))))

                  ;; 14

                  (set! result

                    (make-rdf-literal value datatype (assoc-ref item "@language")))))))))

    (when (blank-node? result)

      (set! result (blank-node->rdf-blank-node result)))

    `(("result" . ,result)

      ("list-triples" . ,list-triples))))