#lang racket

(require rackunit
         sexp-diff) ;; raco pkg install sexp-diff

(provide check-sexp-equal?)

;; check-equal? doesn't even pretty-print the sexprs, which can be
;; very long and hard to compare. Anyway let's do even better and use
;; sexp-diff to highlight to diff.

(define-check (check-sexp-equal? a b)
  (or (equal? a b)
      (fail-check (format "sexp-diff (#:new = actual, #:old = expected):~n~n~a"
                          (pretty-format (first (sexp-diff b a)))))))

(define-check (check-sexp-equal2? a b)
  (or (equal? a b)
      (with-check-info (['actual a]
                        ['expected b]
                        ['sexp-diff (first (sexp-diff b a))]
                        ['key "sexp-diff (#:new = actual, #:old = expected)"])
        (fail-check))))

(module+ test
  (define (check-stack->hash lst)
    (for/hash ([info (in-list lst)])
      (values (check-info-name info)
              (check-info-value info))))

  (define-check (check-exn-info? proc message info)
    (define failure (with-handlers ([exn:test:check? identity])
                      (parameterize ([current-check-around (λ (proc) (proc))])
                        (proc))
                      #f))
    (unless failure (fail-check "No failure raised"))
    (define info-hash (check-stack->hash (exn:test:check-stack failure)))
    (check-equal? (exn-message failure) message "failed to match exn message")
    (for ([(k v) (in-hash info)])
      (check-equal? (hash-ref info-hash k (not v)) v)))

  (let ([a '(a (foo bar foo bar b c d e f (g h i j k l))
             (m n o p q (r s t u v w x y z)))]
        [b '(a (foo bar foo bar b c d e f (g h i j k l))
             (m n o p q (r s t u v 0 x y z)))])

    (check-exn-info? (thunk (check-equal? a b))
                     "Check failure"
                     (hash 'actual a
                           'expected b))

    ;; --------------------
    ;; FAILURE
    ;; name:       check-sexp-equal?
    ;; location:   (#<path:/Users/ryan/Work/git/zenspider/check-sexp-equal/main.rkt> 52 0 1881 23)
    ;; expression: (check-sexp-equal? a b)
    ;; params:     ((a (foo bar foo bar b c d e f (g h i j k l)) (m n o p q (r s t u v w x y z))) (a (foo bar foo bar b c d e f (g h i j k l)) (m n o p q (r s t u v 0 x y z))))
    ;;
    ;; ; sexp-diff (#:new = actual, #:old = expected):
    ;; ;
    ;; ; '(a
    ;; ;   (foo bar foo bar b c d e f (g h i j k l))
    ;; ;   (m n o p q (r s t u v #:new w #:old 0 x y z)))
    ;; ; /Users/ryan/Work/git/zenspider/check-sexp-equal/main.rkt:52:0
    ;; --------------------

    (check-exn-info? (thunk (check-sexp-equal? a b))
                     #<<DONE
sexp-diff (#:new = actual, #:old = expected):

'(a
  (foo bar foo bar b c d e f (g h i j k l))
  (m n o p q (r s t u v #:new w #:old 0 x y z)))
DONE
                     (hash))

    ;; --------------------
    ;; FAILURE
    ;; actual:     (a (foo bar foo bar b c d e f (g h i j k l)) (m n o p q (r s t u v w x y z)))
    ;; expected:   (a (foo bar foo bar b c d e f (g h i j k l)) (m n o p q (r s t u v 0 x y z)))
    ;; sexp-diff:  (a (foo bar foo bar b c d e f (g h i j k l)) (m n o p q (r s t u v #:new w #:old 0 x y z)))
    ;; key:        "sexp-diff (#:new = actual, #:old = expected)"
    ;; name:       check-sexp-equal2?
    ;; location:   (#<path:/Users/ryan/Work/git/zenspider/check-sexp-equal/main.rkt> 58 0 2160 24)
    ;; expression: (check-sexp-equal2? a b)
    ;;
    ;; --------------------

    (check-exn-info? (thunk (check-sexp-equal2? a b))
                     "Check failure"
                     (hash 'actual a
                           'expected b
                           'sexp-diff '(a (foo bar foo bar b c d e f (g h i j k l)) (m n o p q (r s t u v #:new w #:old 0 x y z)))))

    (displayln 'done)
    ))

standard-module-name-resolver: collection not found
  for module path: sexp-diff
  collection: "sexp-diff"
  in collection directories:
   /home/pasterack/.racket/6.6/collects
   /home/pasterack/racket66/collects
   ... [161 additional linked and package directories]
  context...:
   show-collection-err
   standard-module-name-resolver
   /home/pasterack/racket66/collects/racket/require-transform.rkt:266:2: expand-import
   /home/pasterack/racket66/collects/racket/private/reqprov.rkt:570:24
   /home/pasterack/racket66/collects/racket/private/reqprov.rkt:558:5
   /home/pasterack/racket66/collects/racket/require-transform.rkt:266:2: expand-import
   /home/pasterack/racket66/collects/racket/private/reqprov.rkt:266:21: try-next
   /home/pasterack/racket66/collects/racket/private/reqprov.rkt:347:21: try-next
   /home/pasterack/racket66/collects/racket/private/reqprov.rkt:243:2
   /home/pasterack/racket66/collects/syntax/wrap-modbeg.rkt:46:4