;;; hierarchy-tests.el --- Tests for hierarchy.el  -*- lexical-binding:t -*-

;; Copyright (C) 2017-2019 Damien Cassou

;; Author: Damien Cassou <damien@cassou.me>
;; Maintainer: emacs-devel@gnu.org

;; 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/>.

;;; Commentary:

;; Tests for hierarchy.el

;;; Code:

(require 'ert)
(require 'hierarchy)

(defun hierarchy-animals ()
  "Create a sorted animal hierarchy."
  (let ((parentfn (lambda (item) (cl-case item
                              (dove 'bird)
                              (pigeon 'bird)
                              (bird 'animal)
                              (dolphin 'animal)
                              (cow 'animal))))
        (hierarchy (hierarchy-new)))
    (hierarchy-add-tree hierarchy 'dove parentfn)
    (hierarchy-add-tree hierarchy 'pigeon parentfn)
    (hierarchy-add-tree hierarchy 'dolphin parentfn)
    (hierarchy-add-tree hierarchy 'cow parentfn)
    (hierarchy-sort hierarchy)
    hierarchy))

(ert-deftest hierarchy-add-one-root ()
  (let ((parentfn (lambda (_) nil))
        (hierarchy (hierarchy-new)))
    (hierarchy-add-tree hierarchy 'animal parentfn)
    (should (equal (hierarchy-roots hierarchy) '(animal)))))

(ert-deftest hierarchy-add-one-item-with-parent ()
  (let ((parentfn (lambda (item)
                    (cl-case item
                      (bird 'animal))))
        (hierarchy (hierarchy-new)))
    (hierarchy-add-tree hierarchy 'bird parentfn)
    (should (equal (hierarchy-roots hierarchy) '(animal)))
    (should (equal (hierarchy-children hierarchy 'animal) '(bird)))))

(ert-deftest hierarchy-add-one-item-with-parent-and-grand-parent ()
  (let ((parentfn (lambda (item)
                    (cl-case item
                      (dove 'bird)
                      (bird 'animal))))
        (hierarchy (hierarchy-new)))
    (hierarchy-add-tree hierarchy 'dove parentfn)
    (should (equal (hierarchy-roots hierarchy) '(animal)))
    (should (equal (hierarchy-children hierarchy 'animal) '(bird)))
    (should (equal (hierarchy-children hierarchy 'bird) '(dove)))))

(ert-deftest hierarchy-add-same-root-twice ()
  (let ((parentfn (lambda (_) nil))
        (hierarchy (hierarchy-new)))
    (hierarchy-add-tree hierarchy 'animal parentfn)
    (hierarchy-add-tree hierarchy 'animal parentfn)
    (should (equal (hierarchy-roots hierarchy) '(animal)))))

(ert-deftest hierarchy-add-same-child-twice ()
  (let ((parentfn (lambda (item)
                    (cl-case item
                      (bird 'animal))))
        (hierarchy (hierarchy-new)))
    (hierarchy-add-tree hierarchy 'bird parentfn)
    (hierarchy-add-tree hierarchy 'bird parentfn)
    (should (equal (hierarchy-roots hierarchy) '(animal)))
    (should (equal (hierarchy-children hierarchy 'animal) '(bird)))))

(ert-deftest hierarchy-add-item-and-its-parent ()
  (let ((parentfn (lambda (item)
                    (cl-case item
                      (bird 'animal))))
        (hierarchy (hierarchy-new)))
    (hierarchy-add-tree hierarchy 'bird parentfn)
    (hierarchy-add-tree hierarchy 'animal parentfn)
    (should (equal (hierarchy-roots hierarchy) '(animal)))
    (should (equal (hierarchy-children hierarchy 'animal) '(bird)))))

(ert-deftest hierarchy-add-item-and-its-child ()
  (let ((parentfn (lambda (item)
                    (cl-case item
                      (bird 'animal))))
        (hierarchy (hierarchy-new)))
    (hierarchy-add-tree hierarchy 'animal parentfn)
    (hierarchy-add-tree hierarchy 'bird parentfn)
    (should (equal (hierarchy-roots hierarchy) '(animal)))
    (should (equal (hierarchy-children hierarchy 'animal) '(bird)))))

(ert-deftest hierarchy-add-two-items-sharing-parent ()
  (let ((parentfn (lambda (item)
                    (cl-case item
                      (dove 'bird)
                      (pigeon 'bird))))
        (hierarchy (hierarchy-new)))
    (hierarchy-add-tree hierarchy 'dove parentfn)
    (hierarchy-add-tree hierarchy 'pigeon parentfn)
    (should (equal (hierarchy-roots hierarchy) '(bird)))
    (should (equal (hierarchy-children hierarchy 'bird) '(dove pigeon)))))

(ert-deftest hierarchy-add-two-hierarchies ()
  (let ((parentfn (lambda (item)
                    (cl-case item
                      (dove 'bird)
                      (circle 'shape))))
        (hierarchy (hierarchy-new)))
    (hierarchy-add-tree hierarchy 'dove parentfn)
    (hierarchy-add-tree hierarchy 'circle parentfn)
    (should (equal (hierarchy-roots hierarchy) '(bird shape)))
    (should (equal (hierarchy-children hierarchy 'bird) '(dove)))
    (should (equal (hierarchy-children hierarchy 'shape) '(circle)))))

(ert-deftest hierarchy-add-with-childrenfn ()
  (let ((childrenfn (lambda (item)
                      (cl-case item
                        (animal '(bird))
                        (bird '(dove pigeon)))))
        (hierarchy (hierarchy-new)))
    (hierarchy-add-tree hierarchy 'animal nil childrenfn)
    (should (equal (hierarchy-roots hierarchy) '(animal)))
    (should (equal (hierarchy-children hierarchy 'animal) '(bird)))
    (should (equal (hierarchy-children hierarchy 'bird) '(dove pigeon)))))

(ert-deftest hierarchy-add-with-parentfn-and-childrenfn ()
  (let ((parentfn (lambda (item)
                    (cl-case item
                      (bird 'animal)
                      (animal 'life-form))))
        (childrenfn (lambda (item)
                      (cl-case item
                        (bird '(dove pigeon))
                        (pigeon '(ashy-wood-pigeon)))))
        (hierarchy (hierarchy-new)))
    (hierarchy-add-tree hierarchy 'bird parentfn childrenfn)
    (should (equal (hierarchy-roots hierarchy) '(life-form)))
    (should (equal (hierarchy-children hierarchy 'life-form) '(animal)))
    (should (equal (hierarchy-children hierarchy 'animal) '(bird)))
    (should (equal (hierarchy-children hierarchy 'bird) '(dove pigeon)))
    (should (equal (hierarchy-children hierarchy 'pigeon) '(ashy-wood-pigeon)))))

(ert-deftest hierarchy-add-twice-with-parentfn-and-childrenfn ()
  (let* ((parentfn (lambda (item)
                     (cl-case item
                       (dove 'bird)
                       (bird 'animal))))
         (childrenfn (lambda (item)
                       (cl-case item
                         (animal '(bird))
                         (bird '(dove)))))
         (hierarchy (hierarchy-new)))
    (hierarchy-add-tree hierarchy 'bird parentfn childrenfn)
    (should (equal (hierarchy-children hierarchy 'animal) '(bird)))
    (should (equal (hierarchy-children hierarchy 'bird) '(dove)))))

(ert-deftest hierarchy-add-trees ()
  (let ((parentfn (lambda (item)
                    (cl-case item
                      (dove 'bird)
                      (pigeon 'bird)
                      (bird 'animal))))
        (hierarchy (hierarchy-new)))
    (hierarchy-add-trees hierarchy '(dove pigeon) parentfn)
    (should (equal (hierarchy-roots hierarchy) '(animal)))
    (should (equal (hierarchy-children hierarchy 'animal) '(bird)))
    (should (equal (hierarchy-children hierarchy 'bird) '(dove pigeon)))))

(ert-deftest hierarchy-from-list ()
  (let ((hierarchy (hierarchy-from-list
                    '(animal (bird (dove)
                                   (pigeon))
                             (cow)
                             (dolphin)))))
    (hierarchy-sort hierarchy (lambda (item1 item2)
                                (string< (car item1)
                                         (car item2))))
    (should (equal (hierarchy-to-string hierarchy (lambda (item) (symbol-name (car item))))
                   "animal\n  bird\n    dove\n    pigeon\n  cow\n  dolphin\n"))))

(ert-deftest hierarchy-from-list-with-duplicates ()
  (let ((hierarchy (hierarchy-from-list
                    '(a (b) (b))
                    t)))
    (hierarchy-sort hierarchy (lambda (item1 item2)
                                ;; sort by ID
                                (< (car item1) (car item2))))
    (should (equal (hierarchy-length hierarchy) 3))
    (should (equal (hierarchy-to-string
                    hierarchy
                    (lambda (item)
                      (format "%s(%s)"
                              (cadr item)
                              (car item))))
                   "a(1)\n  b(2)\n  b(3)\n"))))

(ert-deftest hierarchy-from-list-with-childrenfn ()
  (let ((hierarchy (hierarchy-from-list
                    "abc"
                    nil
                    (lambda (item)
                      (when (string= item "abc")
                        (split-string item "" t))))))
    (hierarchy-sort hierarchy (lambda (item1 item2) (string< item1 item2)))
    (should (equal (hierarchy-length hierarchy) 4))
    (should (equal (hierarchy-to-string hierarchy)
                   "abc\n  a\n  b\n  c\n"))))

(ert-deftest hierarchy-add-relation-check-error-when-different-parent ()
  (let ((parentfn (lambda (item)
                    (cl-case item
                      (bird 'animal))))
        (hierarchy (hierarchy-new)))
    (hierarchy-add-tree hierarchy 'bird parentfn)
    (should-error
     (hierarchy--add-relation hierarchy 'bird 'cow #'identity))))

(ert-deftest hierarchy-empty-p-return-non-nil-for-empty ()
  (should (hierarchy-empty-p (hierarchy-new))))

(ert-deftest hierarchy-empty-p-return-nil-for-non-empty ()
  (should-not (hierarchy-empty-p (hierarchy-animals))))

(ert-deftest hierarchy-length-of-empty-is-0 ()
  (should (equal (hierarchy-length (hierarchy-new)) 0)))

(ert-deftest hierarchy-length-of-non-empty-counts-items ()
  (let ((parentfn (lambda (item)
                    (cl-case item
                      (bird 'animal)
                      (dove 'bird)
                      (pigeon 'bird))))
        (hierarchy (hierarchy-new)))
    (hierarchy-add-tree hierarchy 'dove parentfn)
    (hierarchy-add-tree hierarchy 'pigeon parentfn)
    (should (equal (hierarchy-length hierarchy) 4))))

(ert-deftest hierarchy-has-root ()
  (let ((parentfn (lambda (item)
                    (cl-case item
                      (bird 'animal)
                      (dove 'bird)
                      (pigeon 'bird))))
        (hierarchy (hierarchy-new)))
    (should-not (hierarchy-has-root hierarchy 'animal))
    (should-not (hierarchy-has-root hierarchy 'bird))
    (hierarchy-add-tree hierarchy 'dove parentfn)
    (hierarchy-add-tree hierarchy 'pigeon parentfn)
    (should (hierarchy-has-root hierarchy 'animal))
    (should-not (hierarchy-has-root hierarchy 'bird))))

(ert-deftest hierarchy-leafs ()
  (let ((animals (hierarchy-animals)))
    (should (equal (hierarchy-leafs animals)
                   '(dove pigeon dolphin cow)))))

(ert-deftest hierarchy-leafs-includes-lonely-roots ()
  (let ((parentfn (lambda (_) nil))
        (hierarchy (hierarchy-new)))
    (hierarchy-add-tree hierarchy 'foo parentfn)
    (should (equal (hierarchy-leafs hierarchy)
                   '(foo)))))

(ert-deftest hierarchy-leafs-of-node ()
  (let ((animals (hierarchy-animals)))
    (should (equal (hierarchy-leafs animals 'cow) '()))
    (should (equal (hierarchy-leafs animals 'animal) '(dove pigeon dolphin cow)))
    (should (equal (hierarchy-leafs animals 'bird) '(dove pigeon)))
    (should (equal (hierarchy-leafs animals 'dove) '()))))

(ert-deftest hierarchy-child-p ()
  (let ((animals (hierarchy-animals)))
    (should (hierarchy-child-p animals 'dove 'bird))
    (should (hierarchy-child-p animals 'bird 'animal))
    (should (hierarchy-child-p animals 'cow 'animal))
    (should-not (hierarchy-child-p animals 'cow 'bird))
    (should-not (hierarchy-child-p animals 'bird 'cow))
    (should-not (hierarchy-child-p animals 'animal 'dove))
    (should-not (hierarchy-child-p animals 'animal 'bird))))

(ert-deftest hierarchy-descendant ()
  (let ((animals (hierarchy-animals)))
    (should (hierarchy-descendant-p animals 'dove 'animal))
    (should (hierarchy-descendant-p animals 'dove 'bird))
    (should (hierarchy-descendant-p animals 'bird 'animal))
    (should (hierarchy-descendant-p animals 'cow 'animal))
    (should-not (hierarchy-descendant-p animals 'cow 'bird))
    (should-not (hierarchy-descendant-p animals 'bird 'cow))
    (should-not (hierarchy-descendant-p animals 'animal 'dove))
    (should-not (hierarchy-descendant-p animals 'animal 'bird))))

(ert-deftest hierarchy-descendant-if-not-same ()
  (let ((animals (hierarchy-animals)))
    (should-not (hierarchy-descendant-p animals 'cow 'cow))
    (should-not (hierarchy-descendant-p animals 'dove 'dove))
    (should-not (hierarchy-descendant-p animals 'bird 'bird))
    (should-not (hierarchy-descendant-p animals 'animal 'animal))))

;; keywords supported: :test :key
(ert-deftest hierarchy--set-equal ()
  (should     (hierarchy--set-equal '(1 2 3) '(1 2 3)))
  (should     (hierarchy--set-equal '(1 2 3) '(3 2 1)))
  (should     (hierarchy--set-equal '(3 2 1) '(1 2 3)))
  (should-not (hierarchy--set-equal '(2 3) '(3 2 1)))
  (should-not (hierarchy--set-equal '(1 2 3) '(2 3)))
  (should-not (hierarchy--set-equal '("1" "2") '("2" "1") :test #'eq))
  (should     (hierarchy--set-equal '("1" "2") '("2" "1") :test #'equal))
  (should-not (hierarchy--set-equal '(1 2) '(-1 -2)))
  (should     (hierarchy--set-equal '(1 2) '(-1 -2) :key #'abs))
  (should-not (hierarchy--set-equal '(("1" 1) ("2" 1)) '(("1" 2) ("2" 2))))
  (should-not (hierarchy--set-equal '(("1" 1) ("2" 1)) '(("1" 2) ("2" 2)) :key #'car))
  (should-not (hierarchy--set-equal '(("1" 1) ("2" 1)) '(("1" 2) ("2" 2)) :test #'equal))
  (should     (hierarchy--set-equal '(("1" 1) ("2" 1)) '(("1" 2) ("2" 2)) :key #'car :test #'equal)))

(ert-deftest hierarchy-equal-returns-true-for-same-hierarchy ()
  (let ((animals (hierarchy-animals)))
    (should (hierarchy-equal animals animals))
    (should (hierarchy-equal (hierarchy-animals) animals))))

(ert-deftest hierarchy-equal-returns-true-for-hierarchy-copies ()
  (let ((animals (hierarchy-animals)))
    (should (hierarchy-equal animals (hierarchy-copy animals)))))

(ert-deftest hierarchy-map-item-on-leaf ()
  (let* ((animals (hierarchy-animals))
         (result (hierarchy-map-item (lambda (item indent) (cons item indent))
                                     'cow
                                     animals)))
    (should (equal result '((cow . 0))))))

(ert-deftest hierarchy-map-item-on-leaf-with-indent ()
  (let* ((animals (hierarchy-animals))
         (result (hierarchy-map-item (lambda (item indent) (cons item indent))
                                     'cow
                                     animals
                                     2)))
    (should (equal result '((cow . 2))))))

(ert-deftest hierarchy-map-item-on-parent ()
  (let* ((animals (hierarchy-animals))
         (result (hierarchy-map-item (lambda (item indent) (cons item indent))
                                     'bird
                                     animals)))
    (should (equal result '((bird . 0) (dove . 1) (pigeon . 1))))))

(ert-deftest hierarchy-map-item-on-grand-parent ()
  (let* ((animals (hierarchy-animals))
         (result (hierarchy-map-item (lambda (item indent) (cons item indent))
                                     'animal
                                     animals)))
    (should (equal result '((animal . 0) (bird . 1) (dove . 2) (pigeon . 2)
                            (cow . 1) (dolphin . 1))))))

(ert-deftest hierarchy-map-conses ()
  (let* ((animals (hierarchy-animals))
         (result (hierarchy-map (lambda (item indent)
                                  (cons item indent))
                                animals)))
    (should (equal result '((animal . 0)
                            (bird . 1)
                            (dove . 2)
                            (pigeon . 2)
                            (cow . 1)
                            (dolphin . 1))))))

(ert-deftest hierarchy-map-tree ()
  (let ((animals (hierarchy-animals)))
    (should (equal (hierarchy-map-tree (lambda (item indent children)
                                         (list item indent children))
                                       animals)
                   '(animal
                     0
                     ((bird 1 ((dove 2 nil) (pigeon 2 nil)))
                      (cow 1 nil)
                      (dolphin 1 nil)))))))

(ert-deftest hierarchy-map-hierarchy-keeps-hierarchy ()
  (let* ((animals (hierarchy-animals))
         (result (hierarchy-map-hierarchy (lambda (item _) (identity item))
                                          animals)))
    (should (hierarchy-equal animals result))))

(ert-deftest hierarchy-map-applies-function ()
  (let* ((animals (hierarchy-animals))
         (parentfn (lambda (item)
                     (cond
                      ((equal item "bird") "animal")
                      ((equal item "dove") "bird")
                      ((equal item "pigeon") "bird")
                      ((equal item "cow") "animal")
                      ((equal item "dolphin") "animal"))))
         (expected (hierarchy-new)))
    (hierarchy-add-tree expected "dove" parentfn)
    (hierarchy-add-tree expected "pigeon" parentfn)
    (hierarchy-add-tree expected "cow" parentfn)
    (hierarchy-add-tree expected "dolphin" parentfn)
    (should (hierarchy-equal
             (hierarchy-map-hierarchy (lambda (item _) (symbol-name item)) animals)
             expected))))

(ert-deftest hierarchy-extract-tree ()
  (let* ((animals (hierarchy-animals))
         (birds (hierarchy-extract-tree animals 'bird)))
    (hierarchy-sort birds)
    (should (equal (hierarchy-roots birds) '(animal)))
    (should (equal (hierarchy-children birds 'animal) '(bird)))
    (should (equal (hierarchy-children birds 'bird) '(dove pigeon)))))

(ert-deftest hierarchy-extract-tree-nil-if-not-in-hierarchy ()
  (let* ((animals (hierarchy-animals)))
    (should-not (hierarchy-extract-tree animals 'foobar))))

(ert-deftest hierarchy-items-of-empty-hierarchy-is-empty ()
  (should (seq-empty-p (hierarchy-items (hierarchy-new)))))

(ert-deftest hierarchy-items-returns-sequence-of-same-length ()
  (let* ((animals (hierarchy-animals))
         (result (hierarchy-items animals)))
    (should (= (seq-length result) (hierarchy-length animals)))))

(ert-deftest hierarchy-items-return-all-elements-of-hierarchy ()
  (let* ((animals (hierarchy-animals))
         (result (hierarchy-items animals)))
    (should (equal (seq-sort #'string< result) '(animal bird cow dolphin dove pigeon)))))

(ert-deftest hierarchy-labelfn-indent-no-indent-if-0 ()
  (let* ((labelfn-base (lambda (_item _indent) (insert "foo")))
         (labelfn (hierarchy-labelfn-indent labelfn-base)))
    (should (equal
             (with-temp-buffer
               (funcall labelfn "bar" 0)
               (buffer-substring (point-min) (point-max)))
             "foo"))))

(ert-deftest hierarchy-labelfn-indent-three-times-if-3 ()
  (let* ((labelfn-base (lambda (_item _indent) (insert "foo")))
         (labelfn (hierarchy-labelfn-indent labelfn-base)))
    (should (equal
             (with-temp-buffer
               (funcall labelfn "bar" 3)
               (buffer-substring (point-min) (point-max)))
             "      foo"))))

(ert-deftest hierarchy-labelfn-indent-default-indent-string ()
  (let* ((labelfn-base (lambda (_item _indent) (insert "foo")))
         (labelfn (hierarchy-labelfn-indent labelfn-base)))
    (should (equal
             (with-temp-buffer
               (funcall labelfn "bar" 1)
               (buffer-substring (point-min) (point-max)))
             "  foo"))))

(ert-deftest hierarchy-labelfn-indent-custom-indent-string ()
  (let* ((labelfn-base (lambda (_item _indent) (insert "foo")))
         (labelfn (hierarchy-labelfn-indent labelfn-base "###"))
         (content (with-temp-buffer
                    (funcall labelfn "bar" 1)
                    (buffer-substring (point-min) (point-max)))))
    (should (equal content "###foo"))))

(ert-deftest hierarchy-labelfn-button-propertize ()
  (let* ((labelfn-base (lambda (_item _indent) (insert "foo")))
         (actionfn #'identity)
         (labelfn (hierarchy-labelfn-button labelfn-base actionfn))
         (properties (with-temp-buffer
                       (funcall labelfn "bar" 1)
                       (text-properties-at 1))))
    (should (equal (car properties) 'action))))

(ert-deftest hierarchy-labelfn-button-execute-labelfn ()
  (let* ((labelfn-base (lambda (_item _indent) (insert "foo")))
         (actionfn #'identity)
         (labelfn (hierarchy-labelfn-button labelfn-base actionfn))
         (content (with-temp-buffer
                    (funcall labelfn "bar" 1)
                    (buffer-substring-no-properties (point-min) (point-max)))))
    (should (equal content "foo"))))

(ert-deftest hierarchy-labelfn-button-if-does-not-button-unless-condition ()
  (let ((labelfn-base (lambda (_item _indent) (insert "foo")))
        (spy-count 0)
        (condition (lambda (_item _indent) nil)))
    (cl-letf (((symbol-function 'hierarchy-labelfn-button) (lambda (_labelfn _actionfn) (lambda (_item _indent) (cl-incf spy-count)))))
      (funcall (hierarchy-labelfn-button-if labelfn-base condition #'identity) nil nil)
      (should (equal spy-count 0)))))

(ert-deftest hierarchy-labelfn-button-if-does-button-when-condition ()
  (let ((labelfn-base (lambda (_item _indent) (insert "foo")))
        (spy-count 0)
        (condition (lambda (_item _indent) t)))
    (cl-letf (((symbol-function 'hierarchy-labelfn-button) (lambda (_labelfn _actionfn) (lambda (_item _indent) (cl-incf spy-count)))))
      (funcall (hierarchy-labelfn-button-if labelfn-base condition #'identity) nil nil)
      (should (equal spy-count 1)))))

(ert-deftest hierarchy-labelfn-to-string ()
  (let ((labelfn (lambda (item _indent) (insert item))))
    (should (equal (hierarchy-labelfn-to-string labelfn "foo" 1) "foo"))))

(ert-deftest hierarchy-print ()
  (let* ((animals (hierarchy-animals))
         (result (with-temp-buffer
                   (hierarchy-print animals)
                   (buffer-substring-no-properties (point-min) (point-max)))))
    (should (equal result "animal\n  bird\n    dove\n    pigeon\n  cow\n  dolphin\n"))))

(ert-deftest hierarchy-to-string ()
  (let* ((animals (hierarchy-animals))
         (result (hierarchy-to-string animals)))
    (should (equal result "animal\n  bird\n    dove\n    pigeon\n  cow\n  dolphin\n"))))

(ert-deftest hierarchy-tabulated-display ()
  (let* ((animals (hierarchy-animals))
         (labelfn (lambda (item _indent) (insert (symbol-name item))))
         (contents (with-temp-buffer
                     (hierarchy-tabulated-display animals labelfn (current-buffer))
                     (buffer-substring-no-properties (point-min) (point-max)))))
    (should (equal contents "animal\nbird\ndove\npigeon\ncow\ndolphin\n"))))

(ert-deftest hierarchy-sort-non-root-nodes ()
  (let* ((animals (hierarchy-animals)))
    (should (equal (hierarchy-roots animals) '(animal)))
    (should (equal (hierarchy-children animals 'animal) '(bird cow dolphin)))
    (should (equal (hierarchy-children animals 'bird) '(dove pigeon)))))

(ert-deftest hierarchy-sort-roots ()
  (let* ((organisms (hierarchy-new))
         (parentfn (lambda (item)
                     (cl-case item
                       (oak 'plant)
                       (bird 'animal)))))
    (hierarchy-add-tree organisms 'oak parentfn)
    (hierarchy-add-tree organisms 'bird parentfn)
    (hierarchy-sort organisms)
    (should (equal (hierarchy-roots organisms) '(animal plant)))))

(defun hierarchy-examples-delayed--find-number (num)
  "Find a number, NUM, by adding 1s together until you reach it.
This is entire contrived and mostly meant to be purposefully inefficient to
not be possible on a large scale.
Running the number 200 causes this function to crash; running this function in
`hierarchy-add-tree' with a root of 80 and no delayed children causes that to
 crash."

  (funcall (lambda (funct) (funcall funct 1 funct))
           (lambda (n funct)
             (if (< n num)
                 (+ 1 (funcall funct (+ 1 n) funct))
               1))))

(defun hierarchy-examples-delayed--childrenfn (hier-elem)
  "Return the children of HIER-ELEM.
Basially, feed the number, minus 1, to `hierarchy-examples-delayed--find-number'
and then create a list of the number plus 0.0–0.9."

  (when (> hier-elem 1)
    (let ((next (hierarchy-examples-delayed--find-number (1- hier-elem))))
      (mapcar (lambda (dec) (+ next dec)) '(.0 .1 .2 .3 .4 .5 .6 .7 .8 .9)))))

(ert-deftest hierarchy-delayed-add-one-root ()
  (let ((parentfn (lambda (_) nil))
        (hierarchy (hierarchy-new)))
    (hierarchy-add-tree hierarchy 190 parentfn
                        #'hierarchy-examples-delayed--childrenfn nil t)
    (should (equal (hierarchy-roots hierarchy) '(190)))))

(ert-deftest hierarchy-delayed-add-one-item-with-parent ()
  (let ((parentfn (lambda (item)
                    (cl-case item
                      (190 191))))
        (hierarchy (hierarchy-new)))
    (hierarchy-add-tree hierarchy 190 parentfn
                        #'hierarchy-examples-delayed--childrenfn nil t)
    (should (equal (hierarchy-roots hierarchy) '(191)))
    (should (equal (hierarchy-children hierarchy 191) '(190)))
    (should (equal (hierarchy-children hierarchy 190) '()))))

(ert-deftest hierarchy-delayed-add-one-item-with-parent-and-grand-parent ()
  (let ((parentfn (lambda (item)
                    (cl-case item
                      (190 191)
                      (191 192))))
        (hierarchy (hierarchy-new)))
    (hierarchy-add-tree hierarchy 190 parentfn
                        #'hierarchy-examples-delayed--childrenfn nil t)
    (should (equal (hierarchy-roots hierarchy) '(192)))
    (should (equal (hierarchy-children hierarchy 192) '(191)))
    (should (equal (hierarchy-children hierarchy 191) '(190)))
    (should (equal (hierarchy-children hierarchy 190) '()))))

(ert-deftest hierarchy-delayed-add-same-root-twice ()
  (let ((parentfn (lambda (_) nil))
        (hierarchy (hierarchy-new)))
    (hierarchy-add-tree hierarchy 190 parentfn
                        #'hierarchy-examples-delayed--childrenfn nil t)
    (hierarchy-add-tree hierarchy 190 parentfn
                        #'hierarchy-examples-delayed--childrenfn nil t)
    (should (equal (hierarchy-roots hierarchy) '(190)))))

(ert-deftest hierarchy-delayed-add-same-child-twice ()
  (let ((parentfn (lambda (item)
                    (cl-case item
                      (190 191))))
        (hierarchy (hierarchy-new)))
    (hierarchy-add-tree hierarchy 190 parentfn
                        #'hierarchy-examples-delayed--childrenfn nil t)
    (hierarchy-add-tree hierarchy 190 parentfn
                        #'hierarchy-examples-delayed--childrenfn nil t)
    (should (equal (hierarchy-roots hierarchy) '(191)))
    (should (equal (hierarchy-children hierarchy 191) '(190)))
    (should (equal (hierarchy-children hierarchy 190) '()))))

(ert-deftest hierarchy-delayed-add-item-and-its-parent ()
  (let ((parentfn (lambda (item)
                    (cl-case item
                      (190 191))))
        (hierarchy (hierarchy-new)))
    (hierarchy-add-tree hierarchy 190 parentfn
                        #'hierarchy-examples-delayed--childrenfn nil t)
    (hierarchy-add-tree hierarchy 191 parentfn
                        #'hierarchy-examples-delayed--childrenfn nil t)
    (should (equal (hierarchy-roots hierarchy) '(191)))
    (should (equal (hierarchy-children hierarchy 191) '(190)))
    (should (equal (hierarchy-children hierarchy 190) '()))))

(ert-deftest hierarchy-delayed-add-item-and-its-child ()
  (let ((parentfn (lambda (item)
                    (cl-case item
                      (190 191))))
        (hierarchy (hierarchy-new)))
    (hierarchy-add-tree hierarchy 191 parentfn
                        #'hierarchy-examples-delayed--childrenfn nil t)
    (hierarchy-add-tree hierarchy 190 parentfn
                        #'hierarchy-examples-delayed--childrenfn nil t)
    (should (equal (hierarchy-roots hierarchy) '(191)))
    (should (equal (hierarchy-children hierarchy 191) '(190)))
    (should (equal (hierarchy-children hierarchy 190) '()))))

(ert-deftest hierarchy-delayed-add-two-items-sharing-parent ()
  (let ((parentfn (lambda (item)
                    (cl-case item
                      (190 191)
                      (190.5 191))))
        (hierarchy (hierarchy-new)))
    (hierarchy-add-tree hierarchy 190 parentfn
                        #'hierarchy-examples-delayed--childrenfn nil t)
    (hierarchy-add-tree hierarchy 190.5 parentfn
                        #'hierarchy-examples-delayed--childrenfn nil t)
    (should (equal (hierarchy-roots hierarchy) '(191)))
    (should (equal (hierarchy-children hierarchy 191) '(190 190.5)))))

(ert-deftest hierarchy-delayed-add-two-hierarchies ()
  (let ((parentfn (lambda (item)
                    (cl-case item
                      (190 191)
                      (circle 'shape))))
        (hierarchy (hierarchy-new)))
    (hierarchy-add-tree hierarchy 190 parentfn
                        #'hierarchy-examples-delayed--childrenfn nil t)
    (hierarchy-add-tree hierarchy 'circle parentfn)
    (should (equal (hierarchy-roots hierarchy) '(191 shape)))
    (should (equal (hierarchy-children hierarchy 191) '(190)))
    (should (equal (hierarchy-children hierarchy 'shape) '(circle)))))

(ert-deftest hierarchy-delayed-add-trees ()
  (let ((parentfn (lambda (item)
                    (cl-case item
                      (190 '191)
                      (190.5 '191)
                      (191 '192))))
        (hierarchy (hierarchy-new)))
    (hierarchy-add-trees hierarchy '(191 190.5) parentfn
                         #'hierarchy-examples-delayed--childrenfn nil t)
    (should (equal (hierarchy-roots hierarchy) '(192)))
    (should (equal (hierarchy-children hierarchy '192) '(191)))
    (should (equal (hierarchy-children hierarchy '191) '(190 190.5)))))

(provide 'hierarchy-tests)
;;; hierarchy-tests.el ends here