Hy, Hypothesis and Hamcrest in action

hypo.hy

(import [hypothesis [given example]]
        [hypothesis.strategies [text lists integers]]
        [hypo.sut [decode encode]])

(import [hamcrest [assert-that is- equal-to has-length less-than
                   less-than-or-equal-to greater-than]])

(with-decorator (given (text))
  (defn decode-inverts-encode [s]
    (assert (= (-> (encode s)
                   (decode)) s))))

(with-decorator (given (text))
  (defn decode-inverts-encode-2 [s]
    (assert-that (-> (encode s)
                     (decode))
                 (is- (equal-to s)))))

(with-decorator (given :s (text))
  (with-decorator (example :s "")
    (defn decode-inverts-encode-3 [s]
      (assert-that (-> (encode s)
                       (decode))
                   (is- (equal-to s))))))

(import [hy [HySymbol]])

(require hy.contrib.anaphoric)

(defn group [seq &optional [n 2]]
  "group list to lists of size n"
  (setv val [])
  (for [x seq]
    (.append val x)
    (when (>= (len val) n)
      (yield val)
      (setv val [])))
  (when val (yield val)))

(defmacro background [context-name &rest code]
  (let [[symbols (ap-map (first it) code)]
        [fn-name (HySymbol (.join "" ["setup_" context-name]))]]
    `(defn ~fn-name []
       ~(.join "" ["setup context " context-name])
       (let [~@code]
         ~(dict-comp (keyword x) x [x symbols])))))

(defmacro fact [desc &rest code]
  (defn group [seq &optional [n 2]]
    "group list to lists of size n"
    (setv val [])
    (for [x seq]
      (.append val x)
      (when (>= (len val) n)
        (yield val)
        (setv val [])))
    (when val (yield val)))

  (defn variants? []
    "check if variants are specified"
    (= 'variants (first (first code))))

  (defn samples? []
    "check if samples are specified"
    (if (>= (len code) 2)
          (= 'sample (first (second code)))
          false))

  (defn create-code-block []
    "create test function body"
    (cond [(and (variants?)
                (samples?)) `(~@(rest (rest code)))]
          [(variants?) `(~@(rest code))]
          [true code]))

  (defn create-func-definition [res]
    "create function header and splice in res"
    (let [[fn-name (HySymbol (.join "" ["test_" (.replace (str desc) " " "_")]))]
          [param-list (if (variants?)
                        (list (ap-map (HySymbol (name (first it))) (group (rest (first code)))))
                        `[])]]
      `(defn ~fn-name ~param-list
         ~desc
       ~@res)))

  (defn create-sample-decorator [res]
    "create decorator for sample data and splice in res"
    (if (samples?)
      `(with-decorator (example ~@(rest (second code)))
         ~res)
      res))

  (defn create-given-decorator [res]
    "create decorator for test data generators and splice in res"
    (if (variants?)
      `(with-decorator (given ~@(rest (first code)))
         ~res)
      res))
  (-> (create-code-block)
      (create-func-definition)
      (create-sample-decorator)
      (create-given-decorator)))

(defmacro/g! with-background [context-name symbols &rest code]
  (let [[fn-name (HySymbol (.join "" ["setup_" context-name]))]]
    `(let [[~g!context (~fn-name)]
           ~@(ap-map `[~it (get ~g!context ~(keyword it))] symbols)]
       ~@code)))

(fact "decode inverts encode"
      (variants :s (text))
      (sample :s "")
      (assert-that (-> (encode s)
                       (decode))
                   (is- (equal-to s))))

(fact "grouping an empty list will return an empty list"
      (assert-that (list (group []))
                   (has-length 0)))

(fact "groups of grouped list of at least one element are equal or less than max size"
      (variants :seq (lists (text) :min-size 1)
                :n (integers :min-value 1))
      (ap-each (group seq n)
               (assert-that it (has-length (less-than-or-equal-to n)))))

(fact "flattening grouped sequence produces original sequence"
      (variants :seq (lists (text))
                :n (integers :min-value 1))
      (sample :seq [] :n 1)
      (assert-that (flatten (group seq n))
                   (is- (equal-to seq))))