X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=sql%2Fsyntax.lisp;h=eb19060c4b6ad655eab3c542d1a1482aa03a7925;hp=c265f634917769e625648c89e7b2d864096269d5;hb=e16a346ab24dc2ee91ce331baef039767bca57e9;hpb=5be31565b7d87b90f0e79a9e61af84ad05e12920 diff --git a/sql/syntax.lisp b/sql/syntax.lisp index c265f63..eb19060 100644 --- a/sql/syntax.lisp +++ b/sql/syntax.lisp @@ -89,7 +89,7 @@ reader syntax is disabled." (declare (ignore char)) (let ((sqllist (read-delimited-list #\] stream t))) (cond ((string= (write-to-string (car sqllist)) "||") - (cons (sql-operator 'concat) (cdr sqllist))) + (cons (sql-operator 'concat-op) (cdr sqllist))) ((and (= (length sqllist) 1) (eql (car sqllist) '*)) (apply #'generate-sql-reference sqllist)) ((sql-operator (car sqllist)) @@ -114,70 +114,77 @@ reader syntax is disabled." (sql-expression :string (car arglist)) (sql-expression :attribute (car arglist)))) ((<= 2 (length arglist)) - (let ((sqltype (if (keywordp (caddr arglist)) - (caddr arglist) nil)) - (sqlparam (if (keywordp (caddr arglist)) - (caddr arglist)))) - (cond + (let ((sqltype (when (keywordp (caddr arglist)) (caddr arglist) nil))) + (cond ((stringp (cadr arglist)) (sql-expression :table (car arglist) :alias (cadr arglist) :type sqltype)) ((keywordp (cadr arglist)) (sql-expression :attribute (car arglist) - :type (cadr arglist) - :params sqlparam)) + :type (cadr arglist))) (t (sql-expression :attribute (cadr arglist) :table (car arglist) - :params sqlparam :type sqltype))))) (t - (error 'clsql-sql-syntax-error :reason "bad expression syntax")))) + (error 'sql-user-error :message "bad expression syntax")))) ;; Exported functions for dealing with SQL syntax (defun sql (&rest args) - "Returns an SQL string generated from the SQL expressions -ARGS. The expressions are translated into SQL strings and then -concatenated with a single space delimiting each expression." + "Returns an SQL string generated from the expressions ARGS. The +expressions are translated into SQL strings and then concatenated +with a single space delimiting each expression. An error of type +SQL-USER-ERROR is signalled if any element in ARGS is not of the +supported types (a symbol, string, number or symbolic SQL +expression) or a list or vector containing only these supported +types." (format nil "~{~A~^ ~}" (mapcar #'sql-output args))) -(defun sql-expression (&key string table alias attribute type params) - "Returns an SQL expression constructed from the supplied arguments -which may be combined as follows: ATTRIBUTE and TYPE; ATTRIBUTE; -ALIAS or TABLE and ATTRIBUTE and TYPE; ALIAS or TABLE and -ATTRIBUTE; TABLE, ATTRIBUTE and TYPE; TABLE and ATTRIBUTE; TABLE -and ALIAS; TABLE; and STRING." +(defun sql-expression (&key string table alias attribute type) + "Returns an SQL expression constructed from the supplied +arguments which may be combined as follows: ATTRIBUTE and TYPE; +ATTRIBUTE; ALIAS or TABLE and ATTRIBUTE and TYPE; ALIAS or TABLE +and ATTRIBUTE; TABLE, ATTRIBUTE and TYPE; TABLE and ATTRIBUTE; +TABLE and ALIAS; TABLE; and STRING. An error of type +SQL-USER-ERROR is signalled if an unsupported combination of +keyword arguments is specified." (cond (string (make-instance 'sql :string string)) (attribute (make-instance 'sql-ident-attribute :name attribute :qualifier (or table alias) - :type type - :params params)) + :type type)) ((and table (not attribute)) (make-instance 'sql-ident-table :name table :table-alias alias)))) -(defun sql-operator (operation) - "Returns the Lisp symbol corresponding to the SQL operation - represented by the symbol OPERATION." - (typecase operation +(defun sql-operator (operator) + "Returns the Lisp symbol corresponding to the SQL operator + represented by the symbol OPERATOR. If OPERATOR does not + represent a supported SQL operator or is not a symbol, nil is + returned." + (typecase operator (string nil) - (symbol (gethash (symbol-name-default-case (symbol-name operation)) - *sql-op-table*)))) - -(defun sql-operation (operation &rest rest) - "Returns an SQL expression constructed from the supplied SQL -operator or function OPERATION and its arguments REST. If -OPERATION is passed the symbol FUNCTION then the first value in -REST is taken to be a valid SQL function and the remaining values -in REST its arguments." - (if (sql-operator operation) - (apply (symbol-function (sql-operator operation)) rest) - (error "~A is not a recognized SQL operator." operation))) + (symbol (values (gethash (symbol-name-default-case (symbol-name operator)) + *sql-op-table*))))) + +(defun sql-operation (operator &rest args) + "Returns an SQL expression constructed from the supplied symbol +OPERATOR representing an SQL operator or function and its +arguments ARGS. An error of type SQL-USER-ERROR is signalled if +OPERATOR is not a symbol representing a supported SQL +operator. If OPERATOR is passed the symbol FUNCTION then the +first value in ARGS must be a string representing a valid SQL +function and the remaining values in ARGS its arguments as +strings." + (if (sql-operator operator) + (apply (symbol-function (sql-operator operator)) args) + (error 'sql-user-error + :message + (format nil "~A is not a recognized SQL operator." operator))))