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