jsonld.scm
| 1 | ;;;; Copyright (C) 2019, 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) |
| 19 | #:use-module (jsonld compaction) |
| 20 | #:use-module (jsonld context) |
| 21 | #:use-module (jsonld context-processing) |
| 22 | #:use-module (jsonld deserialize-jsonld) |
| 23 | #:use-module (jsonld download) |
| 24 | #:use-module (jsonld expansion) |
| 25 | #:use-module (jsonld flattening) |
| 26 | #:use-module (jsonld generate-blank-node-identifier) |
| 27 | #:use-module (jsonld inverse-context-creation) |
| 28 | #:use-module (jsonld iri) |
| 29 | #:use-module (jsonld iri-compaction) |
| 30 | #:use-module (jsonld json) |
| 31 | #:use-module (jsonld node-map-generation) |
| 32 | #:use-module (jsonld options) |
| 33 | #:use-module (jsonld serialize-rdf) |
| 34 | #:use-module (rdf rdf) |
| 35 | #:export (compact |
| 36 | expand |
| 37 | flatten |
| 38 | jsonld->rdf |
| 39 | rdf->jsonld)) |
| 40 | |
| 41 | (define* (compact input context #:key (options (new-jsonld-options))) |
| 42 | (call-with-values |
| 43 | (lambda () |
| 44 | ;; TODO: set ordered to #f |
| 45 | (expand-with-base input #:options options)) |
| 46 | ;; 2 and 3 |
| 47 | (lambda (expanded-input context-base) |
| 48 | (when (string? context) |
| 49 | (set! context |
| 50 | (json-document-document |
| 51 | ((jsonld-options-document-loader options) |
| 52 | context)))) |
| 53 | ;; 4 |
| 54 | (when (json-has-key? context "@context") |
| 55 | (set! context (assoc-ref context "@context"))) |
| 56 | (let* ((base-iri (or (jsonld-options-base options) |
| 57 | (and (jsonld-options-compact-to-relative? options) |
| 58 | (string? input) |
| 59 | input))) |
| 60 | (active-context (context-processing (new-active-context |
| 61 | #:base base-iri) |
| 62 | context context-base |
| 63 | #:options options)) |
| 64 | (inverse-context (inverse-context-creation active-context)) |
| 65 | (compacted-output |
| 66 | (compaction active-context inverse-context |
| 67 | #nil ;; active-property |
| 68 | expanded-input ;; element |
| 69 | #:compact-arrays? (jsonld-options-compact-arrays? options) |
| 70 | #:ordered? (jsonld-options-ordered? options) |
| 71 | #:processing-mode |
| 72 | (jsonld-options-processing-mode options)))) |
| 73 | (if (equal? compacted-output #()) |
| 74 | (set! compacted-output '()) |
| 75 | (when (json-array? compacted-output) |
| 76 | (set! compacted-output `((,(iri-compaction active-context |
| 77 | inverse-context |
| 78 | "@graph" |
| 79 | #:vocab? #t |
| 80 | #:reverse? #f) . |
| 81 | ,compacted-output))))) |
| 82 | (when (and context (not (null? compacted-output)) (not (null? context))) |
| 83 | (set! compacted-output |
| 84 | (cons (cons "@context" context) compacted-output))) |
| 85 | compacted-output)))) |
| 86 | |
| 87 | (define* (expand-with-base input #:key (options (new-jsonld-options))) |
| 88 | (let ((document input) |
| 89 | (remote-document #f) |
| 90 | (active-context (new-active-context |
| 91 | #:base (jsonld-options-base options) |
| 92 | #:original-base (jsonld-options-base options))) |
| 93 | (document-base (jsonld-options-base options))) |
| 94 | (when (string? input) |
| 95 | ;; 2 |
| 96 | (catch #t |
| 97 | (lambda () |
| 98 | (set! remote-document |
| 99 | ((jsonld-options-document-loader options) |
| 100 | input |
| 101 | #:extract-all-scripts? (jsonld-options-extract-all-scripts? options)))) |
| 102 | (lambda (key . value) |
| 103 | (cond |
| 104 | ((member key '(loading-document-failed multiple-context-link-headers |
| 105 | invalid-script-element)) |
| 106 | (apply throw key value)) |
| 107 | (else |
| 108 | (apply throw 'loading-document-failed key value))))) |
| 109 | ;; 3 |
| 110 | (set! document (json-document-document remote-document)) |
| 111 | (set! document-base (json-document-document-url remote-document)) |
| 112 | ;; 4 |
| 113 | (set! active-context |
| 114 | (update-active-context active-context |
| 115 | #:base (or (jsonld-options-base options) |
| 116 | (json-document-document-url remote-document)) |
| 117 | #:original-base |
| 118 | (or (json-document-document-url remote-document) |
| 119 | (jsonld-options-base options))))) |
| 120 | |
| 121 | ;; 5 |
| 122 | (when (jsonld-options-expand-context options) |
| 123 | (set! active-context |
| 124 | (let* ((local-context (jsonld-options-expand-context options)) |
| 125 | (local-context (if (json-has-key? local-context "@context") |
| 126 | (assoc-ref local-context "@context") |
| 127 | local-context))) |
| 128 | (context-processing active-context local-context |
| 129 | (active-context-original-base active-context))))) |
| 130 | |
| 131 | ;; 6 |
| 132 | (when (and remote-document (json-document-context-url remote-document)) |
| 133 | (let ((context-url (json-document-context-url remote-document))) |
| 134 | (set! active-context |
| 135 | (context-processing active-context context-url context-url)))) |
| 136 | |
| 137 | ;; 7 |
| 138 | (let ((expanded-output (expansion active-context #nil document |
| 139 | (if remote-document |
| 140 | (or (json-document-document-url remote-document) |
| 141 | (jsonld-options-base options)) |
| 142 | (jsonld-options-base options)) |
| 143 | #:options options))) |
| 144 | (when (and |
| 145 | (json-object? expanded-output) |
| 146 | (json-has-key? expanded-output "@graph") |
| 147 | (null? (filter |
| 148 | (lambda (kv) |
| 149 | (not (equal? (car kv) "@graph"))) |
| 150 | expanded-output))) |
| 151 | (set! expanded-output (assoc-ref expanded-output "@graph"))) |
| 152 | (when (equal? expanded-output #nil) |
| 153 | (set! expanded-output #())) |
| 154 | (unless (json-array? expanded-output) |
| 155 | (set! expanded-output `#(,expanded-output))) |
| 156 | ;; 8 |
| 157 | (values expanded-output document-base)))) |
| 158 | |
| 159 | (define* (expand input #:key (options (new-jsonld-options))) |
| 160 | (call-with-values |
| 161 | (lambda () |
| 162 | (expand-with-base input #:options options)) |
| 163 | (lambda (out base) |
| 164 | out))) |
| 165 | |
| 166 | (define* (flatten input #:key (context #f) (options (new-jsonld-options))) |
| 167 | ;; 2 |
| 168 | (let* ((expanded-input |
| 169 | (expand input #:options (update-jsonld-options |
| 170 | options #:ordered? #t))) |
| 171 | ;; 3 |
| 172 | (base-iri (or (jsonld-options-base options) |
| 173 | (and (jsonld-options-compact-to-relative? options) |
| 174 | (string? input) |
| 175 | input))) |
| 176 | ;; 4 |
| 177 | (identifier-map '()) |
| 178 | ;; 5 |
| 179 | (flattened-output (flattening expanded-input |
| 180 | #:ordered? |
| 181 | (jsonld-options-ordered? options)))) |
| 182 | ;; 5.1 |
| 183 | (when context |
| 184 | ;; TODO |
| 185 | (set! flattened-output (compact flattened-output context #:options options))) |
| 186 | flattened-output)) |
| 187 | |
| 188 | (define* (jsonld->rdf input #:key (options (new-jsonld-options))) |
| 189 | (call-with-values |
| 190 | (lambda () |
| 191 | ;; TODO: set ordered to #f |
| 192 | (expand-with-base input #:options options)) |
| 193 | ;; 2 and 3 |
| 194 | (lambda (expanded-input context-base) |
| 195 | (pk 'expanded expanded-input) |
| 196 | (let* ((generate-blank-node (get-generate-blank-node-identifier)) |
| 197 | (generate-node-map (get-node-map-generation generate-blank-node)) |
| 198 | (node-map (generate-node-map expanded-input '())) |
| 199 | (node-map (assoc-ref node-map "node-map"))) |
| 200 | (pk node-map) |
| 201 | (deserialize-jsonld |
| 202 | generate-blank-node node-map (make-rdf-dataset '() '()) |
| 203 | #:produce-generalized-rdf? |
| 204 | (jsonld-options-produce-generalized-rdf? options) |
| 205 | #:rdf-direction (jsonld-options-rdf-direction options)))))) |
| 206 | |
| 207 | (define* (rdf->jsonld input #:key (options (new-jsonld-options))) |
| 208 | (serialize-rdf input |
| 209 | #:ordered? (jsonld-options-ordered? options) |
| 210 | #:rdf-direction (jsonld-options-rdf-direction options) |
| 211 | #:use-native-types? (jsonld-options-use-native-types? options) |
| 212 | #:use-rdf-type? (jsonld-options-use-rdf-type? options) |
| 213 | #:processing-mode (jsonld-options-processing-mode options))) |
| 214 |