;;; test.lisp - 2025-03-01

;; Copyright (C) 2025 Aryadev Chavali

;; This program is distributed in the hope that it will be useful, but WITHOUT
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
;; FOR A PARTICULAR PURPOSE.  See the GNU General Public License Version 2 for
;; details.

;; You may distribute and modify this code under the terms of the GNU General
;; Public License Version 2, which you should have received a copy of along with
;; this program.  If not, please go to <https://www.gnu.org/licenses/>.

;; Packages

(defpackage cantedraw/tests/main
  (:use :cl :parachute))

(defpackage cantedraw/tests/macros
  (:use :cl :parachute
        :cantedraw.lib.macros))

(defpackage cantedraw/tests/functions
  (:use :cl :parachute
        :cantedraw.lib.macros :cantedraw.lib.functions))

(defpackage cantedraw/tests/model
  (:use :cl :parachute
        :cantedraw.lib.macros :cantedraw.lib.functions
        :cantedraw.model))

;; Implementations

;;; main
(in-package :cantedraw/tests/main)

(define-test all
  :serial t
  :depends-on ((cantedraw/tests/macros macro-test)
               (cantedraw/tests/functions function-test)
               (cantedraw/tests/model model-test)))

;;; macros
(in-package :cantedraw/tests/macros)

(define-test macro-test)

(define-test (macro-test "-->")
  (true (null          (--> x)))
  (is eq 'a            (--> x 'a))
  (is eq 2             (--> x 1 (1+ x)))
  (is eq 2             (--> x 1 1+))
  (is string= "World!" (--> _ "Hello" (format nil "~a World!" _) (subseq _ 6))))

(define-test (macro-test "->>")
  (true (null (->>)))
  (let ((a (gensym))
        (b (gensym))
        (c (gensym))
        (d (gensym)))
    (is eq a (->> a))
    (is equal `(,a ,b)           (macroexpand `(->> ,b (,a))))
    (is equal `(,a ,b)           (macroexpand `(->> ,b ,a)))
    (is equal `(,a (,b ,c))      (macroexpand `(->> ,c (,b) (,a))))
    (is equal `(,a (,b ,c))      (macroexpand `(->> ,c ,b ,a)))
    (is equal `(,a ,b ,c)        (macroexpand `(->> ,c (,a ,b))))
    (is equal `(,a ,b (,c ,d))   (macroexpand `(->> (,c ,d) (,a ,b))))
    (is equal `(,a (,b (,c ,d))) (macroexpand `(->> ,d (,c) (,b) (,a))))
    (is equal `(,a (,b (,c ,d))) (macroexpand `(->> ,d ,c ,b ,a))))
  (is string= "Hello, World!"    (->> "world!" (format nil "hello, ~a") string-capitalize)))

(define-test (macro-test "-<>")
  (true (null (-<>)))
  (let ((a (gensym))
        (b (gensym))
        (c (gensym))
        (d (gensym)))
    (is eq a (-<> a))
    (is equal `(,a ,b)           (macroexpand `(-<> ,b (,a))))
    (is equal `(,a ,b)           (macroexpand `(-<> ,b ,a)))
    (is equal `(,a (,b ,c))      (macroexpand `(-<> ,c (,b) (,a))))
    (is equal `(,a (,b ,c))      (macroexpand `(-<> ,c ,b ,a)))
    (is equal `(,a ,b ,c)        (macroexpand `(-<> ,b (,a ,c))))
    (is equal `(,a (,b (,c ,d))) (macroexpand `(-<> ,d (,c) (,b) (,a))))
    (is equal `(,a (,b (,c ,d))) (macroexpand `(-<> ,d ,c ,b ,a)))
    (is equal `(,a (,b ,c) ,d)   (macroexpand `(-<> ,c (,b) (,a ,d)))))
  (is equal 69                   (-<> 489 (- 420)))
  (is string= "HELLO"            (-<> "Hello World!" (subseq 0 5) string-upcase)))

;;; functions
(in-package :cantedraw/tests/functions)

(define-test function-test)

(define-test (function-test "parse-integer*")
  :compile-at :execute
  (is eq 2    (parse-integer* "2"))
  (is eq 2048 (parse-integer* "2048abcdef"))
  (is eq nil    (parse-integer* "a2048abcdef"))
  (is eq nil    (parse-integer* "garbage"))
  (fail       (parse-integer* nil)))

