- (cond
- ((consp specified-type)
- (cond
- ((and (symbolp (car specified-type))
- (string-equal (symbol-name (car specified-type)) "string"))
- 'string)
- ((and (symbolp (car specified-type))
- (string-equal (symbol-name (car specified-type)) "varchar"))
- 'string)
- ((and (symbolp (car specified-type))
- (string-equal (symbol-name (car specified-type)) "char"))
- 'string)
- (t
- specified-type)))
- ((eq (ensure-keyword specified-type) :bigint)
- 'integer)
- ((eq (ensure-keyword specified-type) :char)
- 'character)
- ((eq (ensure-keyword specified-type) :varchar)
- 'string)
- ((and specified-type
- (not (eql :not-null (slot-value slotd 'db-constraints))))
- `(or null ,specified-type))
- (t
- specified-type)))
+ (let ((type
+ (cond
+ ((consp specified-type)
+ (cond
+ ((and (symbolp (car specified-type))
+ (string-equal (symbol-name (car specified-type)) "string"))
+ 'string)
+ ((and (symbolp (car specified-type))
+ (string-equal (symbol-name (car specified-type)) "varchar"))
+ 'string)
+ ((and (symbolp (car specified-type))
+ (string-equal (symbol-name (car specified-type)) "char"))
+ 'string)
+ (t
+ specified-type)))
+ ((eq (ensure-keyword specified-type) :bigint)
+ 'integer)
+ ((eq (ensure-keyword specified-type) :char)
+ 'character)
+ ((eq (ensure-keyword specified-type) :varchar)
+ 'string)
+ (t
+ specified-type)))
+ (constraints (slot-value slotd 'db-constraints)))
+ (if (and type (not (member :not-null (listify constraints))))
+ `(or null ,type)
+ type)))