#lang racket

(module+ test
  (require rackunit)

  (require (for-syntax racket/base))
  (require (for-syntax syntax/srcloc))
  (require (for-template "../pattern.rkt"))
  (require "../pattern.rkt")

  (struct foo (bar zot) #:prefab)

  (define-syntax (check-analyse-pattern stx)
    (syntax-case stx ()
      [(_ expected-pat actual-stxpat fn)
       #`(with-check-info [('real-location #,(source-location->string stx))]
           (check-match (fn '#,(analyse-pattern #'actual-stxpat)) expected-pat))]
      [(_ expected-pat actual-stxpat)
       #'(check-analyse-pattern expected-pat actual-stxpat values)]))

  (check-analyse-pattern `(compound ,_ (atom 123) (atom 234)) (foo 123 234))
  (check-analyse-pattern `(compound ,_ (discard) (atom 234)) (foo _ 234))
  (check-analyse-pattern `(compound ,_ (atom 123) (atom xyzzy)) (foo 123 xyzzy))
  (check-analyse-pattern `(compound ,_ (atom 123) (capture cap (discard))) (foo 123 $cap))
  (check-analyse-pattern `(compound ,_ (atom 123) (capture cap (atom 234))) (foo 123 ($ cap 234)))

  (check-analyse-pattern `(atom (bar 123 234)) (bar 123 234))
  (check-analyse-pattern `(atom (bar 123 $beep)) (bar 123 $beep))

  (check-analyse-pattern `(compound list (atom 123) (capture q (discard))) (list 123 $q))

  (define ((s->d f) desc) (syntax->datum (f desc)))

  (check-analyse-pattern '() $cap desc->key)
  (check-analyse-pattern '() $cap desc->skeleton-proj)
  (check-analyse-pattern '(()) $cap desc->capture-proj)
  (check-analyse-pattern '#f $cap (s->d desc->skeleton-stx))
  (check-analyse-pattern '(capture (discard)) $cap (s->d desc->assertion-stx))

  (check-analyse-pattern '(123) (foo 123 $cap) desc->key)
  (check-analyse-pattern '((0)) (foo 123 $cap) desc->skeleton-proj)
  (check-analyse-pattern '((1)) (foo 123 $cap) desc->capture-proj)
  (check-analyse-pattern '(list struct:foo #f #f) (foo 123 $cap) (s->d desc->skeleton-stx))
  (check-analyse-pattern '(foo 123 (capture (discard))) (foo 123 $cap) (s->d desc->assertion-stx))

  (check-analyse-pattern '((bar 'beep)) (foo (bar 'beep) $cap) desc->key)
  (check-analyse-pattern '((0)) (foo (bar 'beep) $cap) desc->skeleton-proj)
  (check-analyse-pattern '((1)) (foo (bar 'beep) $cap) desc->capture-proj)
  (check-analyse-pattern '(list struct:foo #f #f) (foo (bar 'beep) $cap) (s->d desc->skeleton-stx))
  (check-analyse-pattern '(foo (bar 'beep) (capture (discard)))
                         (foo (bar 'beep) $cap)
                         (s->d desc->assertion-stx))

  (define-pattern-expander foo123
    (syntax-rules ()
      [(_ zot) (foo 123 zot)]))

  (define-pattern-expander foo234
    (syntax-rules ()
      [(_ zot) (foo 234 zot)])
    (syntax-rules ()
      [(_ zot) (foo 234 zot)]))

  (check-analyse-pattern `(compound ,_ (atom 123) (atom 'zot)) (foo123 'zot))
  (check-analyse-pattern `(compound ,_ (atom 234) (atom 'zot)) (foo234 'zot))
  (check-equal? (foo 234 'zot) (foo234 'zot))

  )