;; 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 (form)
			   (cond
			    ((and (list? form) (member (car form)
						       '(import include define set!)))
			     (eval form)
			     form)
			    ((and (list? form) (member (car form)
						       '(unless when)))
			     form)
			    (else `(unless (equal? ',(eval form) ,form)
				     (error ,(with-output-to-string
					       (lambda () (write form))))))))
		     (with-input-from-file garb read-list)))))))