records-with-default-values.scm

(define-syntax define-record-with-defaults
  (lambda (stx)
    (syntax-case stx ()
      ((_ record-name (field-info ...))
       (with-syntax (((field-names ...) (map (lambda (field-value)
					     (let ((val (syntax->datum field-value)))
					       (cond
						((symbol? val) (datum->syntax #'record-name val))
						((pair? val) (datum->syntax #'record-name (car val)))
						(else (syntax-error "either a symbol or pair supported")))))
					   #'(field-info ...)))
		     (default-constructor (construct-name #'record-name "make-" #'record-name)))
	 #'(begin (define-record-type record-name (fields field-names ...))
		  
		  (define-syntax record-name
		    (lambda (stx)
		      
		      ;; given a list of symbols and a list of pairs
		      ;; returns list of values associated with the symbols
		      (define order
			(lambda (fields field-values-info)
			  (let ((default-vals (filter (lambda (f) (not (symbol? f))) fields)))
			    (map (lambda (field)
				   (cond
				    ((symbol? field)  (cadr (assoc field field-values-info)))
				    ((pair? field) (or (cadr (assoc (car field) default-vals))
						      (cdr field)))
				    (else (error "wrong value passed to constructor" field))))
				 fields))))
		      
		      (syntax-case stx ()
			((_ opts (... ...))
			 (with-syntax (((vals (... ...))
					(map (lambda (v) (datum->syntax #'record-name v))
					     (order '(field-info ...)
						    (map syntax->datum #'(opts (... ...)))))))
			   #'(default-constructor vals (... ...)))))))))))))


;; constructor takes a plist of values
;; genrates all the usual record defs
(define-record-with-defaults input-options
  (input-name
   [type "text"]
   [label-class "w-1/3"]
   [input-class "w-1/3"]
   [container-class "flex items-center mb-6"]))


(input-options [input-name "he"])