guile-rdf/nquads/fromrdf.scm

fromrdf.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 (nquads fromrdf)
19
  #:use-module (ice-9 match)
20
  #:use-module (ice-9 textual-ports)
21
  #:use-module (iri iri)
22
  #:use-module (turtle parser)
23
  #:use-module (srfi srfi-9)
24
  #:use-module (rdf rdf)
25
  #:export (rdf->nquads))
26
27
(define (node->nquads node)
28
  (cond
29
    ((blank-node? node)
30
     (string-append "_:" (number->string node)))
31
    ((rdf-datatype? node)
32
     (string-append "<" (car (rdf-datatype-iris node)) ">"))
33
    ((rdf-literal? node)
34
     (string-append "\"" (rdf-literal-lexical-form node) "\""
35
                    (if (rdf-literal-langtag node)
36
                        (string-append "@" (rdf-literal-langtag node))
37
                        (let ((type (rdf-literal-type node)))
38
                          (if (equal? type "http://www.w3.org/2001/XMLSchema#string")
39
                              ""
40
                              (string-append
41
                                "^^<"
42
                                (if (rdf-datatype? type)
43
                                    (car (rdf-datatype-iris type))
44
                                    type)
45
                                ">"))))))
46
    ((string? node)
47
     (string-append "<" node ">"))))
48
49
(define (rdf-triple->nquads t graph)
50
  (match t
51
    (($ rdf-triple subject predicate object)
52
     (format #f "~a ~a ~a ~a ."
53
             (node->nquads subject)
54
             (node->nquads predicate)
55
             (node->nquads object)
56
             (or graph "")))))
57
58
(define (rdf->nquads g)
59
  (match g
60
    (($ rdf-dataset default-graph named-graphs)
61
     (string-join
62
       (apply append
63
         (map (lambda (t) (rdf-triple->nquads t #f)) default-graph)
64
         (map
65
           (match-lambda
66
             ((name . graph)
67
              (let ((name (node->nquads name)))
68
                (map (lambda (t) (rdf-triple->nquads t name)) graph))))
69
           named-graphs))
70
       "\n"))))
71