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
                          (string-append
39
                            "^^" (if (rdf-datatype? type)
40
                                     (car (rdf-datatype-iris type))
41
                                     type))))))
42
    ((string? node)
43
     (string-append "<" node ">"))))
44
45
(define (rdf-triple->nquads t graph)
46
  (match t
47
    (($ rdf-triple subject predicate object)
48
     (format #f "~a ~a ~a ~a ."
49
             (node->nquads subject)
50
             (node->nquads predicate)
51
             (node->nquads object)
52
             (or graph "")))))
53
54
(define (rdf->nquads g)
55
  (match g
56
    (($ rdf-dataset default-graph named-graphs)
57
     (string-join
58
       (apply append
59
         (map (lambda (t) (rdf-triple->nquads t #f)) default-graph)
60
         (map
61
           (match-lambda
62
             ((name . graph)
63
              (let ((name (node->nquads name)))
64
                (map (lambda (t) (rdf-triple->nquads t name)) graph))))
65
           named-graphs))
66
       "\n"))))
67