;;; Weeb --- Web microframework for GNU Guile
;;; Copyright © 2026 Jakob Kreuze <zerodaysfordays@sdf.org>
;;;
;;; This file is part of Weeb.
;;;
;;; Weeb is free software: you can redistribute it and/or modify it
;;; under the terms of the GNU Affero General Public License as
;;; published by the Free Software Foundation, either version 3 of the
;;; License, or (at your option) any later version.
;;;
;;; Weeb is distributed in the hope that it will be useful, but WITHOUT
;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
;;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Affero General
;;; Public License for more details.
;;;
;;; You should have received a copy of the GNU Affero General Public
;;; License along with Weeb. If not, see <https://www.gnu.org/licenses/>.

(define-module (weeb struct)
  #:use-module (ice-9 regex)
  #:export (define-struct
            make-struct
            with-accessors
            call-with-slots))

;; Define a new record type with the given NAME and FIELDS.
(define-syntax define-struct
  (lambda (stx)
    (syntax-case stx ()
      ((_ name field* ...)
       #'(define name
           (let* ((type-string (symbol->string (quote name)))
                  (type-representation (match:substring
                                        (string-match "[^<> ]+" type-string))))
             (make-record-type (symbol->string (quote name))
                               (quote (field* ...)))))))))

(define (make-struct type . args)
  "Create a new instance of the record type TYPE using ARGS to
instantiate the record's fields."
  (apply (record-constructor type) args))

;; Bind the accessors for the fields of the record RTD to local
;; variables in BODY. RTD must be a record type descriptor.
(define-syntax with-accessors
  (syntax-rules ()
    ((with-accessors (rtd field ...)
        body ...)
     (let ((rtd-eval rtd))
       (let ((field ((record-accessor (record-type-descriptor rtd) 'field) rtd))
             ...)
         body ...)))))

;; Bind the slots of the record RTD to the named variables in LAMBDA.
;; This allows for pattern-matching-like access to the fields of the
;; record.
(define-syntax call-with-slots
  (syntax-rules ()
    ((call-with-slots rtd
        (lambda (field ...)
          body ...))
     (let ((rtd-eval rtd))
       (let ((field ((record-accessor (record-type-descriptor rtd) 'field) rtd))
             ...)
         body ...)))))