1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495 |
- ;;;; collect.lisp
- ;;;;
- ;;;; Copyright (c) 2015 Samuel W. Flint <swflint@flintfam.org>
- (in-package #:collect)
- ;;; "collect" goes here. Hacks and glory await!
- (defun to-sql-type (type)
- (cadr (assoc type '((:integer "INTEGER")
- (:text "TEXT")
- (:real "REAL")
- (:blob "BLOB")))))
- (defun relation (relationship)
- (if (not (null relationship))
- (destructuring-bind (table column) relationship
- (declare (string table column))
- (format nil " REFERENCES ~a (~a)"
- table
- column))
- ""))
- (defun col-to-clause (column)
- (destructuring-bind (name type &key (nullable t) (primary nil) relationship) column
- (declare (string name)
- (keyword type)
- (ignorable nullable relationship))
- (if (null primary)
- (if (null nullable)
- (format nil "~a ~a~a,"
- name
- (to-sql-type type)
- (relation relationship))
- (format nil "~a ~a~a NOT NULL,"
- name
- (to-sql-type type)
- (relation relationship)))
- (format nil "~a ~a PRIMARY KEY,"
- name
- (to-sql-type type)))))
- (defmacro define-table (name (&rest cols) &key &allow-other-keys)
- (let* ((clauses (map 'list #'col-to-clause cols))
- (sql-command (format nil "CREATE TABLE IF NOT EXISTS ~a~%(~%~{~a~%~});"
- name
- clauses)))
- `(list ,sql-command)))
- (defun make-form-entry (entry)
- (destructuring-bind (label column &key (type :text) other-column options) entry
- (declare (string label column)
- (ignorable other-column options))
- (let ((label-name (concatenate 'string "fld_" column))
- (the-options (if (null options)
- (if (not (null other-column))
- `(,(car other-column) ,(cadr other-column))))))
- (case type
- (:text
- `(:tr
- (:td ,label)
- (:td (:input :type :text
- :name ,label-name))))
- (:drop-down
- `(:tr
- (:td ,label)
- (:td
- (:select :name ,label-name
- (loop for option in ,the-options
- collect (make-option-drop-down option))))))
- (:radio-buttons
- `(:tr
- (:td ,label)
- (:td (loop for option in ,the-options
- collect (make-option-radio option ,label-name)))))))))
- (defun make-option-drop-down (option)
- (let ((name (first option))
- (value (second option)))
- `(:option :value ,value ,name)))
- (defun make-option-radio (option label)
- (let ((name (first option))
- (value (second option)))
- `(:div (:input :type "radio" :name ,label :value ,value)
- ,name (:br))))
- (defmacro define-form (name table (&rest fields) &key &allow-other-keys)
- (let* ((columns (map 'list #'second fields))
- (field-names (map 'list #'(lambda (column)
- (concatenate 'string "fld_" column))
- columns))
- (form-entries (map 'list #'make-form-entry fields)))
- `(list (list ,@columns)
- (list ,@field-names))))
|