;;; -*- mode: Lisp; Syntax: Common-Lisp; -*-
;;;
;;; Copyright (c) 2006 by the authors.
;;;
;;; See LICENCE for details.

(in-package :hu.dwim.rdbms)

;; TODO: rename columns and tables to something more general?
(def syntax-node sql-select (sql-dml-statement)
  ((distinct
    nil
    :type boolean)
   (columns
    :type (list sql-column-alias*))
   (tables
    nil
    :type (list sql-table-reference))
   (where
    nil
    :type (or null sql-expression))
   (group-by
    nil
    :type (list sql-expression))
   (having
    nil
    :type (or null sql-expression))
   (order-by
    nil
    :type list)                         ; TODO: element type
   (offset
    nil
    :type (or null integer))
   (limit
    nil
    :type (or null integer))
   (for
    nil
    :type (or null (member :update :share))
    :accessor for-of)
   (wait
    #t
    :type boolean))
  (:documentation "An SQL SELECT statement.")
  (:format-sql-syntax-node
   (format-string "SELECT ")
   (when distinct
     (format-string "DISTINCT "))
   (format-comma-separated-identifiers columns)
   (when tables
     (format-string " FROM ")
     (format-comma-separated-list tables 'format-sql-table-reference))
   (format-sql-where where)
   (when group-by
     (format-string " GROUP BY ")
     (format-comma-separated-list group-by))
   (when having
     (format-string " HAVING ")
     (format-sql-syntax-node having))
   (when order-by
     (format-string " ORDER BY ")
     (format-comma-separated-list order-by))
   (when limit
     (format-string " LIMIT ")
     (format-sql-syntax-node limit))
   (when offset
     (format-string " OFFSET ")
     (format-sql-syntax-node offset))
   (when for
     (format-string " FOR ")
     (format-string (symbol-name for))
     (unless wait
       (format-string " NOWAIT")))))

;; TODO shouldn't the NAME slot be called TABLE and be typed (or sql-identifier* sql-table)?
(def syntax-node sql-table-alias (sql-identifier)
  ((name
    :type sql-identifier*)
   (alias
    nil
    :type sql-identifier*))
  (:format-sql-identifier
   (format-sql-identifier name)
   (when alias
     (format-string " ")
     (format-sql-identifier alias))))

(def type sql-table-alias* ()
  '(or string symbol sql-identifier sql-table-alias))

(def syntax-node sql-derived-table (sql-syntax-node)
  ((subquery
    :type )
   (alias
    nil
    :type sql-identifier*))
  (:format-sql-syntax-node
   (format-sql-syntax-node subquery)
   (when alias
     (format-char " ")
     (format-sql-identifier alias))))

(def syntax-node sql-joined-table (sql-syntax-node)
  ((kind
    :type (member :cross :inner :left :right :full :union))
   (left
    :type (or sql-table-reference list))
   (right
    :type (or sql-table-reference list))
   (on
    nil
    :type (or null sql-expression))
   (using
    nil
    :type (list sql-identifier*)))
  (:format-sql-syntax-node
   (format-char "(")
   (if (atom left)
       (format-sql-syntax-node left)
       (format-comma-separated-list left))
   (format-char " ")
   (format-string (string-upcase kind))
   (format-string " JOIN ")
   (if (atom right)
       (format-sql-syntax-node right)
       (format-comma-separated-list right))
   (when on
     (format-string " ON ")
     (format-sql-syntax-node on))
   (when using
     (format-string " USING ")
     (format-char "(")
     (format-comma-separated-identifiers using)
     (format-char ")"))
   (format-char ")")))

(def type sql-table-reference ()
  '(or sql-table-alias* sql-derived-table sql-joined-table))

(def function format-sql-table-reference (reference database)
  (etypecase reference
    (sql-table-alias* (format-sql-identifier reference database))
    ((or sql-derived-table sql-joined-table sql-unquote) (format-sql-syntax-node reference database))))

(def syntax-node sql-column-alias (sql-identifier)
  ((table
    nil
    :type sql-identifier*)
   (column
    :type sql-identifier*)
   (alias
    nil
    :type sql-identifier*))
  (:format-sql-identifier
   (awhen table
     (format-sql-identifier table)
     (format-char "."))
   (format-sql-identifier column)
   (when alias
     (format-string " AS ")
     (format-sql-identifier alias))))

(def type sql-column-alias* ()
  '(or string symbol sql-column-alias))

(def syntax-node sql-all-columns (sql-identifier)
  ()
  (:format-sql-identifier
   (format-char "*")))

(def syntax-node sql-distinct-spec (sql-identifier)
  ((column-spec
    :type (or integer sql-column-alias*)))
  (:format-sql-identifier
   (format-string "DISTINCT ")
   (format-sql-syntax-node column-spec)))

(def syntax-node sql-sort-spec (sql-syntax-node)
  ((sort-key
    :type (or integer sql-column-alias*))
   (ordering
    :ascending
    :type (member :ascending :descending)))
  (:format-sql-syntax-node
   (format-sql-syntax-node sort-key)
   (format-char " ")
   (ecase ordering
     (:ascending (format-string "ASC"))
     (:descending (format-string "DESC")))))