;;; GNU Guix --- Functional package management for GNU

;;; Copyright © 2019 Julien Lepiller <julien@lepiller.eu>

;;;

;;; This file is part of GNU Guix.

;;;

;;; GNU Guix is free software; you can redistribute it and/or modify it

;;; under the terms of the GNU General Public License as published by

;;; the Free Software Foundation; either version 3 of the License, or (at

;;; your option) any later version.

;;;

;;; GNU Guix 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 General Public License for more details.

;;;

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

;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (more build maven java)

  #:use-module (ice-9 peg)

  #:use-module (ice-9 textual-ports)

  #:export (parse-java-file))

(define-peg-pattern java-file body (and (* WS) (* (and top-level-statement

                                                       (* WS)))))

(define-peg-pattern WS none (or " " "\n" "\t" "\r"))

(define-peg-pattern top-level-statement body (or package import-pat class-pat comment))

(define-peg-pattern package all (and (ignore "package") (* WS) package-name

                                     (* WS) (ignore ";")))

(define-peg-pattern import-pat all (and (ignore "import") (* WS) package-name

                                     (* WS) (ignore ";")))

(define-peg-pattern comment all (and (ignore "/*")

                                     comment-part))

(define-peg-pattern comment-part body (or (ignore (and (* "*") "/"))

                                          (and (* "*") (+ comment-chr) comment-part)))

(define-peg-pattern comment-chr body (or "\t" "\n" (range #\ #\)) (range #\+ #\xffff)))

(define-peg-pattern package-name body (* (or (range #\a #\z) (range #\A #\Z)

                                             (range #\0 #\9) "_" ".")))

(define-peg-pattern class-pat all (and (? (and annotation-pat (* WS)))

                                       (? (and (ignore "public") (* WS))) (ignore "class")

                                       (* WS) package-name (* WS)

                                       (? extends)

                                       (? implements)

                                       (ignore "{") class-body (ignore "}")))

(define-peg-pattern extends all (? (and (ignore "extends") (* WS)

                                        package-name (* WS))))

(define-peg-pattern implements all (? (and (ignore "implements") (* WS)

                                           package-name (* WS))))

(define-peg-pattern annotation-pat all (and (ignore "@") package-name

                                            (? (and

                                                 (ignore "(") (* WS)

                                                 annotation-attr

                                                 (* (and (ignore ",") (* WS) annotation-attr))

                                                 (ignore ")")))))

(define-peg-pattern annotation-attr all (and attr-name (* WS) (ignore "=")

                                             (* WS) attr-value (* WS)))

(define-peg-pattern attr-name all (* (or (range #\a #\z) (range #\A #\Z) (range #\0 #\9)

                                         "_")))

(define-peg-pattern attr-value all (or "true" "false"

                                       (+ (or (range #\0 #\9) (range #\a #\z)

                                              (range #\A #\Z) "." "_"))

                                       string-pat))

(define-peg-pattern string-pat body (and (ignore "\"") (* string-chr) (ignore "\"")))

(define-peg-pattern string-chr body (or " " "!" (and (ignore "\\") "\"")

                                        (and (ignore "\\") "\\") (range #\# #\xffff)))

(define-peg-pattern class-body all (and (* WS) (* (and class-statement (* WS)))))

(define-peg-pattern class-statement body (or comment param-pat method-pat))

(define-peg-pattern param-pat all (and (? (and annotation-pat (* WS)))

                                       (? (and (ignore (or "private" "public" "protected"))

                                               (* WS)))

                                       type-name (* WS) param-name

                                       (? (and (* WS) (ignore "=") (* WS) (+ valuechr)))

                                       (ignore ";")))

(define-peg-pattern valuechr none (or string-pat comment "\n" "\t" "\r"

                                      (range #\  #\:) (range #\< #\xffff)))

(define-peg-pattern param-name all (* (or (range #\a #\z) (range #\A #\Z) (range #\0 #\9)

                                          "_")))

(define-peg-pattern type-name all (* (or (range #\a #\z) (range #\A #\Z) (range #\0 #\9)

                                         "_" "<" ">")))

(define-peg-pattern method-pat all (and (? (and annotation-pat (* WS)))

                                        (? (and (ignore (or "private" "public" "protected"))

                                                (* WS)))

                                        type-name (* WS) param-name (* WS)

                                        (ignore "(")

                                        param-list (ignore ")") (* WS)

                                        (? (and (ignore "throws") (* WS) package-name (* WS)

                                                (* (and (ignore ",") (* WS) package-name

                                                        (* WS)))))

                                        (ignore "{") (* WS) (? (and method-statements (* WS)))

                                        (ignore "}")))

(define-peg-pattern param-list all (and (* WS) (* (and type-name (* WS) param-name (* WS)

                                                       (? (ignore ",")) (* WS)))))

(define-peg-pattern method-statements none (and (or (+ method-chr)

                                                    (and "{" method-statements "}")

                                                    string-pat)

                                                (? method-statements)))

(define-peg-pattern method-chr none (or "\t" "\n" "\r" " " "!" (range #\# #\z) "|"

                                        (range #\~ #\xffff)))

(define (parse-java-file file)

  (peg:tree (match-pattern java-file (call-with-input-file file get-string-all))))