#| 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" #f)
                (node-children _)
                (list-queue-list _)
                (list-ref _ 0)
                (xstring->string _))))
    (test-equal "single line" str "hello, world\n"))
  (let ((str
         (chain (parse->document "hello," #f)
                (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" #f)
              (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" #f)
                        (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," #f)
                    (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" #f)
                      (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" #f)
                      (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" #f)
             (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 _)))))