Commit 2492f9e1 authored by divoplade's avatar divoplade
Browse files

The turtle printer is terser.

The turtle printer now:
- properly escapes IRIs;
- group the triples by subject, and then by predicate;
- can use a set of specified prefixes to shorten the IRIs;
- uses relative IRIs when they are relative to an internal base;
- can write down an explicit base;
- shorten integer, decimal, double and boolean literals;
- shorten the rdf:type predicate.

Shortcomings:
- the default list of common prefixes is relatively small, a lot more
  can be added since the unused ones won’t appear;
- the printer does not try to generate blank node property lists or
  collections.
parent 1a792ac0
......@@ -406,8 +406,9 @@ vocabulary, an `rdf-vocabulary` object.
### Turtle Format
Turtle is a textual format to represent RDF graphs. We include a parser and
a generator in guile-rdf. The `(turtle tordf)` module defines a parser:
Turtle is a textual format to represent RDF graphs. We include a
parser and a generator in guile-rdf. The `(turtle tordf)` module
defines a parser, and `(turtle fromrdf)` a printer:
#### **Scheme Procedure**: `turtle->rdf str-or-file base`
......@@ -417,11 +418,21 @@ parse it as a string). The `base` is the document base or `#f` if there is
none. When a document is downloaded from the internet, the base is typically
the URl of that document, or the value of a base header.
#### **Scheme Procedure**: `rdf->turtle graph`
Generates a string representing a turtle document for the `graph`. This is more
accurately a N-Triples representation of the graph, but that format is a subset
of Turtle.
#### **Scheme Procedure**: `rdf->turtle graph [#implicit-base] [#explicit-base] [#prefixes] [#validate-langtags?]`
Generates a string representing a turtle document for the `graph`.
The format is made terser by defining an `implicit-base`, so that all
IRIs in `graph` that are relative to `implicit-base` will appear
relative. An explicit `@base` definition can be added to the document
by setting `explicit-base`. The string will use all prefixes passed as
`prefixes` that are necessary. If not set, the value of
`common-prefixes` from this module will be used.
String langtags are not escaped in Turtle, so they are prone to data
injection if they come from unreliable sources. By default,
`#:validate-langtags?` is `#t`, so an error will be thrown if one of
the langtags does not conform to the grammar. You can override it to
disable the checks.
### N-Quads Format
......
;;;; Copyright (C) 2020 Julien Lepiller <julien@lepiller.eu>
;;;; Copyright (C) 2021 divoplade <d@divoplade.fr>
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
......@@ -16,54 +17,388 @@
;;;;
(define-module (turtle fromrdf)
#:use-module (ice-9 match)
#:use-module (ice-9 textual-ports)
#:use-module (iri iri)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (rdf rdf)
#:export (rdf->turtle))
(define (turtle-escape str)
"Escape a string for writing it to a turtle document."
(list->string (append-map (lambda (c)
(match c
(#\\ (list #\\ #\\))
(#\" (list #\\ #\"))
(#\newline (list #\\ #\n))
(#\return (list #\\ #\r))
(#\tab (list #\\ #\t))
(#\backspace (list #\\ #\b))
(_ (list c))))
(string->list str))))
(define (node->turtle node)
#:use-module ((rdf xsd) #:prefix xsd:)
#:use-module (iri iri)
#:use-module (turtle tordf)
#:use-module (ice-9 hash-table)
#:use-module (ice-9 receive)
#:use-module (web uri)
#:export (common-prefixes rdf->turtle))
(define common-prefixes
`(("rdf" . "http://www.w3.org/1999/02/22-rdf-syntax-ns#")
("rdfs" . "http://www.w3.org/2000/01/rdf-schema#")
("foaf" . "http://xmlns.com/foaf/0.1/")
("xsd" . "http://www.w3.org/2001/XMLSchema#")
("acl" . "http://www.w3.org/ns/auth/acl#")
("rel" . "http://www.perceive.net/schemas/relationship/")))
(define (iriref-escape iri)
;; Replace <, >, ", {, }, |, ^, `, \
(define (aux accu chars)
(if (null? chars)
(list->string (reverse accu))
(aux
(append
(reverse
(string->list
(case (car chars)
((#\>) "%3E")
((#\<) "%3C")
((#\") "%22")
((#\{) "%7B")
((#\}) "%7D")
((#\|) "%7C")
((#\^) "%5E")
((#\`) "%60")
(else (list->string (list (car chars)))))))
accu)
(cdr chars))))
(aux '() (string->list iri)))
(define (pn-local-escape local)
;; Replace _, ~, ., -, !, $, &, ', (, ), *, +, ,, ;, =, /, ?, #, @, %
(define (aux accu chars)
(if (null? chars)
(list->string (reverse accu))
(aux
(append
(reverse
(case (car chars)
((#\_ #\~ #\. #\- #\! #\$ #\& #\' #\( #\) #\* #\+
#\, #\; #\= #\/ #\? #\# #\@ #\% #\\)
(list #\\ (car chars)))
(else (list (car chars)))))
accu)
(cdr chars))))
(aux '() (string->list local)))
(define (lexical-form-escape lf)
;; Replace \ \r \n \t \b \f " '
(define (aux accu chars)
(if (null? chars)
(list->string (reverse accu))
(aux
(append
(reverse
(case (car chars)
((#\\ #\" #\')
(list #\\ (car chars)))
((#\newline)
(list #\\ #\n))
((#\return)
(list #\\ #\r))
((#\tab)
(list #\\ #\t))
((#\backspace)
(list #\\ #\b))
((#\page)
(list #\\ #\f))
(else
(list (car chars)))))
accu)
(cdr chars))))
(aux '() (string->list lf)))
(define (iri->node predicate? iri base prefixes)
;; Try to use all the prefixes in turn until one can be applied to
;; the iri. Return the list of used prefixes, and the node
;; string.
(define (search prefixes)
(cond
((null? prefixes)
(values '()
(format #f "<~a>"
(iriref-escape
(if base
(make-relative-iri iri base)
iri)))))
((string-prefix? (cdr (car prefixes)) iri)
(values
(list
(caar prefixes))
(format #f "~a:~a"
(car (car prefixes))
(pn-local-escape
(substring iri
(string-length
(cdr (car prefixes))))))))
(else
(search (cdr prefixes)))))
(if (and predicate? ;; rdf:type cannot be reduced to "a" for a
;; subject or object
(equal? iri "http://www.w3.org/1999/02/22-rdf-syntax-ns#type"))
(values '() "a")
(search prefixes)))
(define (merge-unique alist blist < =)
;; Merge alist and blist (they must be sorted both) with the <
;; comparator, but remove duplicates (with the = comparator). That
;; way, we can compute the unique list of all used prefixes
;; (sorted alphabetically).
(define (aux accu alist blist)
(cond
((and (null? alist) (null? blist))
(reverse accu))
((null? alist)
(aux (cons (car blist) accu) alist (cdr blist)))
((null? blist)
(aux accu blist alist))
((= (car alist) (car blist))
(aux accu (cdr alist) blist))
((< (car alist) (car blist))
(aux (cons (car alist) accu) (cdr alist) blist))
(else
(aux accu blist alist))))
(aux '() alist blist))
(define (valid-integer-representation? str)
((rdf-datatype-lexical? xsd:integer) str))
(define (valid-decimal-representation? str)
(and ((rdf-datatype-lexical? xsd:decimal) str)
;; Do not accept the letter e (or E)
(null? (filter (lambda (c)
(or (eqv? c #\e)
(eqv? c #\E)))
(string->list str)))))
(define (valid-double-representation? str)
((rdf-datatype-lexical? xsd:double) str))
(define (valid-boolean-representation? str)
((rdf-datatype-lexical? xsd:boolean) str))
(define (validate-langtag langtag)
;; A valid langtag has an ASCII letter as the first character, and
;; then a mix of dash, letter, digit, with a letter or digit after
;; each dash.
(define (in-ascii-range? first last c)
(and (char>=? c first)
(char<=? c last)))
(define (alpha? c)
(or (in-ascii-range? #\a #\z c)
(in-ascii-range? #\A #\Z c)))
(define (digit? c)
(in-ascii-range? #\0 #\9 c))
(define (dash? c)
(eqv? c #\-))
(define (validate-tail characters)
(or (null? characters)
(let ((first (car characters))
(rest (cdr characters)))
(if (dash? first)
(and (not (null? rest))
(not (dash? (car rest)))
(validate-tail rest))
(and (or (alpha? first)
(digit? first))
(validate-tail rest))))))
(define (validate characters)
(and (not (null? characters))
(let ((first (car characters))
(rest (cdr characters)))
(and (alpha? first)
(validate-tail rest)))))
(validate (string->list langtag)))
(define (node->turtle predicate? base prefixes validate-langtags? used-prefixes node)
;; Return the list of used prefixes, sorted alphabetically by
;; namespace, and the string representation of node.
(cond
((blank-node? node)
(string-append "_:" (number->string node)))
((rdf-datatype? node)
(string-append "<" (car (rdf-datatype-iris node)) ">"))
((rdf-literal? node)
(string-append "\"" (turtle-escape (rdf-literal-lexical-form node)) "\""
(if (rdf-literal-langtag node)
(string-append "@" (rdf-literal-langtag node))
(let ((type (rdf-literal-type node)))
(string-append
"^^<" (if (rdf-datatype? type)
(car (rdf-datatype-iris type))
type)
">")))))
((string? node)
(string-append "<" node ">"))))
(define (rdf->turtle g)
(string-join
(map
(match-lambda
(($ rdf-triple subject predicate object)
(format #f "~a ~a ~a ."
(node->turtle subject)
(node->turtle predicate)
(node->turtle object))))
g)
"\n"))
((blank-node? node)
(values used-prefixes (format #f "_:b~a" node)))
((string? node)
(receive (new-prefixes reduced)
(iri->node predicate? node base prefixes)
(values
(merge-unique new-prefixes used-prefixes string<? equal?)
reduced)))
((rdf-literal? node)
(cond
((equal? (rdf-literal-type node)
"http://www.w3.org/2001/XMLSchema#string")
(values used-prefixes
(format #f "\"~a\""
(lexical-form-escape
(rdf-literal-lexical-form node)))))
((equal? (rdf-literal-type node)
"http://www.w3.org/1999/02/22-rdf-syntax-ns#langString")
(when (and validate-langtags?
(not (validate-langtag (rdf-literal-langtag node))))
(throw 'invalid-langtag "The langtag is invalid."))
(values used-prefixes
(format #f "\"~a\"@~a"
(lexical-form-escape
(rdf-literal-lexical-form node))
(rdf-literal-langtag node))))
((or (and
(equal? (rdf-literal-type node)
"http://www.w3.org/2001/XMLSchema#integer")
(valid-integer-representation? (rdf-literal-lexical-form node)))
(and
(equal? (rdf-literal-type node)
"http://www.w3.org/2001/XMLSchema#decimal")
(valid-decimal-representation? (rdf-literal-lexical-form node)))
(and
(equal? (rdf-literal-type node)
"http://www.w3.org/2001/XMLSchema#double")
(valid-double-representation? (rdf-literal-lexical-form node)))
(and
(equal? (rdf-literal-type node)
"http://www.w3.org/2001/XMLSchema#boolean")
(valid-boolean-representation? (rdf-literal-lexical-form node))))
(values used-prefixes (rdf-literal-lexical-form node)))
(else
(receive (new-prefixes type)
(iri->node #f (rdf-literal-type node) base prefixes)
(values
(merge-unique new-prefixes used-prefixes string<? equal?)
(format #f "\"~a\"^^~a"
(lexical-form-escape
(rdf-literal-lexical-form node))
type))))))))
(define (format-triple base prefixes validate-langtags? used-prefixes triple)
;; Return a list with subject, predicate and object, where each of
;; them is a turtle representation of the nodes.
(receive (used-prefixes subject)
(node->turtle #f base prefixes validate-langtags?
used-prefixes (rdf-triple-subject triple))
(receive (used-prefixes predicate)
(node->turtle #t base prefixes validate-langtags?
used-prefixes (rdf-triple-predicate triple))
(receive (used-prefixes object)
(node->turtle #f base prefixes validate-langtags?
used-prefixes (rdf-triple-object triple))
(values used-prefixes
(list subject predicate object))))))
(define (format-graph base prefixes validate-langtags? used-prefixes accumulated triples)
;; Return a list of printed triples.
(if (null? triples)
(values used-prefixes
(reverse accumulated))
(receive (used-prefixes triple)
(format-triple base prefixes validate-langtags?
used-prefixes (car triples))
(format-graph base
prefixes
validate-langtags?
used-prefixes
(cons triple accumulated)
(cdr triples)))))
(define* (rdf->turtle graph
#:key
(implicit-base #f)
(explicit-base #f)
(prefixes common-prefixes)
(validate-langtags? #t))
"Return as a string the Turtle representation of @val{graph}.
If @val{implicit-base} is specified, all IRIs that are relative to
@val{implicit-base} will be made relative.
If @val{explicit-base} is specified, it will be written down as the
base. You can translate IRIs by passing both an implicit and explicit
base that are not equal. You can pass @code{#t} to use the same value
as @val{implicit-base}.
The IRIs will be reduced with known prefixes, by default
@val{common-prefixes}, or an association list of prefix name and URL.
If @val{validate-langtags?} is not set to @code{#f}, you must ensure
that the langtags used in RDF langstrings are valid, otherwise data
injection is possible."
;; If there are duplicate keys in prefixes, it will change the
;; semantics because it will merge both.
(let ((without-duplicates
(hash-map->list
cons
(alist->hash-table prefixes))))
(set! prefixes without-duplicates))
(when (and implicit-base (eq? explicit-base #t))
(set! explicit-base implicit-base))
(receive (used-prefixes pretty-triples)
(format-graph implicit-base prefixes validate-langtags? '() '() graph)
(call-with-output-string
(lambda (port)
(when explicit-base
(format port "@base <~a> .\n"
(iriref-escape explicit-base)))
(for-each
(lambda (pref)
(format port "@prefix ~a: <~a> .\n"
pref (iriref-escape (assoc-ref prefixes pref))))
used-prefixes)
(let ((table (make-hash-table (length pretty-triples)))
(subject-order-rev '()))
;; Store the list of (predicate object) in table, indexed by
;; the subject. Keep the order of insertion, because it will
;; be lost when hashed.
(for-each
(lambda (triple)
(let ((subject (car triple))
(predicate (cadr triple))
(object (caddr triple)))
(let ((pol (hash-ref table subject '())))
(when (null? pol)
(set! subject-order-rev
(cons subject subject-order-rev)))
(hash-set! table subject
(cons (list predicate object)
pol)))))
pretty-triples)
(let ((data
(map
(lambda (subject)
(let ((pl (hash-ref table subject)))
(let ((table (make-hash-table (length pl)))
(predicate-order-rev '()))
;; Store the list of objects in table, indexed
;; by the predicate, where the subject is
;; subject. Also keep the order of insertion
;; of the predicates.
(for-each
(lambda (p/o)
(let ((predicate (car p/o))
(object (cadr p/o)))
(let ((ol (hash-ref table predicate '())))
(when (null? ol)
(set! predicate-order-rev
(cons predicate predicate-order-rev)))
(hash-set! table predicate
(cons object ol)))))
pl)
;; Look up the table to get
;; (subject (predicate1 (object1 object2 ...)) (predicate2 (...)))
(let ((data
(map
(lambda (predicate)
(cons predicate
(reverse
(hash-ref table predicate))))
(reverse predicate-order-rev))))
(cons subject data)))))
(reverse subject-order-rev))))
(for-each
;; Print the data grouped by subject, in the apparition
;; order of subjects.
(lambda (triples)
(let ((subject (car triples))
(pol (cdr triples)))
(format port "\n~a\n~a .\n"
subject
(string-join
(map
(lambda (pol)
(let ((predicate (car pol))
(objects (cdr pol)))
(string-append
" " predicate " "
(string-join objects ", "))))
pol)
" ;\n"))))
data)))))))
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment