#lang racket/base

(provide schema-check-problems)

(require racket/match)
(require (only-in racket/list check-duplicates))
(require preserves/order)

(require (only-in "type.rkt" unwrap))
(require "gen/schema.rkt")

(define (schema-check-problems schema)
  (define problems '())

  (define (problem! context f . args)
    (set! problems (cons (format "~v: ~a" (reverse context) (apply format f args)) problems)))

  (define (check-binding context scope n)
    (when (hash-has-key? scope n)
      (problem! context "duplicate binding ~v" n))
    (hash-set! scope n #t))

  (define (check-pattern context scope p value-available?)
    (match (unwrap p)
      [(SimplePattern-lit _)
       (void)]
      [(? SimplePattern?)
       (when (not value-available?) (problem! context "non-bijection"))]
      [(CompoundPattern-rec l f)
       (check-named-pattern (cons "label" context) scope l)
       (check-named-pattern (cons "fields" context) scope f)]
      [(CompoundPattern-tuple ps)
       (for [(p (in-list ps)) (i (in-naturals))] (check-named-pattern (cons i context) scope p))]
      [(CompoundPattern-tuple* ps v)
       (for [(p (in-list ps)) (i (in-naturals))] (check-named-pattern (cons i context) scope p))
       (check-named-pattern (cons "tail" context) scope v)]
      [(CompoundPattern-dict entries)
       (for [(entry (in-list (sorted-dict-entries entries)))]
         (check-named-pattern (cons (car entry) context) scope (cdr entry)))]))

  (define (check-named-pattern context scope p)
    (match (unwrap p)
      [(NamedSimplePattern_ n p)
       (check-binding context scope n)
       (check-pattern (cons n context) scope p #t)]
      [p (check-pattern context scope p #f)]))

  (for [((name def) (in-hash (Schema-definitions schema)))]
    (define context (list name))
    (match def
      [(Definition-or p0 p1 pN)
       (define alts (list* p0 p1 pN))
       (unless (void? (check-duplicates alts #:key NamedAlternative-variantLabel #:default (void)))
         (problem! context "duplicate variant label"))
       (for [(a (in-list alts))]
         (check-pattern context (make-hash) (NamedAlternative-pattern a) #t))]
      [(Definition-and p0 p1 pN)
       (define scope (make-hash))
       (for [(p (in-list (list* p0 p1 pN)))]
         (check-named-pattern context scope p))]
      [(Definition-Pattern p) (check-pattern context (make-hash) p #t)]))

  (reverse problems))