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