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

(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 pattern-spec
  (t/testing "var"
    (let [pattern-var? #(match (s/conform ::pattern %)
                          [:var _] true
                          _ false)]
      (t/is (pattern-var? 'abc))
      (t/is (not (pattern-var? '_)))
      (t/is (not (pattern-var? '...)))))
  (t/testing "list"
    (t/are [l e t x] (= [l e t]
                        ((juxt :leading :ellipsis :trailing)
                         (s/conform ::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/are [p] (s/invalid? ::pattern p)
      '... '(...) '(... a b c)
      '(a ... b ...)))
  (t/testing "simple data"
    (t/is (= 'a (s/conform ::patern '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 "syntax-rules"
    (t/is (= '(lambda (x) x)
             (sut/expand
              '(syntax-rules
                ()
                ((_)))))))
  (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 (= '[:list [[:var x]
                    [:ellipsis [:var y]]
                    [:ellipsis [:var z]]
                    [:var a]
                    [:var b]
                    [:var c]]]
           (s/conform ::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)))))

(t/deftest unify-test
  (t/are [result pattern datum] (= result (sut/unify pattern datum))
    {'a 123 'b 456} '(a b) '(123 456)
    nil '(a b) 123

    '{b [:ellipsis ([:ellipsis (1 2)] [:ellipsis (3 4)])]}
    '((b ...) ...)
    '((1 2) (3 4))

    {} '_ 123)
  (t/testing "non-matches"
    (t/are [pattern datum] (= nil (sut/unify pattern datum))
      '(a b c) '(1 2)
      '(a b c) '(1 2))))

(t/deftest transcribe-test
  (t/are [result datum pattern template]
      (= result (sut/transcribe (sut/unify pattern datum) template))
    '(1 a 2 b) '((1 2) (a b))
    '((x y) ...) '(x ... y ...)

    '(1 2 3 4) '(1 2 3 4)
    '(x ...) '(x ...)

    '(concat (1 2) (3 4) (5 6)) '((1 2) (3 4) (5 6))
    '((a ...) ...) '(concat (a ...) ...)))