;;;; 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 parser)

  #:use-module (ice-9 peg)

  #:export (parse-nquads))

;; Productions for terminals

(define-peg-pattern langtag all

  (and (ignore "@") (+ (or (range #\a #\z) (range #\A #\Z)))

       (* (and "-" (+ (or (range #\a #\z) (range #\A #\Z) (range #\0 #\9)))))))

(define-peg-pattern eol none (+ (or "\n" "\r")))

(define-peg-pattern iriref all

  (and (ignore "<")

       (* (or "!" (range #\x23 #\x3b) "=" (range #\x3f #\x5b) "]" "_"

              (range #\x61 #\x7a) (range #\x7e #\x10ffff) uchar))

       (ignore ">")))

(define-peg-pattern string-literal-quote all

  (and (ignore "\"")

       (* (or (range #\x00 #\x09) (range #\x0b #\x0c) (range #\x0d #\x21)

              (range #\x23 #\x5b) (range #\x5d #\x10ffff) echar uchar))

       (ignore "\"")))

(define-peg-pattern blank-node-label all

  (and "_:" (or pn-chars-u (range #\0 #\9)) (* (and (* ".") pn-chars))))

(define-peg-pattern uchar all

  (or (and (ignore "\\u") hex hex hex hex)

      (and (ignore "\\U") hex hex hex hex hex hex hex hex)))

(define-peg-pattern echar all

  (or "\\t" "\\b" "\\n" "\\r" "\\f" "\\\"" "\\'" "\\\\"))

(define-peg-pattern pn-chars-base body

  (or (range #\A #\Z) (range #\a #\z) (range #\x00c0 #\x00d6)

      (range #\x00d8 #\x00f6) (range #\x00f8 #\x02ff) (range #\x0370 #\x037d)

      (range #\x037f #\x1fff) (range #\x200c #\x200d) (range #\x2070 #\x218f)

      (range #\x2c00 #\x2fef) (range #\x3001 #\xd7ff) (range #\xf900 #\xfdcf)

      (range #\xfdf0 #\xfffd) (range #\x10000 #\xeffff)))

(define-peg-pattern pn-chars-u body (or pn-chars-base "_"))

(define-peg-pattern pn-chars body

  (or pn-chars-u "-" (range #\0 #\9) "·" (range #\x0300 #\x036f)

      (range #\x203f #\x2040)))

(define-peg-pattern hex body (or (range #\0 #\9) (range #\a #\f) (range #\A #\F)))

;; Grammar

(define-peg-pattern unrecognized body (range #\x00 #\x10ffff))

(define-peg-pattern comment body (and "#" (* (or (range #\x00 #\x09)

                                                 (range #\x0B #\x0C)

                                                 (range #\x0E #\x10FFFF)))))

(define-peg-pattern WS none (* (or comment "\t" " ")))

(define-peg-pattern nquads-doc body (and (* (and WS (? eol))) (* statement)))

(define-peg-pattern statement all

  (or

    (and WS subject WS iriref WS object WS (? graph-label) WS (? (ignore "."))

         (* (and WS eol)))

    (* unrecognized)))

(define-peg-pattern subject body

  (or iriref blank-node-label))

(define-peg-pattern object body

  (or iriref blank-node-label literal))

(define-peg-pattern graph-label body

  (or iriref blank-node-label))

(define-peg-pattern literal all

  (and string-literal-quote (? (or (and "^^" iriref) langtag))))

(define (parse-nquads str)

  (peg:tree (match-pattern nquads-doc str)))