9mm/lib/test.fnl

(local {:print pprint} (require :lib.table))

;; thanks:
;; https://gist.github.com/sapphyrus/fd9aeb871e3ce966cc4b0b969f62f539
;; and antifennel
(fn deep-equals [o1 o2 ignore-mt]
  (when (= o1 o2) (lua "return true"))
  (local o1-type (type o1))
  (local o2-type (type o2))
  (when (not= o1-type o2-type) (lua "return false"))
  (when (not= o1-type :table) (lua "return false"))
  (when (not ignore-mt)
    (local mt1 (getmetatable o1))
    (when (and mt1 mt1.__eq)
      (let [___antifnl_rtn_1___ (= o1 o2)] (lua "return ___antifnl_rtn_1___"))))
  (each [key1 value1 (pairs o1)]
    (local value2 (. o2 key1))
    (when (or (= value2 nil) (= (deep-equals value1 value2 ignore-mt) false))
      (lua "return false")))
  (each [key2 _ (pairs o2)]
    (when (= (. o1 key2) nil) (lua "return false")))
  true)	

(var plan 0)

(fn once [funky]
  (var bang false)
  (fn [...]
    (if (not bang)
      (do
        (funky ...)
        (set bang true)))))

(fn test [obj]
  (let [{: given : should : actual : expected} obj
        ok (if (deep-equals actual expected) :ok "not ok")
        description (.. "Given " given " should " should)
        ]
    (set plan (+ 1 plan))
    (print (.. ok " " plan " - " description))
    (if (= "not ok" ok)
      (do
        (print "  ---")
        (if (= :table (type expected))
          (do
            (print (.. "  expected: " ))
            (pprint expected))
          (print (.. "  expected: " (tostring expected))))
        (if (= :table (type actual))
          (do
            (print (.. "  actual: " ))
            (pprint actual))
          (print (.. "  actual: " (tostring actual))))
        (print "  ...")
        )
      )
    ))

(local print-header (once (fn [] (print "TAP version 14"))))

(fn describe [str cb]
  (print-header)
  (print (.. "#" str))
  (cb test))

(fn test-end []
  (print (.. 1 ".." plan)))


{: describe
 : deep-equals
 : test-end}