;;; Excercise the AST routines.                  -*- Scheme -*-
;;;
;;; Copyright (C) 2009, 2012, 2021  Ludovic Courtès <ludo@gnu.org>
;;; Copyright (C) 2023 Arun Isaac <arunisaac@systemreboot.net>
;;;
;;; This file is part of Skribilo.
;;;
;;; Skribilo 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.
;;;
;;; Skribilo 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 program.  If not, see <http://www.gnu.org/licenses/>.

(define-module (tests ast)
  #:use-module (ice-9 match)
  #:use-module (skribilo ast)
  #:use-module (skribilo package base)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-64)
  #:use-module (ice-9 match))

(define (tree-map proc tree)
  ;; Map PROC over TREE.
  (let loop ((tree tree))
    (cond ((pair? tree)
           (map loop tree))
          ((null? tree)
           tree)
          (else
           (proc tree)))))


(test-begin "ast")

(test-assert "document"
  (let ((doc (document #:title "Foo")))
    (and (document? doc)
         (ast? doc)
         (node? doc)
         (container? doc)
         (markup? doc)
         (is-markup? doc 'document)
         (string=? (markup-option doc #:title) "Foo"))))

(test-assert "document + chapter"
  (let* ((doc  (document #:title "Foo" (chapter #:title "Bar" "Blah.")))
         (body (markup-body doc)))
    (and (pair? body)
         (let ((ch (car body)))
           (and (is-markup? ch 'chapter)
                (container? ch)
                (ast? ch)
                (node? ch)
                (string=? (markup-option ch #:title) "Bar")
                (let ((body (markup-body ch)))
                  (and (pair? body)
                       (string=? (car body) "Blah.")
                       (null? (cdr body))))))
         (null? (cdr body)))))

(test-equal "ast->string"
  "Blah."
  (ast->string (document #:title "Foo" (chapter #:title "Bar" "Blah."))))

(test-assert "`find-down' returns the empty list"
  (let* ((doc (document (chapter (section)) (chapter (section))))
         (lst (find-down (lambda (n) (is-markup? n 'chapter)) doc)))
    (null? lst)))

(test-assert "`find-down' returns a tree"
  (let* ((doc (document (chapter (section)) (chapter (section))))
         (lst (find-down (lambda (n) (is-markup? n 'chapter))
                         (markup-body doc))))
    (and (pair? lst)
         (= (length lst) 2)
         (every (lambda (n) (is-markup? n 'chapter))
                (map car lst)))))

(test-assert "`find-down' returns an ordered tree"
  (let* ((doc (document (chapter #:ident "0" (section #:ident "1"))
                        (chapter #:ident "2" (section #:ident "3"))))
         (lst (find-down markup? (markup-body doc))))
    (and (pair? lst)
         (= (length lst) 2)
         (equal? (tree-map markup-markup lst)
                 '((chapter (section)) (chapter (section))))
         (equal? (tree-map markup-ident lst)
                 '(("0" ("1")) ("2" ("3")))))))

(test-assert "`search-down' searches in depth, returns an ordered list"
  (let* ((doc (document (chapter (section #:ident "0"))
                        (chapter (section #:ident "1"))))
         (lst (search-down (lambda (n) (is-markup? n 'section)) doc)))
    (and (pair? lst)
         (= (length lst) 2)
         (every (lambda (n) (is-markup? n 'section)) lst)
         (equal? (map markup-ident lst)
                 (map number->string (iota 2))))))

(test-assert "node-children"
  (let* ((doc (document
               (chapter #:ident "0" (section #:ident "s"))
               (list (chapter #:ident "1"))
               "hey"
               (list "foo"
                     (chapter #:ident "2"))))
         (lst (node-children doc)))
    (equal? (map markup-ident lst)
            '("0" "1" "2"))))

(test-end "ast")