#| Copyright 2024 Peter McGoron
 |
 | Licensed under the Apache License, Version 2.0 (the "License");
 |
 | you may not use this file except in compliance with the License.
 | You may obtain a copy of the License at
 |
 |     http://www.apache.org/licenses/LICENSE-2.0
 |
 | Unless required by applicable law or agreed to in writing, software
 | distributed under the License is distributed on an "AS IS" BASIS,
 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 | See the License for the specific language governing permissions and
 | limitations under the License.
 |#

(load "../mcgoron/srfi/61.sld")
(load "../market/string.sld")
(load "../market/blocks.sld")
(load "../market/default.sld")

(import (prefix (only (mcgoron srfi 64) factory)
                mcgoron-test-)
        (srfi 64) (srfi 197) (srfi 117))
(import (market default) (market string) (market blocks))

(test-runner-factory mcgoron-test-factory)
(test-runner-current (test-runner-create))

(test-group "paragraphs"
  (let ((str
         (chain (parse->document "hello, world")
                (node-children _)
                (list-queue-list _)
                (list-ref _ 0)
                (xstring->string _))))
    (test-equal "single line" str "hello, world\n"))
  (let ((str
         (chain (parse->document "hello,")
                (parse->document "world" _)
                (node-children _)
                (list-queue-list _)
                (list-ref _ 0)
                (xstring->string _))))
    (test-equal "two lines" str "hello,\nworld\n"))
  (test-group "two paragraphs"
    (let ((children
       (chain (parse->document "hello")
              (parse->document "" _)
              (parse->document "world" _)
              (node-children _)
              (list-queue-list _))))
      (test-equal "first paragraph"
                  (xstring->string (list-ref children 0))
                  "hello\n")
      (test-equal "second paragraph"
                  (xstring->string (list-ref children 1))
                  "world\n"))))

(test-group "block quotes"
  (test-group "single line"
    (let ((block (chain (parse->document "> hello, world")
                        (node-children _)
                        (list-queue-list _)
                        (list-ref _ 0))))
      (test-assert "block-quote?" (block-quote? block))
      (let ((str (chain (node-children block)
                        (list-queue-list _)
                        (list-ref _ 0)
                        (xstring->string _))))
        (test-equal "string" str "hello, world\n"))))
  (let ((str (chain (parse->document "> hello,")
                    (parse->document "> world" _)
                    (node-children _)
                    (list-queue-list _)
                    (list-ref _ 0)
                    (node-children _)
                    (list-queue-list _)
                    (list-ref _ 0)
                    (xstring->string _))))
    (test-equal "two lines" str "hello,\nworld\n"))
  (test-group "multiple paragraphs"
    (let ((lst (chain (parse->document "> hello")
                      (parse->document "> " _)
                      (parse->document "> world" _)
                      (node-children _)
                      (list-queue-list _)
                      (list-ref _ 0)
                      (node-children _)
                      (list-queue-list _))))
      (test-equal "first paragraph"
                  (xstring->string (list-ref lst 0))
                  "hello\n")
      (test-equal "second paragraph"
                  (xstring->string (list-ref lst 1))
                  "world\n")))
  (test-group "interrupted"
    (let ((lst (chain (parse->document "> hello, world")
                      (parse->document "outside of a block quote" _)
                      (node-children _)
                      (list-queue-list _))))
      (test-assert "first is block quote"
                   (block-node? (list-ref lst 0)))
      (let ((quote-paragraph (chain (list-ref lst 0)
                                    (node-children _)
                                    (list-queue-list _)
                                    (list-ref _ 0)
                                    (xstring->string _))))
        (test-equal "block quote paragraph"
                    "hello, world\n"
                    quote-paragraph))
      (test-assert "second is paragraph"
                   (xstring? (list-ref lst 1)))
      (test-equal "second paragraph"
                  "outside of a block quote\n"
                  (xstring->string (list-ref lst 1)))))
  (test-group "two nested with spaces"
    (define block
      (chain (parse->document "> > hello, world")
             (parse->document "> > continuing nested" _)
             (parse->document "> outside of the block quote" _)
             (node-children _)
             (list-queue-list _)
             (list-ref _ 0)))
    (test-assert "first block quote"
                 (block-quote? block))
    (test-equal "first block quote second paragraph"
                "outside of the block quote\n"
                (chain (node-children block)
                       (list-queue-list _)
                       (list-ref _ 1)
                       (xstring->string _)))
    (set! block
          (chain (node-children block)
                 (list-queue-list _)
                 (list-ref _ 0)))
    (test-assert "second block quote" (block-quote? block))
    (test-equal "second block quote paragraph"
                "hello, world\ncontinuing nested\n"
                (chain (node-children block)
                       (list-queue-list _)
                       (list-ref _ 0)
                       (xstring->string _))))
  (test-group "two nested without spaces"
    (define block
      (chain (parse->document ">> hello, world")
             (parse->document ">> continuing nested" _)
             (parse->document "> at first level" _)
             (parse->document "> continuing first level" _)
             (node-children _)
             (list-queue-list _)
             (list-ref _ 0)))
    (test-assert "first block quote" (block-quote? block))
    (test-equal "first block quote paragraph"
                "at first level\ncontinuing first level\n"
                (chain (node-children block)
                       (list-queue-list _)
                       (list-ref _ 1)
                       (xstring->string _)))
    (define nested-str (chain (node-children block)
                              (list-queue-list _)
                              (list-ref _ 0)
                              (node-children _)
                              (list-queue-list _)
                              (list-ref _ 0)
                              (xstring->string _)))
    (test-equal "nested block quote paragraph"
                "hello, world\ncontinuing nested\n"
                nested-str)))

