Skip to content

Instantly share code, notes, and snippets.

@shakdwipeea
Created February 13, 2020 21:39
Show Gist options
  • Save shakdwipeea/47cfb6250efa4843a4022bf017b16e97 to your computer and use it in GitHub Desktop.
Save shakdwipeea/47cfb6250efa4843a4022bf017b16e97 to your computer and use it in GitHub Desktop.
(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"])
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment