;;;; 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 (iri iri)
  #:use-module (jsonld deserialize-jsonld)
  #: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))))