/src/lobos/core.clj

  1; Copyright (c) Nicolas Buduroi. All rights reserved.
  2; The use and distribution terms for this software are covered by the
  3; Eclipse Public License 1.0 which can be found in the file
  4; epl-v10.html at the root of this distribution. By using this software
  5; in any fashion, you are agreeing to be bound by the terms of this
  6; license.
  7; You must not remove this notice, or any other, from this software.
  8
  9(ns lobos.core
 10  "The `core` namespace provide the basic interface to interact with a
 11  database. It contains a set of functions and *actions* (a special kind
 12  of functions acting on abstract schemas or their elements) used to
 13  manipulate database schemas in an implementation agnostic way.
 14
 15  To find out more about **Lobos**, check out:
 16
 17   * [Lobos website](http://budu.github.com/lobos/)
 18   * [Lobos repo](https://github.com/budu/lobos)
 19   * [Lobos wiki](https://github.com/budu/lobos/wiki)"
 20  {:author "Nicolas Buduroi"}
 21  (:refer-clojure :exclude [alter defonce drop])
 22  (:require (lobos [compiler :as compiler]
 23                   [connectivity :as conn]
 24                   [migration :as mig]
 25                   [schema :as schema]))
 26  (:use (clojure.tools [macro :only [name-with-attributes]])
 27        (clojure [pprint :only [pprint]])
 28        lobos.internal
 29        lobos.utils))
 30
 31;; -----------------------------------------------------------------------------
 32
 33;; ## Helpers
 34
 35(defmacro without-migration [& body]
 36  `(binding [mig/*record* nil]
 37     ~@body))
 38
 39;; -----------------------------------------------------------------------------
 40
 41;; ## Debugging Interface
 42
 43(defn set-debug-level
 44  "Set the current debugging level. The level argument can be one of
 45  `:schema`, `:ast` or `:sql`. Currently only `:sql` is supported for
 46  all actions. e.g.:
 47
 48    user> (set-debug-level :sql)"
 49  [level]
 50  (swap! debug-level (constantly level)))
 51
 52(defn debug
 53  "Prints useful information on the given combination protocol method
 54  and schema (or elements). For the available methods, see the
 55  `lobos.schema` namespace. For methods taking extra argument use the
 56  optional `args` argument, which takes a sequence. You can also supply
 57  a `level` and `connection-info` argument. Use the default connection
 58  and the `:sql` level when not specified.  *For debugging purpose*. e.g.:
 59
 60    user> (debug build-create-statement
 61                 (sample-schema))"
 62  [method object-or-fn & [args level connection-info]]
 63  (let [level (or level @debug-level :sql)
 64        object (if (fn? object-or-fn)
 65                 (object-or-fn)
 66                 object-or-fn)
 67        db-spec (conn/get-db-spec connection-info)
 68        ast (when-not (= :schema level)
 69              (apply method object (conj args db-spec)))]
 70    (case level
 71      :sql (doseq [ast-element ast]
 72             (pprint (compiler/compile ast-element)))
 73      :ast (do (println (type ast))
 74               ;; TODO: walk to remove db-spec
 75               (pprint ast))
 76      :schema (do (println (type object))
 77                  (pprint object)))))
 78
 79;; -----------------------------------------------------------------------------
 80
 81;; ## Lobos Action
 82
 83;; ### Action Macro
 84
 85(defmacro defaction
 86  "Defines an action applicable to an optional abstract schema or
 87  database connection. *Actions* are simply a special kind of
 88  functions. They will have an augmented argument list, which is the
 89  given one prepended by the optional `cnx-or-schema` argument.
 90
 91  All actions must return a built statement (or list of statements)
 92  using one of the protocol method available.
 93
 94  The defined actions will have access to two extra local variables. The
 95  `schema` variable will contain the given schema if `cnx-or-schema` is
 96  one else it be nil. The `db-spec` argument will contain the db-spec
 97  map found with the given connection or in the given schema. *For
 98  internal use*."
 99  {:arglists '([name doc-string? attr-map? [params*] & body])}
100  [name & args]
101  (let [params (seq (first (filter vector? args)))
102        name* (symbol (str name \*))
103        [name args] (name-with-attributes name args)
104        [params* & body] args]
105    `(do
106       (defn ~name* [self# & params#]
107         (let [[~'db-spec ~'schema ~params*]
108               (optional-cnx-or-schema params#)]
109           (execute
110            (do ~@body)
111            ~'db-spec)
112           (mig/record self#)))
113       (defmacro ~name [~'& args#]
114         `(~~name* (quote ~~'&form) ~@args#))
115       (.setMeta #'~name
116                 (merge (.meta #'~name)
117                        {:arglists '(~(vec (conj params 'cnx-or-schema?)))})))))
118
119;; ### Actions
120
121(defaction create
122  "Builds a create statement with the given schema element and execute
123  it. See the `lobos.schema` namespace for more details on schema
124  elements definition. e.g.:
125
126    user> (create (table :foo (integer :a)))"
127  [element]
128  (schema/build-create-statement (or element schema) db-spec))
129
130(defaction alter
131  "Builds an alter statement with the given schema element and execute
132  it. There's four types of alter actions: `:add`, `:drop`, `:modify`
133  and `:rename`. See the `lobos.schema` namespace for more details on
134  schema elements definition. e.g.:
135
136    user> (alter :add (table :foo (integer :a)))
137    user> (alter :modify (table :foo (column :a [:default 0])))
138    user> (alter :rename (table :foo (column :a :to :b)))"
139  [action element]
140  (check-valid-options action :add :drop :modify :rename)
141  (schema/build-alter-statement element action db-spec))
142
143(defaction drop
144  "Builds a drop statement with the given schema element and execute
145  it. It can take an optional `behavior` argument, when `:cascade` is
146  specified drops all elements relying on the one being dropped. e.g.:
147
148    user> (drop (table :foo) :cascade)"
149  [element & [behavior]]
150  (schema/build-drop-statement element behavior db-spec))
151
152(defaction exec
153  "Execute the given statements as an action."
154  [& statements]
155  statements)
156
157;; -----------------------------------------------------------------------------
158
159;; ## Lobos Migration
160
161;; ### Migration Command Macro
162
163(defmacro defcommand
164  [name & args]
165  (let [params (seq (first (filter vector? args)))
166        [name args] (name-with-attributes name args)
167        [params* & body] args]
168    `(do
169       (defn ~name [& params#]
170         (require mig/*migrations-namespace*)
171         (let [[~'db-spec ~'sname ~params*]
172               (optional-cnx-and-sname params#)]
173           (mig/create-migrations-table ~'db-spec ~'sname)
174           ~@body))
175       (.setMeta #'~name
176                 (merge (.meta #'~name)
177                        {:arglists
178                         '(~(vec (conj params
179                                       'sname?
180                                       'cnx-or-schema?)))})))))
181
182;; ### Migration Commands
183
184(defn print-stash []
185  (when (.exists mig/*stash-file*)
186    (print (slurp mig/*stash-file*))))
187
188(defcommand print-done []
189  (doseq [name (mig/query-migrations-table db-spec sname)]
190    (println name)))
191
192(defcommand print-pending []
193  (doseq [name (mig/pending-migrations db-spec sname)]
194    (println name)))
195
196(defcommand migrate [& names]
197  (let [names (if (empty? names)
198                (mig/pending-migrations db-spec sname)
199                names)]
200    (mig/do-migrations db-spec sname :up names)))
201
202(defcommand rollback [& args]
203  (let [names (cond
204               (empty? args)
205               [(last (mig/query-migrations-table db-spec sname))]
206               (= 1 (count args))
207               (let [arg (first args)
208                     migs (mig/query-migrations-table db-spec sname)]
209                 (cond
210                  (integer? arg) (take arg (reverse migs))
211                  (= arg :all) migs
212                  :else args))
213               :else args)]
214    (mig/do-migrations db-spec sname :down names)))
215
216(defcommand reset [& args]
217  (apply rollback args)
218  (migrate))
219
220(defcommand generate-migration [name & [msg]]
221  (let [name (symbol (if (string? name)
222                       name
223                       (clojure.core/name name)))]
224    (when-not name
225      (throw (IllegalArgumentException.
226              "Migration must be named.")))
227    (when ((set (mig/list-migrations-names)) (str name))
228      (throw (IllegalArgumentException.
229              "Migration name is already taken.")))
230    (mig/generate-migration* db-spec sname name msg
231                             (mig/read-stash-file))
232    (mig/clear-stash-file)))