(test-group "atx headings"
  (test-group "heading 1"
    (let ((heading (chain (parse->document "# hello")
                          (node-children _)
                          (list-queue-list _)
                          (list-ref _ 0))))
      (test-assert "atx-heading?" (atx-heading? heading))
      (test-equal "indent" 1 (atx-heading-indent heading))
      (test-equal "text" "hello" (chain (node-children heading)
                                        (list-queue-list _)
                                        (list-ref _ 0)
                                        (xstring->string _)))))
  (test-group "heading 6"
    (let ((heading (chain (parse->document "###### hello")
                          (node-children _)
                          (list-queue-list _)
                          (list-ref _ 0))))
      (test-assert "atx-heading?" (atx-heading? heading))
      (test-equal "indent" 6 (atx-heading-indent heading))
      (test-equal "text" "hello" (chain (node-children heading)
                                        (list-queue-list _)
                                        (list-ref _ 0)
                                        (xstring->string _)))))
  (test-group "heading followed by paragraph"
    (let ((children (chain (parse->document "## hello, ")
                           (parse->document "world" _)
                           (parse->document "## another heading" _)
                           (node-children _)
                           (list-queue-list _))))
      (test-group "atx heading 1"
        (define heading (list-ref children 0))
        (test-equal "indent" 2 (atx-heading-indent heading))
        (define text (chain (node-children heading)
                            (list-queue-list _)
                            (list-ref _ 0)
                            (xstring->string _)))
        (test-equal "text" "hello, " text))
      (test-group "paragraph"
        (define text (chain (list-ref children 1)
                            (xstring->string _)))
        (test-equal "text" "world\n" text))
      (test-group "atx heading 2"
        (define heading (list-ref children 2))
        (test-equal "indent" 2 (atx-heading-indent heading))
        (define text (chain (node-children heading)
                            (list-queue-list _)
                            (list-ref _ 0)
                            (xstring->string _)))
        (test-equal "text" "another heading" text))))
  (test-group "heading inside block quote"
    (let ((children (chain (parse->document "> # nested heading")
                           (parse->document "> text inside quote" _)
                           (parse->document "### outside of quote" _)
                           (node-children _)
                           (list-queue-list _))))
      (test-group "block quote"
        (define block-quote (list-ref children 0))
        (test-assert "block-quote?" (block-quote? block-quote))
        (let ((children (chain (node-children block-quote)
                               (list-queue-list _))))
          (test-group "atx heading"
            (define heading (list-ref children 0))
            (test-equal "indent" 1 (atx-heading-indent heading))
            (test-equal "text" "nested heading"
                        (chain (node-children heading)
                               (list-queue-list _)
                               (list-ref _ 0)
                               (xstring->string _))))
          (test-group "paragraph"
            (define par (list-ref children 1))
            (test-equal "text"
                        "text inside quote\n"
                        (xstring->string par)))))
      (test-group "heading outside of quote"
        (define heading (list-ref children 1))
        (test-equal "indent" 3 (atx-heading-indent heading))
        (test-equal "text"
                    "outside of quote"
                    (chain (node-children heading)
                           (list-queue-list _)
                           (list-ref _ 0)
                           (xstring->string _)))))))

(test-group "code blocks"
  (test-group "single line, 4 spaces"
    (let ((block (chain (parse->document "    (procedure? call/cc)")
                        (node-children _)
                        (list-queue-list _)
                        (list-ref _ 0))))
      (test-assert "code-block?" (code-block? block))
      (test-equal "text"
                  "(procedure? call/cc)\n"
                  (chain (node-children block)
                         (list-queue-list _)
                         (list-ref _ 0)
                         (xstring->string _)))))
  (test-group "single line, tab"
    (let ((block (chain (parse->document "\t(procedure? call/cc)")
                        (node-children _)
                        (list-queue-list _)
                        (list-ref _ 0))))
      (test-assert "code-block?" (code-block? block))
      (test-equal "text"
                  "(procedure? call/cc)\n"
                  (chain (node-children block)
                         (list-queue-list _)
                         (list-ref _ 0)
                         (xstring->string _)))))
  (test-group "multiple lines, mixing"
    (let ((str (chain (parse->document "    (lambda (x)")
                      (parse->document "\t  x)" _)
                      (node-children _)
                      (list-queue-list _)
                      (list-ref _ 0)
                      (node-children _)
                      (list-queue-list _)
                      (list-ref _ 0)
                      (xstring->string _))))
      (test-equal "text"
                  "(lambda (x)\n  x)\n"
                  str)))
  (test-group "no quotes in code blocks"
    (let ((first-child (chain (parse->document "    > not a block")
                              (node-children _)
                              (list-queue-list _)
                              (list-ref _ 0)
                              (node-children _)
                              (list-queue-list _)
                              (list-ref _ 0))))
      (test-assert "xstring" (xstring? first-child))
      (test-equal "text"
                  "> not a block\n"
                  (xstring->string first-child))))
  (test-group "code block in quotes"
    (let ((node (chain (parse->document ">     quoted code")
                       (node-children _)
                       (list-queue-list _)
                       (list-ref _ 0))))
      (test-assert "block-quote?" (block-quote? node))
      (set! node (chain (node-children node)
                        (list-queue-list _)
                        (list-ref _ 0)))
      (test-assert "code-block?" (code-block? node))
      (set! text (chain (node-children node)
                        (list-queue-list _)
                        (list-ref _ 0)
                        (xstring->string _)))
      (test-equal "text"
                  "quoted code\n"
                  text))))