guile-jsonld/jsonld/rdf-to-object.scm

rdf-to-object.scm

1
;;;; Copyright (C) 2020 Julien Lepiller <julien@lepiller.eu>
2
;;;;
3
;;;; This library is free software; you can redistribute it and/or
4
;;;; modify it under the terms of the GNU Lesser General Public
5
;;;; License as published by the Free Software Foundation; either
6
;;;; version 3 of the License, or (at your option) any later version.
7
;;;;
8
;;;; This library is distributed in the hope that it will be useful,
9
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
10
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
11
;;;; Lesser General Public License for more details.
12
;;;;
13
;;;; You should have received a copy of the GNU Lesser General Public
14
;;;; License along with this library; if not, write to the Free Software
15
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
16
;;;;
17
18
(define-module (jsonld rdf-to-object)
19
  #:use-module (iri iri)
20
  #:use-module (jsonld deserialize-jsonld)
21
  #:use-module (jsonld json)
22
  #:use-module (json)
23
  #:use-module ((rdf rdf) #:hide (blank-node?))
24
  #:use-module ((rdf xsd) #:prefix xsd:)
25
  #:use-module (srfi srfi-1)
26
  #:export (rdf-to-object))
27
28
(define* (rdf-to-object value rdf-direction use-native-types?
29
                        #:key processing-mode)
30
  (if (or (blank-node? value) (absolute-iri? value))
31
      `(("@id" . ,value))
32
      ;; 2
33
      (let ((result '())
34
            (converted-value (rdf-literal-lexical-form value))
35
            (datatype (rdf-literal-type value))
36
            (type json-null))
37
        (cond
38
          ;; 2.4
39
          (use-native-types?
40
            (cond
41
              ;; 2.4.1
42
              ((equal? datatype (xsd-iri "string"))
43
               (set! converted-value (rdf-literal-lexical-form value)))
44
              ;; 2.4.2
45
              ((equal? datatype (xsd-iri "boolean"))
46
               (cond
47
                 ((equal? (rdf-literal-lexical-form value) "true")
48
                  (set! converted-value #t))
49
                 ((equal? (rdf-literal-lexical-form value) "false")
50
                  (set! converted-value #f))
51
                 (else
52
                   (set! converted-value (rdf-literal-lexical-form value))
53
                   (set! type (xsd-iri "boolean")))))
54
              ;; 2.4.3
55
              ((and (equal? datatype (xsd-iri "integer"))
56
                    ((rdf-datatype-lexical? xsd:integer) converted-value))
57
               (set! converted-value ((rdf-datatype-lexical->value xsd:integer)
58
                                      converted-value)))
59
              ((and (equal? datatype (xsd-iri "double"))
60
                    ((rdf-datatype-lexical? xsd:double) converted-value))
61
               (set! converted-value ((rdf-datatype-lexical->value xsd:double)
62
                                      converted-value)))
63
              (else
64
                (set! type datatype))))
65
          ;; 2.5
66
          ((and (not (processing-mode-1.0? processing-mode))
67
                (equal? datatype (rdf-iri "JSON")))
68
           (set! type "@json")
69
           (catch #t
70
             (lambda _
71
               (set! converted-value (json-string->scm (rdf-literal-lexical-form value))))
72
             (lambda _
73
               (throw 'invalid-json-literal))))
74
          ;; 2.6
75
          ((and (> (string-length datatype) (string-length "https://www.w3.org/ns/i18n#"))
76
                (equal? (substring datatype 0 (string-length "https://www.w3.org/ns/i18n#"))
77
                        "https://www.w3.org/ns/i18n#")
78
                (equal? rdf-direction "i18n-datatype"))
79
           ;; 2.6.1
80
           (set! converted-value (rdf-literal-lexical-form value))
81
           (let* ((fragment (substring datatype (string-length "https://www.w3.org/ns/i18n#")))
82
                  (fragment (string-split fragment #\_))
83
                  (language (car fragment))
84
                  (direction (cadr fragment)))
85
             ;; 2.6.2
86
             (unless (equal? language "")
87
               (set! result (alist-set result "@language" language)))
88
             ;; 2.6.3
89
             (unless (equal? direction "")
90
               (set! result (alist-set result "@direction" direction)))))
91
          ;; 2.7
92
          ((rdf-literal-langtag value)
93
           (set! result (alist-set result "@language" (rdf-literal-langtag value))))
94
          ;; 2.8
95
          (else
96
            (unless (equal? datatype (xsd-iri "string"))
97
              (set! type datatype))))
98
        ;; 2.9
99
        (set! result (alist-set result "@value" converted-value))
100
        ;; 2.10
101
        (when (not-null-or-false type)
102
          (set! result (alist-set result "@type" type)))
103
        ;; 2.11
104
        result)))
105