#-eql5
(error "Please use the EQL5 executable")

(require 'ecl-quicklisp)
(ql:quickload :fiveam)

(use-package :alexandria)
(use-package :fiveam)
(use-package :org)

(defmacro with-open-org-from-string (str &body body)
  `(progn
     (open-from-string ,str)
     ,@body))

(defmacro with-open-org-file (pathname &body body)
  `(progn
     (open-file ,pathname)
     ,@body
     (close-file)))

(defparameter empty-org "")

(defparameter test-org-1 "preamble 1
preamble 2
* header 1
line 1
line 2
** header 2
line 3
line 4
* header 3
line 5
")

(defmacro with-test-org-1 (&body body)
  `(let* ((test-org (sextant:make-document-from-string test-org-1))
          (preamble-1 (next-of test-org))
          (preamble-2 (next-of preamble-1))
          (header-1 (next-of preamble-2))
          (line-1 (next-of header-1))
          (line-2 (next-of line-1))
          (header-2 (next-of line-2))
          (line-3 (next-of header-2))
          (line-4 (next-of line-3))
          (header-3 (next-of line-4))
          (line-5 (next-of header-3)))
     ,@body))


(defparameter test-org-2 "* header 1
** sub header 1
*** sub sub header 1
** sub header 2
**** sub sub sub header 1
*** sub sub header 2
")

(defmacro with-test-org-2 (&body body)
  `(let* ((test-org (sextant:make-document-from-string test-org-2))
          (first-node (next-of test-org))
          (second-node (next-of first-node))
          (third-node (next-of second-node))
          (fourth-node (next-of third-node))
          (fifth-node (next-of fourth-node))
          (sixth-node (next-of fifth-node)))
     ,@body))

(def-suite all-tests)

(def-suite org :in all-tests)
(in-suite org)

(test parse-document
  (is (equal "" (raw-text-of (next-of (sextant:make-document-from-string empty-org)))))
  (is (null (next-of (next-of (sextant:make-document-from-string empty-org)))))
  (let ((test-org (sextant:make-document-from-string test-org-1)))
    (is (= 10 (loop for n = (next-of test-org) then (next-of n)
                    until (null n)
                    count n)))
    (is (= 3 (loop for h = (next-headline-of test-org) then (next-headline-of h)
                   until (null h)
                   count h)))
    (is (equal test-org-1 (with-output-to-string (str) (org-print test-org str)))))
  (let ((test-org (sextant:make-document-from-string test-org-2)))
    (is (= 6 (loop for n = (next-of test-org) then (next-of n)
                    until (null n)
                    count n)))
    (is (= 6 (loop for h = (next-headline-of test-org) then (next-headline-of h)
                   until (null h)
                   count h)))
    (is (equal test-org-2 (with-output-to-string (str) (org-print test-org str))))))

(test headline-of
  (let* ((test-org (sextant:make-document-from-string test-org-1))
         (current-node (next-of test-org)))
    (is (null (headline-of current-node)))
    (let ((first-headline (next-headline-of current-node)))
      (is (equal "header 1" (title-of first-headline)))
      (is (null (headline-of first-headline)))
      (setf current-node (next-of first-headline))
      (is (eq first-headline (headline-of current-node)))
      (is (eq (next-headline-of first-headline) (next-headline-of current-node))))))

(test depth-of
  (let* ((test-org (sextant:make-document-from-string test-org-1))
         (first-node (next-of test-org)))
    (is (= 0 (depth-of first-node)))
    (let* ((first-headline (next-headline-of first-node))
           (line-1 (next-of first-headline)))
      (is (= 0 (depth-of first-headline)))
      (is (= 1 (depth-of line-1))))))

(test path-of
  (with-test-org-2
      (is (equal (list first-node) (path-of first-node)))
    (is (equal (list first-node second-node) (path-of second-node)))
    (is (equal (list first-node second-node third-node) (path-of third-node)))
    (is (equal (list first-node fourth-node fifth-node) (path-of fifth-node)))))

(test count-nodes
  (with-test-org-1
      (is (= 0 (count-nodes line-2 line-2)))
    (is (= 1 (count-nodes preamble-1 preamble-2)))
    (is (= 3 (count-nodes header-2 header-3)))
    (is (= 9 (count-nodes preamble-1 line-5)))
    (is (null (count-nodes line-4 line-1)))))

(test visibility-1
  (with-test-org-1
    (collapse-node header-2)
    (is (equal "preamble 1
preamble 2
* header 1
line 1
line 2
** header 2
* header 3
line 5
" (with-output-to-string (str) (org-print test-org str t))))
    (collapse-node header-1)
    (is (null (node-visible-p line-1)))
    (is (equal "preamble 1
preamble 2
* header 1
* header 3
line 5
" (with-output-to-string (str) (org-print test-org str t))))
    (expand-node header-2)
    (is (equal "preamble 1
preamble 2
* header 1
line 3
line 4
* header 3
line 5
" (with-output-to-string (str) (org-print test-org str t))))
    (collapse-node header-3)
    (is (equal "preamble 1
preamble 2
* header 1
line 3
line 4
* header 3
" (with-output-to-string (str) (org-print test-org str t))))))

(test visibility-2
  (with-test-org-2
    (collapse-node second-node)
    (is (equal "* header 1
** sub header 1
** sub header 2
**** sub sub sub header 1
*** sub sub header 2
" (with-output-to-string (str) (org-print test-org str t))))
    (collapse-node fourth-node)
    (is (equal "* header 1
** sub header 1
** sub header 2
" (with-output-to-string (str) (org-print test-org str t))))
    (collapse-node first-node)
    (is (equal "* header 1
" (with-output-to-string (str) (org-print test-org str t))))
    (expand-node first-node)
    (is (equal "* header 1
** sub header 1
** sub header 2
" (with-output-to-string (str) (org-print test-org str t))))
    (expand-node first-node t)
    (is (equal "* header 1
** sub header 1
*** sub sub header 1
** sub header 2
**** sub sub sub header 1
*** sub sub header 2
" (with-output-to-string (str) (org-print test-org str t))))
    (collapse-node first-node)
    (ensure-node-visible fifth-node)
    (is (equal "* header 1
** sub header 1
** sub header 2
**** sub sub sub header 1
*** sub sub header 2
" (with-output-to-string (str) (org-print test-org str t))))))

(def-suite cursor :in all-tests)
(in-suite cursor)

(defmacro check-cursor (cursor node index visual-index)
  (once-only (cursor)
    `(progn
       (is (eq ,node (cursor-node ,cursor)))
       (is (eq ,index (cursor-index ,cursor)))
       (is (eq ,visual-index (visual-index ,cursor))))))

(defmacro check-visible-cursor (cursor node index visual-index)
  (once-only (cursor)
    `(progn
       (is (eq ,node (visible-node ,cursor)))
       (is (eq ,index (visible-index ,cursor)))
       (is (eq ,visual-index (visual-index ,cursor))))))

(test next-previous-node
  (with-test-org-1
      (let ((cursor (make-cursor test-org preamble-1 0 0)))
        (check-cursor cursor preamble-1 0 0)
        (check-visible-cursor cursor preamble-1 0 0)
        (setf cursor (next-node cursor))
        (check-visible-cursor cursor preamble-2 1 1)
        (setf cursor (next-node cursor))
        (check-visible-cursor cursor header-1 2 2)
        (setf cursor (next-node cursor))
        (check-visible-cursor cursor line-1 3 3)
        (setf cursor (next-node cursor))
        (check-visible-cursor cursor line-2 4 4)
        (setf cursor (next-node cursor))
        (check-visible-cursor cursor header-2 5 5)
        (setf cursor (next-node cursor))
        (check-visible-cursor cursor line-3 6 6)
        (setf cursor (next-node cursor))
        (check-visible-cursor cursor line-4 7 7)
        (setf cursor (next-node cursor))
        (check-visible-cursor cursor header-3 8 8)
        (setf cursor (next-node cursor))
        (check-visible-cursor cursor line-5 9 9)
        (is (null (next-node cursor)))
        (dotimes (i 9)
          (setf cursor (previous-node cursor)))
        (check-visible-cursor cursor preamble-1 0 0)
        (is (null (previous-node cursor))))))

(test next-previous-headline
  (with-test-org-1
    (let ((cursor (make-cursor test-org preamble-1 0 0)))
      (setf cursor (next-headline cursor))
      (check-visible-cursor cursor header-1 2 2)
      (setf cursor (next-headline cursor))
      (check-visible-cursor cursor header-2 5 5)
      (setf cursor (next-headline cursor))
      (check-visible-cursor cursor header-3 8 8)
      (is (null (next-headline cursor)))
      (setf cursor (previous-headline cursor))
      (check-visible-cursor cursor header-2 5 5)
      (setf cursor (previous-headline cursor))
      (check-visible-cursor cursor header-1 2 2)
      (is (null (previous-headline cursor))))))

(test next-previous-visible-node
  (with-test-org-1
      (let ((cursor (make-cursor test-org preamble-1 0 0)))
        (collapse-node header-1)
        (setf cursor (next-node (next-node cursor)))
        (check-visible-cursor cursor header-1 2 2)
        (setf cursor (next-visible-node cursor))
        (check-visible-cursor cursor header-3 8 3)
        (check-cursor cursor header-3 8 3)
        (expand-node header-1)
        (setf cursor (previous-visible-node cursor))
        (check-visible-cursor cursor header-2 5 2)
        (check-cursor cursor header-2 5 2)
        (setf cursor (previous-visible-node cursor))
        (check-visible-cursor cursor line-2 4 1))))

(test next-previous-hidden-node
  (with-test-org-1
      (let ((cursor (make-cursor test-org preamble-1 0 0)))
        (collapse-node header-1)
        (setf cursor (next-node (next-node cursor)))
        (check-cursor cursor header-1 2 2)
        (setf cursor (next-node cursor))
        (check-visible-cursor cursor header-1 2 2)
        (check-cursor cursor line-1 3 2)
        (setf cursor (next-node cursor))
        (check-visible-cursor cursor header-1 2 2)
        (check-cursor cursor line-2 4 2)
        (setf cursor (next-node cursor))
        (check-visible-cursor cursor header-1 2 2)
        (check-cursor cursor header-2 5 2)
        (setf cursor (next-headline cursor))
        (check-visible-cursor cursor header-3 8 3)
        (check-cursor cursor header-3 8 3)
        (setf cursor (previous-node cursor))
        (check-visible-cursor cursor header-1 2 2)
        (check-cursor cursor line-4 7 2)
        (expand-node header-2)
        (setf cursor (previous-node cursor))
        (check-visible-cursor cursor line-3 6 1)
        (check-cursor cursor line-3 6 1))))

(test goto-index
      (with-test-org-1
        (let ((cursor (make-cursor test-org preamble-1 0 0)))
          (setf cursor (goto-index cursor 4))
          (check-cursor cursor line-2 4 4)
          (setf cursor (goto-index cursor 9))
          (check-cursor cursor line-5 9 9)
          (setf cursor (goto-index cursor 0))
          (check-cursor cursor preamble-1 0 0)
          (is (null (goto-index cursor 10))))))

(run! 'all-tests)