;;;; Copyright (C) 2020 Julien Lepiller <julien@lepiller.eu>

;;;; 

;;;; This library is free software; you can redistribute it and/or

;;;; modify it under the terms of the GNU Lesser General Public

;;;; License as published by the Free Software Foundation; either

;;;; version 3 of the License, or (at your option) any later version.

;;;; 

;;;; This library is distributed in the hope that it will be useful,

;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of

;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU

;;;; Lesser General Public License for more details.

;;;; 

;;;; You should have received a copy of the GNU Lesser General Public

;;;; License along with this library; if not, write to the Free Software

;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA

;;;; 

(define-module (nquads 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->nquads))

(define (nquads-escape str)

  "Escape a string for writing it to an nquads 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->nquads 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 "\"" (nquads-escape (rdf-literal-lexical-form node)) "\""

                    (if (rdf-literal-langtag node)

                        (string-append "@" (rdf-literal-langtag node))

                        (let ((type (rdf-literal-type node)))

                          (if (equal? type "http://www.w3.org/2001/XMLSchema#string")

                              ""

                              (string-append

                                "^^<"

                                (if (rdf-datatype? type)

                                    (car (rdf-datatype-iris type))

                                    type)

                                ">"))))))

    ((string? node)

     (string-append "<" node ">"))))

(define (rdf-triple->nquads t graph)

  (match t

    (($ rdf-triple subject predicate object)

     (format #f "~a ~a ~a ~a ."

             (node->nquads subject)

             (node->nquads predicate)

             (node->nquads object)

             (or graph "")))))

(define (rdf->nquads g)

  (match g

    (($ rdf-dataset default-graph named-graphs)

     (string-join

       (apply append

         (map (lambda (t) (rdf-triple->nquads t #f)) default-graph)

         (map

           (match-lambda

             ((name . graph)

              (let ((name (node->nquads name)))

                (map (lambda (t) (rdf-triple->nquads t name)) graph))))

           named-graphs))

       "\n"))))