;; Only promise to test schemas listed in the section #Recommended schemas#
;; - https://yaml.org/spec/1.2.2/#recommended-schemas
;; WITHOUT TAG. yaml tag is undefined in libyaml.ss,
;;   and may make error

(import libyaml)
(import test)

(define-syntax test? (syntax-rules ()
	((test? ?) (let ()
		(test #t ?)))))

(test-group "libyaml"

(test-group "if.ss"
	(test-group "yscalar?"
		(test? (yscalar? '()))
		(test? (yscalar? #t)) (test? (yscalar? #f))
		(test? (yscalar? 0)) (test? (yscalar? 0.1)) (test? (yscalar? (/ 1 2)))
		(test? (yscalar? "")) (test? (yscalar? "关注电池耐用形色好谢谢喵"))
		(test? (not (yscalar? #:keyword)))
		(test? (not (yscalar? 'symbol)))
	)
	(test-group "ymap?"
		(test? (ymap?? '(())))
		(test? (ymap?? '(((0 . 1)))))
		(test? (ymap?? '(((() . "null")))))
		(test? (ymap?? '(( (#() . (( ("key" . #("value" 0.1) ) ))) )) ))
		(test? (not (ymap?? '((("key" . false-here))))))
		(test? (not (ymap?? '(((false-here . "value"))))))
		(test? (ymap? '((("key" . false-here)))))
		(test? (ymap? '(((false-here . "value")))))
	)
	(test-group "ylist?"
		(test? (ylist?? #()))
		(test? (ylist?? #(#())))
		(test? (ylist?? #(1 "" #() (()))))
		(test? (ylist?? #((( ((((0 . 1))) . #("u" "v")) )) "tail")))
		(test? (not (ylist?? #(symbol))))
		(test? (not (ylist?? #(#:keyword))))
		(test? (ylist? #(symbol)))
		(test? (ylist? #(#:keyword)))
	)
	(test-group "ydoc?"
		(test? (not (ydoc? '())))
		(test? (ydoc? (lambda (^ . ..) '())))
		(test? (ydoc? (lambda (^ . ..) '("after zero" 2 #(3 4) (( (() . #f) ))))))
		(test? (ydoc? (yaml->ss "")))
		(test? (ydoc?
			(with-input-from-file "/dev/null"
				(lambda () (yaml->ss (current-input-port))))))
		(test? (not (ydoc? ((yaml->ss "")))))
	)
	(test-group "yaml?"
		(test? (not (yaml? (lambda (?) '()))))
		(test? (not (yaml? (lambda (?) '("after zero" 2 #(3 4) (( (() . #f) )))))))
		(test? (not (yaml? (lambda (? . ...)
			'()))))
		(test? (not (yaml? (lambda (? . ...)
			'("after zero" 2 #(3 4) (( (() . #f) )))))))
		(test? (yaml? (yaml->ss "")))
		(test? (yaml?
			(with-input-from-file "/dev/null"
				(lambda () (yaml->ss (current-input-port))))))
	)
)

(test-group "yaml->ss"
	(test? (procedure? (yaml->ss "")))
	(test? (procedure?
			(with-input-from-file "/dev/null"
				(lambda () (yaml->ss (current-input-port))))))
	(test-group "document"
		(test? (procedure? (yaml->ss "")))
		(test-error ((yaml->ss "") 1))
		(test 2 ((yaml->ss "--- 1\n--- 2") 1))
	)
	(test-group "scalar"
		(test-group "null"
			(test? (null? ((yaml->ss ""))))
			(test? (null? ((yaml->ss "~"))))
			(test? (null? ((yaml->ss "null"))))
			(test? (null? ((yaml->ss "Null"))))
			(test? (null? ((yaml->ss "NULL"))))
			(test? (null?
				((with-input-from-file
					"/dev/null"
					(lambda () (yaml->ss (current-input-port)))))))
		)
		(test-group "boolean"
			(test? ((yaml->ss "true")))
			(test? ((yaml->ss "True")))
			(test? ((yaml->ss "TRUE")))
			(test #f ((yaml->ss "false")))
			(test #f ((yaml->ss "False")))
			(test #f ((yaml->ss "FALSE")))
		)
		(test-group "numeric"
			(test-group "integer"
				(let-syntax
					(
						(test-int (syntax-rules ()
							((test-int num str) (let ()
								(test? (integer? ((yaml->ss str))))
								(test num ((yaml->ss str)))))))
						(test-int+- (syntax-rules ()
							((test-int num str) (let ()
								(test? (integer? ((yaml->ss (string-append "-" str)))))
								(test (- num) ((yaml->ss (string-append "-" str))))
								(test? (integer? ((yaml->ss (string-append "+" str)))))
								(test (+ num) ((yaml->ss (string-append "+" str))))))))
					)
					(test-int+- 1 "1")
					(test-int+- 0 "0")
					(test-int+- 64 "64")
					(test-int #o505 "0o505") (test-int 325 "0o505")
					(test "-0o112" ((yaml->ss "-0o112")))
					(test "+0o112" ((yaml->ss "+0o112")))
					(test-int #x505 "0x505") (test-int 1285 "0x505")
					(test "-0x112" ((yaml->ss "-0x112")))
					(test "+0x112" ((yaml->ss "+0x112")))
				)
			)
			(test-group "real"
				(let-syntax ((test-real+- (syntax-rules ()
					((test-real+- num str) (let ()
						(test num ((yaml->ss str)))
						(test (- num) ((yaml->ss (string-append "-" str))))
						(test (+ num) ((yaml->ss (string-append "+" str))))
					)))))
					(test-real+- 0.0 "0.0")
					(test-real+- 0.1 "0.1")
					(test-real+- (exact->inexact 12000) "12e03")
					(test-real+- 0.001862 "1.862e-3")
					(test-real+- 12.4 "1.24E+1")
					(test-real+- (exact->inexact 3) "3E+0")
				)
			)
			(test-group "inf/nan"
				(test +inf.0 ((yaml->ss "+.inf"))) (test +inf.0 ((yaml->ss "+.INF")))
				(test +inf.0 ((yaml->ss "+.Inf")))

				(test -inf.0 ((yaml->ss "-.inf"))) (test -inf.0 ((yaml->ss "-.INF")))
				(test -inf.0 ((yaml->ss "-.Inf")))

				(test? (nan? ((yaml->ss ".nan")))) (test? (nan? ((yaml->ss ".NAN"))))
				(test? (nan? ((yaml->ss ".NaN"))))
			)
		)
		(test-group "string"
			(test "" ((yaml->ss "''")))
			(test "" ((yaml->ss "\"\"")))
			(test "here" ((yaml->ss "here")))
			(test "@" ((yaml->ss "\"\\x40\"")))
			(test "\\x40" ((yaml->ss "\\x40")))
			(test "\n" ((yaml->ss "\"\\n\"")))
			(test "line2\n" ((yaml->ss "|\n  line2\n")))
			(test "line2\nL\n" ((yaml->ss "|\n  line2\n  L\n")))
			(test "line2\nL" ((yaml->ss "|-\n  line2\n  L\n")))
			(test "line2 L" ((yaml->ss ">-\n  line2\n  L\n")))
			(test "line2 L\n" ((yaml->ss ">\n  line2\n  L\n")))
		)
	) ; scalar
	(test-group "list"
		(test 0 (vector-length ((yaml->ss "[]"))))
		(test "@" (vector-ref ((yaml->ss "[\"\\x40\",2,'u']")) 0))
		(test "@"
			(vector-ref (vector-ref ((yaml->ss "-\n  - \"\\x40\"")) 0) 0))
		(test '("key" . #("@"))
			(assoc "key" (car ((yaml->ss "key:\n  - \"\\x40\"")))))
	)
	(test-group "map" (let ((mapv (lambda (key yamlmap) (cdr (assoc key (car yamlmap))))))
		(test 0 (length (car ((yaml->ss "{}")))))
		(test "@" (mapv "key" ((yaml->ss "{key: \"\\x40\"}"))))
		(test "@"
			(mapv "key" ((yaml->ss "key:\n  \"\\x40\""))))
		(test (vector "@")
			(mapv '() (mapv "key"
				((yaml->ss "key:\n  ~:\n    - \"\\x40\"")))))
	))
)


(test-group "ss2yaml.ss"
	(test-group "yaml->ss"
		(test? (not (not (ss->yaml (yaml->ss "")))))
		(test? (not (not (ss->yaml `()))))
		(test? (not (not (ss->yaml #:strict-input (yaml->ss "")))))
	)
)

)