Possible additional sql-ops

[Sabra Crolleton]

I have been writing queries requiring window functions and recursive
with functions. I finally decided to try to write some sql-ops so that
I can use s-sql. They work for me but would appreciate comments. I did
include a :parens op because I find that sometimes I just need an
additional set of parens for an sql query. Below are the functions,
the amendments to :select and :order-by and usage examples.

(def-sql-op :over (form &rest args)
  (if args `("(" ,@(sql-expand form) " OVER " ,@(sql-expand-list args) ")")
          `("(" ,@(sql-expand form) " OVER ()) ")))

(def-sql-op :partition-by (&rest args)
  `("(PARTITION BY " ,@(sql-expand-list args) ")"))

(def-sql-op :partition-by-order-by (form &rest fields)
  `("(PARTITION BY " ,@(sql-expand form) " ORDER BY "
,@(sql-expand-list fields) ") "))

(def-sql-op :parens (op) `(" (" ,@(sql-expand op) ") "))

(def-sql-op :with (&rest args)
  (let ((x (butlast args)) (y (last args)))
    `("WITH " ,@(sql-expand-list x) ,@(sql-expand (car y)))))

(def-sql-op :with-recursive1 (form1 form2)
  `("WITH RECURSIVE " ,@(sql-expand form1) ,@(sql-expand form2)))

(def-sql-op :window (form)
  `("WINDOW " ,@(sql-expand form)))


Amendment to :select (to pick up the new "window" arg

(def-sql-op :select (&rest args)
(split-on-keywords ((vars *) (distinct - ?) (distinct-on * ?) (from * ?)
(window ?) (where ?) (group-by * ?)
(having ?)) (cons :vars args)
`("(SELECT "
,@(if distinct '("DISTINCT "))
,@(if distinct-on `("DISTINCT ON (" ,@(sql-expand-list distinct-on) ") "))
,@(sql-expand-list vars)
,@(if from (cons " FROM " (expand-joins from)))
,@(if window (cons " WINDOW " (sql-expand-list window)))
,@(if where (cons " WHERE " (sql-expand (car where))))
,@(if group-by (cons " GROUP BY " (sql-expand-list group-by)))
,@(if having (cons " HAVING " (sql-expand (car having))))
")")))

Amendment to :order-by to pick up the situation where the only arg is the
form

(def-sql-op :order-by (form &rest fields)
(if fields
`("(" ,@(sql-expand form) " ORDER BY " ,@(sql-expand-list fields) ")")
`("( ORDER BY " ,@(sql-expand form) ")")))


Usage Examples:
Over Examples generally following
http://www.postgresql.org/docs/9.3/static/tutorial-window.html

(query (:select 'salary (:over (:sum 'salary))
                :from 'empsalary))

(query (:select 'depname 'empno 'salary
                (:over (:avg 'salary)
                       (:partition-by 'depname))
                :from 'empsalary))

(query (:select 'depname 'empno 'salary
                (:over (:rank)
                       (:partition-by-order-by 'depname (:desc 'salary)))
                :from 'empsalary))

(query (:select (:over (:sum 'salary) 'w)
              (:over (:avg 'salary) 'w)
              :from 'empsalary :window
              (:as 'w (:partition-by-order-by 'depname
                                              (:desc 'salary)))))


With Examples

(query (:with (:as 'upd

                 (:parens
                  (:update 'employees :set 'sales-count (:+ 'sales-count 1)
                           :where (:= 'id
                                      (:select 'sales-person
                                               :from 'accounts
                                               :where (:= 'name "Acme
Corporation")))
                           :returning '*)))
            (:insert-into 'employees-log
                          (:select '* 'current-timestamp :from
                 'upd))))

With-Recursive Examples following
http://www.postgresql.org/docs/current/static/queries-with.html

(query (:with-recursive
      (:as (:t1 'n)
           (:union-all (:values 1)
                       (:select (:+ 'n 1)
                                :from 't1
                                :where (:< 'n 100))))
      (:select (:sum 'n) :from 't1)))

(query (:with-recursive
      (:as (:included_parts 'sub-part 'part 'quantity)
           (:union-all
            (:select 'sub-part 'part 'quantity
                     :from 'parts
                     :where (:= 'part "our-product"))
            (:select 'p.sub-part 'p.part 'p.quantity
                     :from (:as 'included-parts 'pr)
                     (:as 'parts 'p)
                     :where (:= 'p.part 'pr.sub-part) )))
      (:select 'sub-part (:as (:sum 'quantity) 'total-quantity)
               :from 'included-parts
               :group-by 'sub-part)))

(query (:with-recursive
      (:as (:search-graph 'id 'link 'data 'depth)
           (:union-all (:select 'g.id 'g.link 'g.data 1
                                :from (:as 'graph 'g))
                       (:select 'g.id 'g.link 'g.data (:+ 'sg.depth 1)
                                :from (:as 'graph 'g) (:as 'search-graph 'sg)
                                :where (:= 'g.id 'sg.link))))
      (:select '* :from 'search-graph)))

(query (:with-recursive
      (:as (:search-graph 'id 'link 'data'depth 'path 'cycle)
           (:union-all
            (:select 'g.id 'g.link 'g.data 1
                     (:[] 'g.f1 'g.f2) nil
                     :from (:as 'graph 'g))
            (:select 'g.id 'g.link 'g.data (:+ 'sg.depth 1)
                     (:|| 'path (:row 'g.f1 'g.f2))
                     (:= (:row 'g.f1 'g.f2)
                         (:any* 'path))
                     :from (:as 'graph 'g)
                     (:as 'search-graph 'sg)
                     :where (:and (:= 'g.id 'sg.link)
                                  (:not 'cycle)))))
      (:select '* :from 'search-graph)))
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/postmodern-devel/attachments/20131026/328243dd/attachment.html>