;; Public domain for sure and defo no warranty on this jank.
;; Made by Idiomdrottning 2021.

(define ((relc canon) path)
  (if (eq? #\/ (string-ref path 0))
      path
      (uri->string
       (relative-to
	(reference path)
	(reference canon)))))

(define garb
  ((relc (string-append (current-directory) "/"))
   (cadr (argv))))

(define rel (relc garb))

(create-directory (rel "tests"))

(with-output-to-file
    (rel "tests/run.scm")
  (lambda () (for-each pp
		       (delete-duplicates
			(append
			 (if (and (directory? (rel "tests"))
				  (regular-file? (rel "tests/run.scm")))
			     (with-input-from-file (rel "tests/run.scm") read-list)
			     '())
			 ((over
			   (cond
			    ((and (list? x) (member (car x)
						    '(import include define set!)))
			     (eval x)
			     x)
			    ((and (list? x) (member (car x)
						    '(unless when)))
			     x)
			    (else `(unless (equal? ',(eval x) ,x)
				     (error ,(with-output-to-string
					       (lambda () (write x))))))))
			  (with-input-from-file garb read-list)))))))


(with-output-to-file "/tmp/make-tests-examples.txt"
  (lambda () (for-each (fn
			(cond
			 ((and (list? x) (member (car x)
						 '(import include define set!)))
			  (eval x))
			 (else (pp x) (display "⇒ ") (pp (eval x)) (newline))))
		       (with-input-from-file garb read-list))))