(ns expand-test
  (:require [expand :as sut]
            [clojure.test :as t]
            [clojure.spec.alpha :as s]))

(t/deftest scheme-base-env-test
  (t/is (s/valid? ::sut/environment sut/scheme-base-env)))

(t/deftest symtable-for-env-test
  (t/is (s/valid? ::sut/symtable (sut/symtable-for-env sut/scheme-base-env))))

(t/deftest nearest-test
  (t/is (= [:primitive 'lambda]
           (sut/lookup ['lambda #{}]
                       sut/scheme-base-env
                       (sut/symtable-for-env sut/scheme-base-env))))
  (t/is (= [#{0 1}]
           (sut/nearest ['x #{0 1 2}]
                        [#{0} #{0 1} #{0 3}]))))

(t/deftest parse-pattern-test
  (t/testing "list"
    (t/are [l e t x] (= [l e t]
                        ((juxt :leading :ellipsis :trailing)
                         (sut/parse-pattern x)))
      nil nil nil '()
      '(a) nil nil '(a)
      '(a b) nil nil '(a b)
      '(a) 'b nil '(a b ...)
      '(a) 'b '(c) '(a b ... c)
      '(a) 'b '(c d) '(a b ... c d)))
  (t/testing "simple data"
    (t/is (= 'a (sut/parse-pattern 'a)))))

(t/deftest expand-test
  (t/testing "unbound symbol"
    (t/is (thrown? Exception (sut/expand 'x))))
  (t/testing "lambda"
    (t/is (= '(lambda (x) x)
             (sut/expand '(λ (x) x)))))
  (t/testing "let"
    (t/is (= '(let ((x 123)
                    (y 456))
                (+ x y))
             (sut/expand
              '(let ((x 123)
                     (y 456))
                 (+ x y))))))
  (t/testing "application"
    (t/is (= '(lambda (f x) (f x))
             (sut/expand '(lambda (f x) (f x)))))))

(t/deftest prim-lambda-spec
  (t/is (s/valid? ::sut/prim-lambda '(lambda (x) x)))
  (t/is (s/valid? ::sut/prim-lambda '(lambda (x) (display x) (newline)))))

(t/deftest prim-let-spec
  (t/is (s/valid? ::sut/prim-let '(let ((x 123)
                                        (y 456))
                                    (+ x y)))))

(t/deftest prim-let-syntax-spec
  (t/is (s/valid? ::sut/prim-let-syntax
                  '(let-syntax ((m (syntax-rules ()
                                     ((m) 123))))
                     (m)))))

(t/deftest template-spec
  (t/is (s/valid? ::sut/template '(x ... y)))
  (t/is (s/valid? ::sut/template 123))
  (t/is (s/valid? ::sut/template '(x y ... z ... a b c))))

(t/deftest pattern-spec
  (t/is (s/valid? ::sut/pattern '(m))))

(t/deftest rule-spec
  (t/is (s/valid? ::sut/rule '((m) 123))))

(t/deftest prim-syntax-rules-spec
  (t/is (s/valid? ::sut/prim-syntax-rules
                  '(syntax-rules
                    ()
                    ((m) 123)))))