;;; tree-sitter-tests.el --- tests for src/tree-sitter.c         -*- lexical-binding: t; -*-

;; Copyright (C) 2021 Free Software Foundation, Inc.

;; This file is part of GNU Emacs.

;; GNU Emacs 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 Emacs 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 Emacs.  If not, see <https://www.gnu.org/licenses/>.

;;; Code:

(require 'ert)
(require 'tree-sitter)

(ert-deftest tree-sitter-basic-parsing ()
  "Test basic parsing routines."
  (with-temp-buffer
    (let ((parser (tree-sitter-parser-create
                   (current-buffer) 'tree-sitter-json)))
      (should
       (eq parser (car tree-sitter-parser-list)))
      (should
       (equal (tree-sitter-node-string
               (tree-sitter-parser-root-node parser))
              "(ERROR)"))

      (insert "[1,2,3]")
      (should
       (equal (tree-sitter-node-string
               (tree-sitter-parser-root-node parser))
              "(document (array (number) (number) (number)))"))

      (goto-char (point-min))
      (forward-char 3)
      (insert "{\"name\": \"Bob\"},")
      (should
       (equal
        (tree-sitter-node-string
         (tree-sitter-parser-root-node parser))
        "(document (array (number) (object (pair key: (string (string_content)) value: (string (string_content)))) (number) (number)))")))))

(ert-deftest tree-sitter-node-api ()
  "Tests for node API."
  (with-temp-buffer
    (let (parser root-node doc-node object-node pair-node)
      (progn
        (insert "[1,2,{\"name\": \"Bob\"},3]")
        (setq parser (tree-sitter-parser-create
                      (current-buffer) 'tree-sitter-json))
        (setq root-node (tree-sitter-parser-root-node
                         parser)))
      ;; `tree-sitter-node-type'.
      (should (equal "document" (tree-sitter-node-type root-node)))
      ;; `tree-sitter-node-check'.
      (should (eq t (tree-sitter-node-check root-node 'named)))
      (should (eq nil (tree-sitter-node-check root-node 'missing)))
      (should (eq nil (tree-sitter-node-check root-node 'extra)))
      (should (eq nil (tree-sitter-node-check root-node 'has-error)))
      ;; `tree-sitter-node-child'.
      (setq doc-node (tree-sitter-node-child root-node 0))
      (should (equal "array" (tree-sitter-node-type doc-node)))
      (should (equal (tree-sitter-node-string doc-node)
                     "(array (number) (number) (object (pair key: (string (string_content)) value: (string (string_content)))) (number))"))
      ;; `tree-sitter-node-child-count'.
      (should (eql 9 (tree-sitter-node-child-count doc-node)))
      (should (eql 4 (tree-sitter-node-child-count doc-node t)))
      ;; `tree-sitter-node-field-name-for-child'.
      (setq object-node (tree-sitter-node-child doc-node 2 t))
      (setq pair-node (tree-sitter-node-child object-node 0 t))
      (should (equal "object" (tree-sitter-node-type object-node)))
      (should (equal "pair" (tree-sitter-node-type pair-node)))
      (should (equal "key"
                     (tree-sitter-node-field-name-for-child
                      pair-node 0)))
      ;; `tree-sitter-node-child-by-field-name'.
      (should (equal "(string (string_content))"
                     (tree-sitter-node-string
                      (tree-sitter-node-child-by-field-name
                       pair-node "key"))))
      ;; `tree-sitter-node-next-sibling'.
      (should (equal "(number)"
                     (tree-sitter-node-string
                      (tree-sitter-node-next-sibling object-node t))))
      (should (equal "(\",\")"
                     (tree-sitter-node-string
                      (tree-sitter-node-next-sibling object-node))))
      ;; `tree-sitter-node-prev-sibling'.
      (should (equal "(number)"
                     (tree-sitter-node-string
                      (tree-sitter-node-prev-sibling object-node t))))
      (should (equal "(\",\")"
                     (tree-sitter-node-string
                      (tree-sitter-node-prev-sibling object-node))))
      ;; `tree-sitter-node-first-child-for-pos'.
      (should (equal "(number)"
                     (tree-sitter-node-string
                      (tree-sitter-node-first-child-for-pos
                       doc-node 3 t))))
      (should (equal "(\",\")"
                     (tree-sitter-node-string
                      (tree-sitter-node-first-child-for-pos
                       doc-node 3))))
      ;; `tree-sitter-node-descendant-for-range'.
      (should (equal "(\"{\")"
                     (tree-sitter-node-string
                      (tree-sitter-node-descendant-for-range
                       root-node 6 7))))
      (should (equal "(object (pair key: (string (string_content)) value: (string (string_content))))"
                     (tree-sitter-node-string
                      (tree-sitter-node-descendant-for-range
                       root-node 6 7 t))))
      ;; `tree-sitter-node-eq'.
      (should (tree-sitter-node-eq root-node root-node))
      (should (not (tree-sitter-node-eq root-node doc-node))))))

(ert-deftest tree-sitter-query-api ()
  "Tests for query API."
  (with-temp-buffer
    (let (parser root-node pattern doc-node object-node pair-node)
      (progn
        (insert "[1,2,{\"name\": \"Bob\"},3]")
        (setq parser (tree-sitter-parser-create
                      (current-buffer) 'tree-sitter-json))
        (setq root-node (tree-sitter-parser-root-node
                         parser)))

      (dolist (pattern
               '("(string) @string
(pair key: (_) @keyword)
((_) @bob (#match \"^B.b$\" @bob))
(number) @number
((number) @n3 (#equal \"3\" @n3)) "
                 ((string) @string
                  (pair key: (_) @keyword)
                  ((_) @bob (:match "^B.b$" @bob))
                  (number) @number
                  ((number) @n3 (:equal "3" @n3)))))
        (should
         (equal
          '((number . "1") (number . "2")
            (keyword . "\"name\"")
            (string . "\"name\"")
            (string . "\"Bob\"")
            (bob . "Bob")
            (number . "3")
            (n3 . "3"))
          (mapcar (lambda (entry)
                    (cons (car entry)
                          (tree-sitter-node-text
                           (cdr entry))))
                  (tree-sitter-query-capture root-node pattern))))
        (should
         (equal
          "(type field: (_) @capture .) ? * + \"return\""
          (tree-sitter-expand-query
           '((type field: (_) @capture :anchor)
             :? :* :+ "return"))))))))

(ert-deftest tree-sitter-narrow ()
  "Tests if narrowing works."
  (with-temp-buffer
    (let (parser root-node pattern doc-node object-node pair-node)
      (progn
        (insert "xxx[1,{\"name\": \"Bob\"},2,3]xxx")
        (narrow-to-region (+ (point-min) 3) (- (point-max) 3))
        (setq parser (tree-sitter-parser-create
                      (current-buffer) 'tree-sitter-json))
        (setq root-node (tree-sitter-parser-root-node
                         parser)))
      ;; This test is from the basic test.
      (should
       (equal
        (tree-sitter-node-string
         (tree-sitter-parser-root-node parser))
        "(document (array (number) (object (pair key: (string (string_content)) value: (string (string_content)))) (number) (number)))"))

      (widen)
      (goto-char (point-min))
      (insert "ooo")
      (should (equal "oooxxx[1,{\"name\": \"Bob\"},2,3]xxx"
                     (buffer-string)))
      (delete-region 10 26)
      (should (equal "oooxxx[1,2,3]xxx"
                     (buffer-string)))
      (narrow-to-region (+ (point-min) 6) (- (point-max) 3))
      ;; This test is also from the basic test.
      (should
       (equal (tree-sitter-node-string
               (tree-sitter-parser-root-node parser))
              "(document (array (number) (number) (number)))"))
      (widen)
      (goto-char (point-max))
      (insert "[1,2]")
      (should (equal "oooxxx[1,2,3]xxx[1,2]"
                     (buffer-string)))
      (narrow-to-region (- (point-max) 5) (point-max))
      (should
       (equal (tree-sitter-node-string
               (tree-sitter-parser-root-node parser))
              "(document (array (number) (number)))"))
      (widen)
      (goto-char (point-min))
      (insert "[1]")
      (should (equal "[1]oooxxx[1,2,3]xxx[1,2]"
                     (buffer-string)))
      (narrow-to-region (point-min) (+ (point-min) 3))
      (should
       (equal (tree-sitter-node-string
               (tree-sitter-parser-root-node parser))
              "(document (array (number)))")))))

(ert-deftest tree-sitter-range ()
  "Tests if range works."
  (with-temp-buffer
    (let (parser root-node pattern doc-node object-node pair-node)
      (progn
        (insert "[[1],oooxxx[1,2,3],xxx[1,2]]")
        (setq parser (tree-sitter-parser-create
                      (current-buffer) 'tree-sitter-json))
        (setq root-node (tree-sitter-parser-root-node
                         parser)))
      (should-error
       (tree-sitter-parser-set-included-ranges
        parser '((1 . 6) (5 . 20)))
       :type '(tree-sitter-range-invalid))

      (tree-sitter-parser-set-included-ranges
       parser '((1 . 6) (12 . 20) (23 . 29)))
      (should (equal '((1 . 6) (12 . 20) (23 . 29))
                     (tree-sitter-parser-included-ranges parser)))
      (should (equal "(document (array (array (number)) (array (number) (number) (number)) (array (number) (number))))"
                     (tree-sitter-node-string
                      (tree-sitter-parser-root-node parser))))
      ;; TODO: More tests.
      )))

(ert-deftest tree-sitter-multi-lang ()
  "Tests if parsing multiple language works."
  (with-temp-buffer
    (let (html css js html-range css-range js-range)
      (progn
        (insert "<html><script>1</script><style>body {}</style></html>")
        (setq html (tree-sitter-get-parser-create 'tree-sitter-html))
        (setq css (tree-sitter-get-parser-create 'tree-sitter-css))
        (setq js (tree-sitter-get-parser-create 'tree-sitter-javascript)))
      ;; JavaScript.
      (setq js-range
            (tree-sitter-query-range
             'tree-sitter-html
             '((script_element (raw_text) @capture))))
      (should (equal '((15 . 16)) js-range))
      (tree-sitter-parser-set-included-ranges js js-range)
      (should (equal "(program (expression_statement (number)))"
                     (tree-sitter-node-string
                      (tree-sitter-parser-root-node js))))
      ;; CSS.
      (setq css-range
            (tree-sitter-query-range
             'tree-sitter-html
             '((style_element (raw_text) @capture))))
      (should (equal '((32 . 39)) css-range))
      (tree-sitter-parser-set-included-ranges css css-range)
      (should
       (equal "(stylesheet (rule_set (selectors (tag_name)) (block)))"
              (tree-sitter-node-string
               (tree-sitter-parser-root-node css))))
      ;; TODO: More tests.
      )))

(ert-deftest tree-sitter-parser-supplemental ()
  "Supplemental node functions."
  ;; `tree-sitter-get-parser'.
  (with-temp-buffer
    (should (equal (tree-sitter-get-parser 'tree-sitter-json) nil)))
  ;; `tree-sitter-get-parser-create'.
  (with-temp-buffer
    (should (not (equal (tree-sitter-get-parser-create 'tree-sitter-json)
                        nil))))
  ;; `tree-sitter-parse-string'.
  (should (equal (tree-sitter-node-string
                  (tree-sitter-parse-string
                   "[1,2,{\"name\": \"Bob\"},3]"
                   'tree-sitter-json))
                 "(document (array (number) (number) (object (pair key: (string (string_content)) value: (string (string_content)))) (number)))"))
  (with-temp-buffer
    (let (parser root-node doc-node object-node pair-node)
      (progn
        (insert "[1,2,{\"name\": \"Bob\"},3]")
        (setq parser (tree-sitter-parser-create
                      (current-buffer) 'tree-sitter-json))
        (setq root-node (tree-sitter-parser-root-node
                         parser))
        (setq doc-node (tree-sitter-node-child root-node 0)))
      ;; `tree-sitter-get-parser'.
      (should (not (equal (tree-sitter-get-parser 'tree-sitter-json)
                          nil)))
      ;; `tree-sitter-language-at'.
      (should (equal (tree-sitter-language-at (point))
                     'tree-sitter-json))
      ;; `tree-sitter-set-ranges', `tree-sitter-get-ranges'.
      (tree-sitter-set-ranges 'tree-sitter-json
                              '((1 . 2)))
      (should (equal (tree-sitter-get-ranges 'tree-sitter-json)
                     '((1 . 2)))))))

(ert-deftest tree-sitter-node-supplemental ()
  "Supplemental node functions."
  (let (parser root-node doc-node array-node)
    (progn
      (insert "[1,2,{\"name\": \"Bob\"},3]")
      (setq parser (tree-sitter-parser-create
                    (current-buffer) 'tree-sitter-json))
      (setq root-node (tree-sitter-parser-root-node
                       parser))
      (setq doc-node (tree-sitter-node-child root-node 0)))
    ;; `tree-sitter-node-buffer'.
    (should (equal (tree-sitter-node-buffer root-node)
                   (current-buffer)))
    ;; `tree-sitter-node-language'.
    (should (eq (tree-sitter-node-language root-node)
                'tree-sitter-json))
    ;; `tree-sitter-node-at'.
    (should (equal (tree-sitter-node-string
                    (tree-sitter-node-at 1 2 'tree-sitter-json))
                   "(\"[\")"))
    ;; `tree-sitter-buffer-root-node'.
    (should (tree-sitter-node-eq
             (tree-sitter-buffer-root-node 'tree-sitter-json)
             root-node))
    ;; `tree-sitter-filter-child'.
    (should (equal (mapcar
                    (lambda (node)
                      (tree-sitter-node-type node))
                    (tree-sitter-filter-child
                     doc-node (lambda (node)
                                (tree-sitter-node-check node 'named))))
                   '("number" "number" "object" "number")))
    ;; `tree-sitter-node-text'.
    (should (equal (tree-sitter-node-text doc-node)
                   "[1,2,{\"name\": \"Bob\"},3]"))
    ;; `tree-sitter-node-index'.
    (should (eq (tree-sitter-node-index doc-node)
                0))
    ;; TODO:
    ;; `tree-sitter-parent-until'
    ;; `tree-sitter-parent-while'
    ;; `tree-sitter-node-children'
    ;; `tree-sitter-node-field-name'
    ))

;; TODO
;; - Functions in tree-sitter.el
;; - tree-sitter-load-name-override-list

(provide 'tree-sitter-tests)
;;; tree-sitter-tests.el ends here