postmodern/util.lisp

   1 (in-package :postmodern)
   2
   3 (defun to-identifier (name)
   4   "Used to allow both strings and symbols as identifier - converts
   5 symbols to string with the S-SQL rules."
   6   (if (stringp name)
   7       name
   8       (to-sql-name name)))
   9
  10 (defun sequence-next (sequence)
  11   "Shortcut for getting the next value from a sequence."
  12   (query (:select (:nextval (to-identifier sequence))) :single))
  13
  14 (defmacro make-list-query (relkind)
  15   "Helper macro for the functions that list tables, sequences, and
  16 views."
  17   `(sql (:select 'relname :from 'pg-catalog.pg-class
  18          :inner-join 'pg-catalog.pg-namespace :on (:= 'relnamespace 'pg-namespace.oid)
  19          :where (:and (:= 'relkind ,relkind)
  20                  (:not-in 'nspname (:set "pg_catalog" "pg_toast"))
  21                  (:pg-catalog.pg-table-is-visible 'pg-class.oid)))))
  22
  23 (defmacro make-exists-query (relkind name)
  24   "Helper macro for the functions that check whether an object
  25 exists."
  26   `(sql (:select (:exists (:select 'relname :from 'pg_catalog.pg_class :inner-join 'pg_catalog.pg_namespace :on
  27                                    (:= 'pg_class.relnamespace 'pg_namespace.oid)
  28                                    :where (:and (:= 'pg_class.relkind ,relkind)
  29                                                 (:= 'pg_namespace.nspname (:any* (:current_schemas nil)))
  30                                                 (:= 'pg_class.relname (to-identifier ,name))))))))
  31
  32 (defun list-tables (&optional strings-p)
  33   "Return a list of the tables in a database. Turn them into keywords
  34 if strings-p is not true."
  35   (let ((result (query (make-list-query "r") :column)))
  36     (if strings-p result (mapcar 'from-sql-name result))))
  37
  38 (defun table-exists-p (table)
  39   "Check whether a table exists. Takes either a string or a symbol for
  40 the table name."
  41   (query (make-exists-query "r" table) :single))
  42
  43 (defun list-sequences (&optional strings-p)
  44   "Return a list of the sequences in a database. Turn them into
  45 keywords if strings-p is not true."
  46   (let ((result (query (make-list-query "S") :column)))
  47     (if strings-p result (mapcar 'from-sql-name result))))
  48 (defun sequence-exists-p (sequence)
  49   "Check whether a sequence exists. Takes either a string or a symbol
  50 for the sequence name."
  51   (query (make-exists-query "S" sequence) :single))
  52
  53 (defun list-views (&optional strings-p)
  54   "Return a list of the views in a database. Turn them into keywords
  55 if strings-p is not true."
  56   (let ((result (query (make-list-query "v") :column)))
  57     (if strings-p result (mapcar 'from-sql-name result))))
  58 (defun view-exists-p (view)
  59   "Check whether a view exists. Takes either a string or a symbol for
  60 the view name."
  61   (query (make-exists-query "v" view) :single))
  62
  63 (defun table-description (table &optional schema-name)
  64   "Return a list of (name type null-allowed) lists for the fields of a
  65 table.  If SCHEMA-NAME is specified, only fields from that schema are
  66 returned."
  67   (let ((schema-test (if schema-name (sql (:= 'pg-namespace.nspname schema-name)) "true")))
  68     (mapcar #'butlast
  69             (query (:order-by (:select 'attname 'typname (:not 'attnotnull) 'attnum :distinct
  70                                :from 'pg-catalog.pg-attribute
  71                                :inner-join 'pg-catalog.pg-type :on (:= 'pg-type.oid 'atttypid)
  72                                :inner-join 'pg-catalog.pg-class :on (:and (:= 'pg-class.oid 'attrelid)
  73                                                                           (:= 'pg-class.relname (to-identifier table)))
  74                                :inner-join 'pg-catalog.pg-namespace :on (:= 'pg-namespace.oid 'pg-class.relnamespace)
  75                                :where (:and (:> 'attnum 0) (:raw schema-test)))
  76                               'attnum)))))
  77
  78 (defun coalesce (&rest args)
  79   (some (lambda (x) (if (eq x :null) nil x)) args))