Permalink
Browse files

Initial commit.

  • Loading branch information...
0 parents commit 19647467baafed1ecb8e675617e65328a9245fd2 @fukamachi committed Oct 19, 2013
Showing with 1,146 additions and 0 deletions.
  1. +8 −0 .gitignore
  2. +18 −0 README.markdown
  3. +71 −0 src/clause.lisp
  4. +123 −0 src/operator.lisp
  5. +242 −0 src/sql-type.lisp
  6. +57 −0 src/statement.lisp
  7. +40 −0 src/sxql.lisp
  8. +23 −0 sxql-test.asd
  9. +43 −0 sxql.asd
  10. +117 −0 t/clause.lisp
  11. +213 −0 t/operator.lisp
  12. +72 −0 t/sql-type.lisp
  13. +54 −0 t/statement.lisp
  14. +65 −0 t/sxql.lisp
@@ -0,0 +1,8 @@
+*.fasl
+*.dx32fsl
+*.dx64fsl
+*.lx32fsl
+*.lx64fsl
+*.x86f
+*~
+.#*
@@ -0,0 +1,18 @@
+# Sxql
+
+## Usage
+
+## Installation
+
+## Author
+
+* Eitarow Fukamachi (e.arrows@gmail.com)
+
+## Copyright
+
+Copyright (c) 2013 Eitarow Fukamachi (e.arrows@gmail.com)
+
+# License
+
+Licensed under the BSD 2-Clause License.
+
@@ -0,0 +1,71 @@
+(in-package :cl-user)
+(defpackage sxql.clause
+ (:use :cl
+ :sxql.sql-type
+ :sxql.operator))
+(in-package :sxql.clause)
+
+(cl-syntax:use-syntax :annot)
+
+@export
+(defstruct (field-clause (:include sql-clause (name ""))
+ (:constructor make-field-clause (fields)))
+ (fields nil :type sql-expression))
+
+@export
+(defstruct (from-clause (:include statement-clause (name "FROM"))
+ (:constructor make-from-clause (statement))))
+
+@export
+(defstruct (where-clause (:include expression-clause (name "WHERE"))
+ (:constructor make-where-clause (expression))))
+
+@export
+(defstruct (order-by-clause (:include expression-clause (name "ORDER BY"))
+ (:constructor make-order-by-clause (expression))))
+
+@export
+(defstruct (limit-clause (:include sql-clause (name "LIMIT"))
+ (:constructor make-limit-clause (count1 &optional count2)))
+ (count1 nil :type sql-variable)
+ (count2 nil :type (or null sql-variable)))
+
+@export
+(defstruct (offset-clause (:include sql-clause (name "OFFSET"))
+ (:constructor make-offset-clause (offset)))
+ (offset nil :type sql-variable))
+
+@export
+(defstruct (group-by-clause (:include expression-clause (name "GROUP BY"))
+ (:constructor make-group-by-clause (expression))))
+
+(defun find-make-clause (clause-name &optional (package *package*))
+ (find-constructor clause-name #.(string :-clause)
+ :package package))
+
+@export
+(defun make-clause (clause-name &rest args)
+ (apply (find-make-clause clause-name #.*package*)
+ (mapcar #'detect-and-convert args)))
+
+(defmethod stringify ((clause field-clause))
+ (if (field-clause-fields clause)
+ (stringify (field-clause-fields clause))
+ (values "*" nil)))
+
+(defmethod stringify ((clause limit-clause))
+ (let ((*use-placeholder* nil))
+ (values
+ (format nil "LIMIT ~A~:[~;~:*, ~A~]"
+ (stringify (limit-clause-count1 clause))
+ (if (limit-clause-count2 clause)
+ (stringify (limit-clause-count2 clause))
+ nil))
+ nil)))
+
+(defmethod stringify ((clause offset-clause))
+ (let ((*use-placeholder* nil))
+ (values
+ (format nil "OFFSET ~A"
+ (stringify (offset-clause-offset clause)))
+ nil)))
@@ -0,0 +1,123 @@
+(in-package :cl-user)
+(defpackage sxql.operator
+ (:use :cl
+ :sxql.sql-type))
+(in-package :sxql.operator)
+
+(cl-syntax:use-syntax :annot)
+
+(defmacro define-op ((op-name struct-type &key sql-op-name include-slots) &body body)
+ (check-type op-name symbol)
+ (let ((struct-name (intern (concatenate 'string (symbol-name op-name) #.(string :-op)))))
+ `(defstruct (,struct-name (:include ,struct-type
+ (name ,(or sql-op-name
+ (with-output-to-string (s)
+ (loop for c across (symbol-name op-name)
+ if (char= c #\-)
+ do (write-char #\Space s)
+ else
+ do (write-char c s)))))
+ ,@include-slots)
+ (:constructor ,(intern (concatenate 'string
+ #.(string :make-)
+ (symbol-name op-name)
+ #.(string :-op)))
+ ,(case struct-type
+ ((unary-op
+ unary-suffix-op) '(var))
+ ((infix-op
+ infix-list-op) '(left right))
+ (conjunctive-op '(&rest expressions)))))
+ ,@body)))
+
+(define-op (:not unary-op))
+(define-op (:is-null unary-op))
+(define-op (:not-null unary-op))
+(define-op (:desc unary-suffix-op))
+(define-op (:asc unary-suffix-op))
+
+(define-op (:= infix-op))
+(define-op (:!= infix-op))
+(define-op (:< infix-op))
+(define-op (:> infix-op))
+(define-op (:<= infix-op))
+(define-op (:>= infix-op))
+(define-op (:as infix-op))
+(define-op (:in infix-list-op))
+(define-op (:not-in infix-list-op))
+(define-op (:like infix-op))
+
+(define-op (:or conjunctive-op))
+(define-op (:and conjunctive-op))
+(define-op (:+ conjunctive-op))
+(define-op (:- conjunctive-op :sql-op-name "-"))
+(define-op (:* conjunctive-op))
+(define-op (:/ conjunctive-op))
+(define-op (:% conjunctive-op))
+
+(defstruct (raw-op (:include sql-op (name ""))
+ (:constructor make-raw-op (var)))
+ (var nil :type (or string
+ sql-variable)))
+
+@export
+(defun find-constructor (name suffix &key (package *package*) (errorp t))
+ (check-type name symbol)
+ (let ((func-symbol (intern
+ (concatenate 'string
+ #.(string :make-)
+ (symbol-name name)
+ suffix)
+ package)))
+ (if (or errorp (fboundp func-symbol))
+ (symbol-function func-symbol)
+ nil)))
+
+(defun find-make-op (op-name &optional (package *package*))
+ (or (find-constructor op-name #.(string :-op)
+ :package package
+ :errorp nil)
+ #'(lambda (&rest expressions)
+ (apply #'make-function-op (symbol-name op-name) expressions))))
+
+@export
+(defun make-op (op-name &rest args)
+ (apply (find-make-op op-name #.*package*)
+ (mapcar #'detect-and-convert args)))
+
+@export
+(defun detect-and-convert (object)
+ (etypecase object
+ (number (make-sql-variable object))
+ (string (make-sql-variable object))
+ (keyword (make-sql-keyword (string-upcase object)))
+ (symbol
+ (if (string= (symbol-name object) "*")
+ (detect-and-convert :*)
+ (make-sql-symbol (string-downcase object))))
+ (list
+ (if (keywordp (car object))
+ (apply #'make-op object)
+ (apply #'make-sql-list
+ (mapcar #'detect-and-convert object))))
+ (structure-object object)))
+
+(defmethod stringify ((op is-null-op))
+ (stringify
+ (make-infix-op "IS"
+ (is-null-op-var op)
+ (make-sql-keyword "NULL"))))
+
+(defmethod stringify ((op not-null-op))
+ (stringify
+ (make-infix-op "IS NOT"
+ (not-null-op-var op)
+ (make-sql-keyword "NULL"))))
+
+(defmethod stringify ((raw raw-op))
+ (values
+ (format nil "(~A)"
+ (etypecase (raw-op-var raw)
+ (string (raw-op-var raw))
+ (sql-variable (let ((*use-placeholder* nil)) (stringify (raw-op-var raw))))))
+ nil))
Oops, something went wrong.

0 comments on commit 1964746

Please sign in to comment.