(define-test (function-test range)
  :compile-at :execute
  (fail (range :start 1 :end 0))
  (fail (range :start nil :end nil))
  (fail (range :start "a" :end "b"))
  (true (null (range :start 1 :end 1)))
  (is equal '(1 2 3 4)    (range :start 1 :end 5))
  (is equal '(-3 -2 -1 0) (range :start -3 :end 1)))

(define-test (function-test split)
  :compile-at :execute
  (fail (split nil nil))
  (fail (split 100 nil))
  (fail (split nil 100))
  (is-values (split 0 '(1 2 3 4))
    (eq nil)
    (equal '(1 2 3 4)))
  (is-values (split 1 '(1 2 3 4))
    (equal '(1))
    (equal '(2 3 4)))
  (is-values (split 5 "Hello World")
    (string= "Hello")
    (string= " World")))

(define-test (function-test rev-map)
  :depends-on (range
               (cantedraw/tests/macros ->>))
  :compile-at :execute
  (fail (rev-map nil nil))
  (fail (rev-map "a string" "another string" :key-eq "not a function"))
  (true (->> nil (rev-map #'identity) null))
  (let ((res (rev-map #'evenp (range :start 1 :end 7))))
    (false (null res))
    (is equal 2 (length res))
    (is equal 3 (->> (assoc t res) cdr length))
    (is equal 3 (->> (assoc nil res) cdr length))
    (true (->> (assoc t res) cdr (every #'evenp)))
    (true (->> (assoc nil res) cdr (every #'oddp))))
  (let* ((mod* (lambda (n) (mod n 3)))
         (res (rev-map mod* (range :start 1 :end 12))))
    (false (null res))
    (is equal 3 (length res))
    (is equal 3 (->> (assoc 0 res) cdr length))
    (is equal 4 (->> (assoc 1 res) cdr length))
    (is equal 4 (->> (assoc 2 res) cdr length))
    (true (->> (assoc 0 res) cdr (every (lambda (x) (= (mod x 3) 0)))))
    (true (->> (assoc 1 res) cdr (every (lambda (x) (= (mod x 3) 1)))))
    (true (->> (assoc 2 res) cdr (every (lambda (x) (= (mod x 3) 2))))))
  (let ((res (rev-map #'identity "lots of letters")))
    (false (null res))
    (is equal 2 (->> (assoc #\l res) cdr length))
    (is equal 3 (->> (assoc #\t res) cdr length))
    (is equal 2 (->> (assoc #\space res) cdr length))
    (is equal 2 (->> (assoc #\s res) cdr length))))

(define-test (function-test remove-at-indices)
  :depends-on (range)
  :compile-at :execute
  (fail (remove-at-indices "a string" "another string"))
  (true (null (remove-at-indices nil nil)))
  (is equal '(1 2 3) (remove-at-indices nil '(1 2 3)))
  (is equal '(2) (remove-at-indices '(0 2) '(1 2 3)))
  (let* ((inp (range :start 100 :end 200))
         (t1 (remove-at-indices (range :start 0 :end 100 :step 2) inp))
         (t2 (remove-at-indices (range :start 1 :end 100 :step 2) inp)))
    (is equal 50 (length t1))
    (is equal 50 (length t2))
    (true (every (lambda (n) (not (member n t2))) t1))
    (true (every (lambda (n) (not (member n t1))) t2)))
  (let* ((indices (list 0 5 6 7 8 9 10))
         (str-lst (remove-at-indices indices "Hello World"))
         (ret (coerce str-lst 'string)))
    (is string= "ello" ret)))


;;; model
(in-package :cantedraw/tests/model)

(define-test model-test)

(define-test (model-test int->rank)
  :depends-on ((cantedraw/tests/macros ->>)
               (cantedraw/tests/functions rev-map))
  :compile-at :execute
  (fail (int->rank nil))
  (fail (int->rank "Not a number"))
  ;; Proving int->rank maps 0-51 to produces 13 ranks, all equally distributed.
  (let ((mapping (rev-map #'int->rank (range :start 0 :end 52))))
    ;; Prove there are 13 ranks
    (is eq 13 (length mapping))
    ;; Prove every rank is equivalent in length.
    (is eq 1 (->> mapping
                  (mapcar ($>> cdr length))
                  remove-duplicates
                  length))
    ;; Prove Ace, 2, ..., 10, Jack, Queen, King are the 13 ranks.
    (true (every #'identity
             (->> (list :ace :king :queen :jack)
                  (append (range :start 2 :end 11))
                  (mapcar (lambda (rank) (assoc rank mapping))))))))

(define-test (model-test rank->int)
  :depends-on ((cantedraw/tests/macros ->>))
  :compile-at :execute
  (fail (rank->int nil))
  (fail (rank->int 1738))
  (fail (rank->int "not a rank"))
  (fail (rank->int :still-not-a-rank))
  ;; Prove ranks are mapped to unique positive integers
  (let ((res (->> (list :jack :queen :king :ace)
                  (append (range :start 2 :end 11))
                  (mapcar #'rank->int))))
    (true (every #'integerp res))
    (true (every #'(lambda (x) (<= 0 x)) res))
    (is equal (length res) (length (remove-duplicates res)))))

(define-test (model-test "int->rank and rank->int are complete inverses")
  :depends-on (rank->int int->rank)
  (let ((int-range (range :start 0 :end 13))
        (rank-range (->> (list :ace :jack :queen :king)
                         (append (range :start 2 :end 11)))))
    (is equal rank-range
        (mapcar ($>> rank->int int->rank) rank-range))
    (is equal int-range
        (mapcar ($>> int->rank rank->int) int-range))))

(define-test (model-test int->suit)
  :depends-on ((cantedraw/tests/macros ->>)
               (cantedraw/tests/functions rev-map))
  :compile-at :execute
  (fail (int->suit nil))
  (fail (int->suit "Not a number"))
  ;; Proving int->suit splits 0-51 perfectly between the 4 suits
  (let ((mapping (rev-map #'int->suit (range :start 0 :end 53))))
    (is eq 5 (length mapping))
    (let ((spades   (alist-val :spades mapping))
          (hearts   (alist-val :hearts mapping))
          (clubs    (alist-val :clubs mapping))
          (diamonds (alist-val :diamonds mapping))
          (jokers   (alist-val :joker mapping)))
      (is eq 1 (length jokers))
      (is eq 1 (->> (list spades hearts clubs diamonds)
                    (mapcar #'length)
                    remove-duplicates
                    length)))))

(define-test (model-test suit->int)
  :depends-on ((cantedraw/tests/macros ->>))
  :compile-at :execute
  (fail (suit->int nil))
  (fail (suit->int "not a suit"))
  (fail (suit->int :still-not-a-suit))
  (fail (suit->int 42069))
  ;; Prove suits are mapped to unique positive integers
  (let ((res (->> (list :diamonds :clubs :hearts :spades :joker)
                  (mapcar #'suit->int))))
    (true (every #'integerp res) "All integers")
    (true (every ($>> (<= 0)) res) "All positive")
    (is equal (length res) (length (remove-duplicates res)) "Unique mapping")))

(define-test (model-test "int->suit and suit->int are complete inverses")
  :depends-on (suit->int int->suit)
  (let ((int-range (list 0 13 26 39 52))
        (suit-range (list :diamonds :clubs :hearts :spades :joker)))
    (is equal suit-range
        (mapcar ($>> suit->int int->suit) suit-range))
    (is equal int-range
        (mapcar ($>> int->suit suit->int) int-range))))

(define-test (model-test int->card)
  :depends-on ((cantedraw/tests/functions range))
  :compile-at :execute
  (fail (int->card nil))
  (fail (int->card "Not a number"))
  ;; Proving int->card maps 0-51 to exactly 52 unique cards
  (let ((mapping (mapcar #'int->card (range :start 0 :end 52))))
    (is eq 52 (length (remove-duplicates mapping :test #'equal))
        "52 unique elements.")
    (true (every #'card-p mapping)
          "Every element is a card."))
  ;; Prove that cards outside of [0, 51] are mapped to jokers (not exhaustive)
  (loop :for positive :from 100 :to 200
        :for negative :from -200 :to -100
        :for inp := (mapcar #'int->card (list positive negative))
        :do (true (every #'card-p inp)
                  "Is a card.")
        :do (true (every (lambda (c) (eq :joker (card-suit c))) inp)
                  "Are jokers.")))

(define-test (model-test card->int)
  :depends-on ((cantedraw/tests/functions range))
  :compile-at :execute
  (fail (card->int nil))
  (fail (card->int 1738))
  (fail (card->int "not a card"))
  (fail (card->int :still-not-a-card))
  (let ((ranks (append (range :start 2 :end 11) (list :jack :queen :king :ace))))
    (let ((res (->> (loop :for suit :in (list :diamonds :clubs :hearts :spades)
                          :nconc
                          (mapcar (lambda (rank) (make-card :rank rank :suit suit)) ranks))
                    (mapcar #'card->int))))
      (true (every #'integerp res) "Every mapped element is an integer.")
      (true (every #'(lambda (x) (<= 0 x)) res) "Every mapped element is positive")
      (is eq (length res) (length (remove-duplicates res))
          "All mapped integers are unique."))
    (let ((res (->> (loop :for rank :in ranks
                          :collect (make-card :rank rank :suit :joker))
                    (mapcar #'card->int))))
      (true (every #'integerp res) "Every mapped element is an integer.")
      (true (every (lambda (n) (or (< n 0) (> n 51))) res)
            "Every mapped element is outside of [0,51]")
      (is eq (length res) (length (remove-duplicates res))
          "All mapped integers are unique."))))

(define-test (model-test "int->card and card->int are complete inverses")
  :depends-on (card->int int->card)
  (let ((int-range (range :start 0 :end 52))
        (card-range
          (loop :for rank :in (append (range :start 2 :end 11) (list :ace :king :jack :queen))
                :nconcing (-<> (lambda (suit) (make-card :rank rank :suit suit))
                               (mapcar (list :Diamonds :Clubs :Hearts :Spades)))
                  :into Y
                :finally (return (sort Y #'card<)))))
    (is equalp card-range (mapcar ($>> card->int int->card) card-range)
        "int->card(card->int s) = s")
    (is equalp int-range (mapcar ($>> int->card card->int) int-range)
        "card->int(int->card i) = i")))