#lang racket/base

(provide (prefix-out mirror: (struct-out record))
         (rename-out [record-expander record]
                     [record?* record?]
                     [record-label* record-label]
                     [record-fields* record-fields]))

(require racket/match)
(require "struct.rkt")

(struct record (label fields) #:transparent)

(define (build-record label fields)
  (with-handlers [(exn:fail:contract? (lambda (e) (record label fields)))]
    (apply make-prefab-struct label fields)))

(define (unrecord r)
  (match r
    [(record label fields) (values #t label fields)]
    [(? non-object-struct?)
     (define key (prefab-struct-key r))
     (when (not key) (error 'preserves "Cannot process non-prefab struct ~v" r))
     (values #t key (cdr (vector->list (struct->vector r))))]
    [_ (values #f #f #f)]))

(define-match-expander record-expander
  (syntax-rules () [(_ lpat fpat) (app unrecord #t lpat fpat)])
  (syntax-rules () [(_ lval fval) (build-record lval fval)]))

(define (record?* r)
  (match r
    [(record-expander _ _) #t]
    [_ #f]))

(define (record-label* r)
  (match-define (record-expander l _) r)
  l)

(define (record-fields* r)
  (match-define (record-expander _ f) r)
  f)

(module+ test
  (require rackunit)
  (check-true (record?* (build-record "label" (list 123 234))))
  (check-true (record?* (build-record 'label (list 123 234))))
  (check-false (record?* "string")))