/src/lobos/schema.clj
Clojure | 760 lines | 570 code | 120 blank | 70 comment | 21 complexity | bae4503939b00068f742e03917ebffed MD5 | raw file
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.schema 10 "This namespace include the abstract schema data-structures, an 11 handful of helpers to create them and the protocol to build the into 12 an abstract syntax tree of implementation agnostic SQL 13 statements. Abstract schema data-structures can be divided in two 14 categories. 15 16 First, schema elements which include the `schema` and the `table` 17 element definitions. Those can be created or dropped, also the `table` 18 element can be altered. 19 20 Then there's the table elements that serves to define tables. There's 21 the completly abstract `column` and `constraint` elements, which are 22 only meant to be used directly with the alter action. Each of them 23 have more specialized function to help you define tables, like the 24 `unique`, `primary-key`, `foreign-key` and `check` constraints 25 definitons and the typed data definitions." 26 (:refer-clojure :exclude [defonce replace 27 bigint boolean char double float time]) 28 (:require (lobos [ast :as ast])) 29 (:use (clojure [walk :only [postwalk]] 30 [set :only [union]] 31 [string :only [replace]]) 32 lobos.utils)) 33 34(ast/import-all) 35 36;; ----------------------------------------------------------------------------- 37 38;; ## Protocols 39 40(defprotocol Alterable 41 "The Alterable protocol add the possibility of building alter 42 statements from an object implementing it. *For internal use*." 43 (build-alter-statement [this action db-spec])) 44 45(defprotocol Buildable 46 "The Buildable protocol is currently used only by table elements. 47 *For internal use*." 48 (build-definition [this db-spec])) 49 50(defprotocol Creatable 51 "The Creatable protocol add the possibility of building create 52 statements from an object implementing it. *For internal use*." 53 (build-create-statement [this db-spec])) 54 55(defprotocol Dropable 56 "The Dropable protocol add the possibility of building drop 57 statements from an object implementing it. *For internal use*." 58 (build-drop-statement [this behavior db-spec])) 59 60;; ----------------------------------------------------------------------------- 61 62;; ## Common Exception 63 64(defn name-required 65 "Throws an IllegalArgumentException when the given name is nil with a 66 default message using the given type of elements." 67 [name etype] 68 (when-not name 69 (throw (IllegalArgumentException. 70 (format "A %s definition needs at least a name." 71 etype))))) 72 73;; ----------------------------------------------------------------------------- 74 75;; ## Definition Predicate 76 77(defn definition? 78 "Returns true if the given object is an abstract schema element 79 definition. *For internal use*." 80 [o] 81 (isa? (type o) ::definition)) 82 83;; ----------------------------------------------------------------------------- 84 85;; ## Expression Definitions 86 87(def ^{:doc "A set of symbol representing SQL infix operators."} 88 sql-infix-operators 89 '#{;; math operators 90 + - * / 91 ;; boolean operators 92 < > <= >= = != or and in like}) 93 94(def ^{:doc "A set of symbol representing SQL prefix operators."} 95 sql-prefix-operators 96 '#{not}) 97 98(def ^{:doc "A set of symbol representing SQL functions."} 99 sql-functions 100 '#{;; string functions 101 length lower position replace str subs trim upper 102 ;; numeric functions 103 abs ceil floor mod 104 ;; datetime functions 105 extract now current_date current_time current_timestamp}) 106 107(def sql-symbols 108 (union sql-infix-operators 109 sql-prefix-operators 110 sql-functions)) 111 112(defrecord Expression [value] 113 Buildable 114 115 (build-definition [this db-spec] 116 (postwalk 117 #(do 118 (cond (vector? %) 119 (let [[f & n] %] 120 (if (keyword? f) 121 (condp contains? (-> f name symbol) 122 sql-infix-operators 123 (OperatorExpression. db-spec f (first n) (next n)) 124 sql-prefix-operators 125 (OperatorExpression. db-spec f nil n) 126 sql-functions 127 (FunctionExpression. db-spec f n)) 128 %)) 129 (and (keyword? %) 130 (not (contains? sql-symbols (-> % name symbol)))) 131 (IdentifierExpression. db-spec % nil) 132 (not (keyword? %)) 133 (ScalarExpression. db-spec %) 134 :else %)) 135 value))) 136 137(defn expression? 138 "Returns true if the given object is an Expression." 139 [o] 140 (instance? Expression o)) 141 142(defmacro expression [form] 143 `(Expression. 144 ~(postwalk 145 #(if (and (seq? %) 146 (sql-symbols (first %))) 147 (apply vector 148 (keyword (first %)) 149 (rest %)) 150 %) 151 form))) 152 153;; ----------------------------------------------------------------------------- 154 155;; ## Index Definitions 156 157(defrecord Index [iname tname columns options] 158 Creatable Dropable 159 160 (build-create-statement [this db-spec] 161 (CreateIndexStatement. db-spec iname tname columns options)) 162 163 (build-drop-statement [this behavior db-spec] 164 (DropStatement. db-spec :index iname nil {:tname tname}))) 165 166(defn index? 167 "Returns true if the given object is an Index." 168 [o] 169 (instance? Index o)) 170 171(defn index 172 "Constructs an index on the specified table and columns. Can take an 173 optional index name and a set of options of which only :unique is 174 available for now. This can be used inside or outside a table 175 definition, in the later case you just have to provide the name of the 176 table as a keyword." 177 {:arglists '([table name? columns & options])} 178 [table & args] 179 (let [tname (if (keyword? table) table (:name table)) 180 [name args] (optional keyword? args) 181 [columns & options] args 182 name (or name (make-index-name tname 183 (or ((set options) :unique) 184 :index) 185 columns))] 186 (if (keyword? table) 187 (Index. name tname columns options) 188 (update-in table [:indexes] conj 189 [name (Index. name tname columns options)])))) 190 191;; ----------------------------------------------------------------------------- 192 193;; ## Constraint Definitions 194 195;; `Constraint` records are only used to define unspecified constraint. 196;; These type of constraints are useful with the alter drop action. They 197;; can be be construct using the `constraint` function. 198;; *For internal use*. 199(defrecord Constraint [cname] 200 Buildable 201 202 (build-definition [this db-spec] 203 (ConstraintDefinition. db-spec cname))) 204 205(defn constraint? 206 "Returns true if the given object is a Constraint." 207 [o] 208 (instance? Constraint o)) 209 210(defn constraint 211 "Constructs an unspecified abstract constraint definition and add it 212 to the given table. To be used with alter action while dropping a 213 constraint." 214 [table name] 215 (update-in table [:constraints] conj 216 [name (Constraint. name)])) 217 218;; `UniqueConstraint` records can be constructed using the `primary-key` or 219;; `unique` functions. It can represent either a unique or primary key 220;; constraint. *For internal use*. 221(defrecord UniqueConstraint [cname ctype columns] 222 Buildable 223 224 (build-definition [this db-spec] 225 (UniqueConstraintDefinition. 226 db-spec 227 cname 228 ctype 229 columns))) 230 231(defn unique-constraint 232 "Constructs an abstract unique (or primary-key depending on the given 233 type) constraint definition and add it to the given table." 234 [table name type column-names] 235 (let [name (or name (make-index-name table type column-names))] 236 (update-in table [:constraints] conj 237 [name (UniqueConstraint. name type (vec column-names))]))) 238 239(defn primary-key 240 "Constructs an abstract primary key constraint definition and add it 241 to the given table. If the name isn't specified, this constraint will 242 be named using its specification." 243 ([table column-names] (primary-key table nil column-names)) 244 ([table name column-names] 245 (unique-constraint table name :primary-key column-names))) 246 247(defn unique 248 "Constructs an abstract unique constraint definition and add it to the 249 given table. If the name isn't specified, this constraint will 250 be named using its specification." 251 ([table column-names] (unique table nil column-names)) 252 ([table name column-names] 253 (unique-constraint table name :unique column-names))) 254 255;; `ForeignKeyConstraint` record can be constructed using the 256;; `foreign-key` function. *For internal use*. 257(defrecord ForeignKeyConstraint 258 [cname columns parent-table parent-columns match triggered-actions] 259 Buildable 260 261 (build-definition [this db-spec] 262 (ForeignKeyConstraintDefinition. 263 db-spec 264 cname 265 columns 266 parent-table 267 parent-columns 268 match 269 triggered-actions))) 270 271(defn foreign-key 272 "Constructs an abstract foreign key constraint definition and add it 273 to the given table. The `columns` and `parent-table` arguments must be 274 specified. If no `parent-columns` are specified, the `columns` will be 275 used in its place. 276 277 The `match` optional argument can be one of `:full`, `:partial` or 278 `:simple`, but note that this isn't supported by most databases. 279 280 You can specify `triggered-actions` with pairs of keyword, the first 281 of the pairs must be one of `:on-delete` or `:on-update`, while the 282 second one can be one of `:cascade`, `:set-null`, `:restrict`, 283 `:set-default` or `:no-action`. The actions keywords are directly 284 translated to SQL keywords, so you can specify custom ones if the 285 database you're using provide more. 286 287 If the name isn't specified, this constraint will be named 288 using its specification." 289 {:arglists '([table name? column-names parent-table 290 parent-column-names? match? & triggered-actions])} 291 [table & args] 292 (let [[constraint-name args] (optional keyword? args) 293 columns (first args) 294 parent-table (second args) 295 args (nnext args) 296 [parent-columns args] (optional vector? args) 297 parent-columns (or parent-columns columns) 298 [match args] (optional #{:full :partial :simple} args) 299 triggered-actions (apply hash-map args) 300 constraint-name (or constraint-name 301 (make-index-name table "fkey" columns))] 302 (update-in table [:constraints] conj 303 [constraint-name 304 (ForeignKeyConstraint. constraint-name 305 columns 306 parent-table 307 parent-columns 308 match 309 triggered-actions)]))) 310 311;; `CheckConstraint` record can be constructed using the 312;; `check` macro or the `chech*` function. *For internal use*. 313(defrecord CheckConstraint 314 [cname condition] 315 Buildable 316 317 (build-definition [this db-spec] 318 (CheckConstraintDefinition. 319 db-spec 320 cname 321 (build-definition condition db-spec)))) 322 323(defn check* 324 "Constructs an abstract check constraint definition and add it to the 325 given table. The `constraint-name` argument is mandatory." 326 [table constraint-name condition] 327 (name-required constraint-name "check constraint") 328 (update-in table [:constraints] conj 329 [constraint-name 330 (CheckConstraint. constraint-name 331 condition)])) 332 333(defmacro check 334 "Constructs an abstract check constraint definition and add it to the 335 given table." 336 [table constraint-name condition] 337 `(check* 338 ~table 339 ~constraint-name 340 (expression ~condition))) 341 342;; ----------------------------------------------------------------------------- 343 344;; ## Data-type Definition 345 346;; `DataType` records can be constructed using the `data-type` function. 347;; *For internal use*. 348(defrecord DataType [name args options]) 349 350(defn data-type? 351 "Returns true if the given object is a DataType." 352 [o] 353 (instance? DataType o)) 354 355(defn data-type 356 "Constructs an abstract data-type definition using the given keyword 357 `name`. Can also take an options list of arguments (`args`) and 358 `options`." 359 [name & [args options]] 360 (check-valid-options options :encoding :collate :time-zone) 361 (update-options 362 (DataType. name (vec args) {}) 363 options)) 364 365;; ----------------------------------------------------------------------------- 366 367;; ## Column Definition 368 369(defn datetime-now-alias 370 "If the given default value, it will be replaced by the standard 371 function returning the current time, date or timestamp depending on 372 the specified data-type. *For internal use*." 373 [name default] 374 (let [value (:value default)] 375 (if (= value [:now]) 376 (Expression. 377 (or ({:date [:current_date] 378 :time [:current_time] 379 :timestamp [:current_timestamp]} name) value)) 380 default))) 381 382;; `Column` records can be constructed using the `column` function or 383;; the more specific typed column functions. The `build-definition` 384;; method will create the appropriate `DataTypeClause` for data-type 385;; definitions and `*Expression` AST for default values. 386;; *For internal use*. 387(defrecord Column [cname data-type default auto-inc not-null others] 388 Buildable 389 390 (build-definition [this db-spec] 391 (let [{:keys [name args options]} data-type] 392 (ColumnDefinition. 393 db-spec 394 cname 395 (when data-type 396 (DataTypeClause. db-spec name args options)) 397 (if (= default :drop) 398 :drop 399 (when default 400 (build-definition 401 (datetime-now-alias name default) 402 db-spec))) 403 (when auto-inc (AutoIncClause. db-spec)) 404 not-null 405 others)))) 406 407(defn column? 408 "Returns true if the given object is a Column." 409 [o] 410 (instance? Column o)) 411 412(defmacro default [form] 413 `[:default (expression ~form)]) 414 415(defn column* 416 "Constructs an abstract column definition. It'll parse the column 417 specific options. See the `column` function for more details. 418 *For internal use*." 419 [column-name data-type options] 420 (let [[map-entries others] (separate vector? (filter identity options)) 421 [kw-options others] (separate keyword? others) 422 {:keys [default encoding collate] :as option-map} 423 ;; HACK: trying to get refer option, but it's not a map entry and 424 ;; it's actually consumed by `column`, will clean up later. 425 (into {} (map (fn [[f & r]] [f (first r)]) map-entries)) 426 option-set (set kw-options) 427 data-type (update-options data-type 428 (assoc (select-keys option-map 429 [:encoding 430 :collate]) 431 :time-zone (option-set :time-zone))) 432 not-null (when (:null option-set) false) 433 not-null (if (and (nil? not-null) (:not-null option-set)) true not-null) 434 auto-inc (when (:auto-inc option-set) true)] 435 (name-required column-name "column") 436 (check-valid-options (into option-set (keys option-map)) 437 :null :not-null :auto-inc :default :primary-key :unique 438 :encoding :collate :time-zone :refer) 439 (Column. column-name 440 data-type 441 default 442 auto-inc 443 not-null 444 others))) 445 446(defn column 447 "Constructs an abstract column definition and add it to the given 448 table. Also creates and add the appropriate column constraints when 449 these are specified as options. Here's a list of available options: 450 451 * `:unique` which construct an unique constraint on that column 452 * `:primary-key` which make the current column the primary key 453 * `[:refer tname & options]` which add a foreign key constraint to 454 the specified table. The options are the same as the `foreign-key` 455 function with the exception that you can specify only one parent 456 column. 457 * `:null` allow null values 458 * `:not-null` prevents this column from being null 459 * `:auto-inc` (for integers types) which makes it auto-populated with 460 incremented integers 461 * `[:encoding enc]` (for character types) determines which encoding to 462 use if supported by the database. Also see the natianal character types. 463 * `[:collate type]` (for character types) determines how equality is 464 handled 465 * `:time-zone` (for time types) determines if the type includes a time-zone 466 467 It also can be used in alter modify and rename actions. In that 468 case, if data-type is :to, it acts as a column rename clause and if 469 data-type is :drop-default, it acts as a column drop default clause." 470 {:arglists '([table column-name data-type? & options])} 471 [table column-name & options] 472 (let [[data-type options] (optional #(instance? DataType %) options) 473 reference? #(and (vector? %) (= (first %) :refer)) 474 [ptable pcol & others] (->> options (filter reference?) first next) 475 options (filter (comp not reference?) options) 476 option-set (when (seq? options) (set options)) 477 add-constraint #(cond (:primary-key option-set) 478 (primary-key % [column-name]) 479 (:unique option-set) 480 (unique % [column-name]) 481 ptable 482 (apply foreign-key % [column-name] ptable 483 (when pcol [pcol]) others) 484 :else %)] 485 (add-constraint 486 (update-in table [:columns] conj 487 [column-name 488 (case (first options) 489 :to (Column. column-name nil nil nil nil (second options)) 490 :drop-default (Column. column-name nil :drop nil nil []) 491 (column* column-name data-type options))])))) 492 493;; ----------------------------------------------------------------------------- 494 495;; ## Typed Column Definitions 496 497;; Instead of calling the `column` option directly and including the 498;; data-type argument, you can use typed column definition in which case 499;; each types have their own functions. 500 501;; ### Typed Column Helpers 502 503(defn def-typed-columns* 504 "Helper for macros that create typed columns definitions. It takes a 505 sequence of names and define a function for each of them, a vector of 506 arguments for those functions, `dargs` must specify how to handle 507 these arguement and `options` must specify the generic column options. 508 The optional `docs` arguement is appended to the generic docstring. 509 *For internal use*." 510 [names args dargs options & [docs]] 511 `(do 512 ~@(for [n names] 513 `(defn ~n 514 ~(format (str "Constructs an abstract %s column definition and" 515 " add it to the given table." docs) 516 (name n)) 517 ~args 518 (let [dargs# ~dargs 519 options# ~options] 520 (apply column 521 ~'table 522 ~'column-name 523 (data-type ~(keyword n) dargs#) 524 options#)))))) 525 526(defmacro def-simple-typed-columns 527 "Defines typed columns for simple data-types taking no arguments. 528 *For internal use*." 529 [& names] 530 (def-typed-columns* 531 names 532 '[table column-name & options] 533 '[] 534 'options)) 535 536(defmacro def-numeric-like-typed-columns 537 "Defines numeric-like typed columns. These typed column funcitons can 538 take an optional `precision` and `scale` argument. *For internal use*." 539 [& names] 540 (def-typed-columns* 541 names 542 '[table column-name & [precision scale & options]] 543 '(-> [] 544 (conj-when (integer? precision) precision) 545 (conj-when (integer? scale) scale)) 546 '(-> options 547 (conj-when (not (integer? precision)) precision) 548 (conj-when (not (integer? scale)) scale)) 549 " Takes an optional `precision` and `scale` arguments.")) 550 551(defmacro def-optional-precision-typed-columns 552 "Defines typed columns with optional precision. Used by `float` and 553 time data-types. *For internal use*." 554 [& names] 555 (def-typed-columns* 556 names 557 '[table column-name & [precision & options]] 558 '(conj-when [] (integer? precision) precision) 559 '(conj-when options (not (integer? precision)) precision) 560 " Takes an optional `precision` argument.")) 561 562(defmacro def-optional-length-typed-columns 563 "Defines optionally length-bounded typed columns. Used by binary and 564 character types. *For internal use*." 565 [& names] 566 (def-typed-columns* 567 names 568 '[table column-name & [length & options]] 569 '(conj-when [] (integer? length) length) 570 '(conj-when options (not (integer? length)) length) 571 " Takes an optional `length` argument.")) 572 573(defmacro def-length-bounded-typed-columns 574 "Defines length-bounded typed columns. Used by variable binary and 575 character types. *For internal use*." 576 [& names] 577 (def-typed-columns* 578 names 579 '[table column-name length & options] 580 '(conj-when [] (integer? length) length) 581 '(conj-when options (not (integer? length)) length) 582 " The `length` arguemnt is mandatory.")) 583 584;; ### Numeric Types 585 586(def-simple-typed-columns 587 smallint 588 integer 589 bigint) 590 591(def-numeric-like-typed-columns 592 numeric 593 decimal) 594 595(def-simple-typed-columns 596 real 597 double-precision) 598 599(def double double-precision) 600 601(def-optional-precision-typed-columns 602 float) 603 604;; ### Character Types 605 606(def-optional-length-typed-columns 607 char 608 nchar 609 clob 610 nclob) 611 612(def text clob) 613 614(def ntext nclob) 615 616(def-length-bounded-typed-columns 617 varchar 618 nvarchar) 619 620;; ### Binary Types 621 622(def-optional-length-typed-columns 623 binary 624 blob) 625 626(def-length-bounded-typed-columns 627 varbinary) 628 629;; ### Boolean Type 630 631(def-simple-typed-columns 632 boolean) 633 634;; ### Data/time Types 635 636(def-simple-typed-columns 637 date) 638 639(def-optional-precision-typed-columns 640 time 641 timestamp) 642 643;; ----------------------------------------------------------------------------- 644 645;; ## Table Definition 646 647(defn- build-table-elements [db-spec method & elements] 648 (->> (apply concat elements) 649 (map #(when (second %) 650 (method (second %) db-spec))) 651 (filter identity))) 652 653;; `Table` records can be constructed using the `table*` function or 654;; the `table` macro. *For internal use*. 655(defrecord Table [name columns constraints indexes] 656 Alterable Creatable Dropable 657 658 (build-alter-statement [this action db-spec] 659 (let [elements (build-table-elements db-spec 660 build-definition 661 columns 662 constraints)] 663 (for [element elements] 664 (AlterTableStatement. 665 db-spec 666 name 667 action 668 element)))) 669 670 (build-create-statement [this db-spec] 671 (conj 672 (build-table-elements db-spec build-create-statement indexes) 673 (CreateTableStatement. 674 db-spec 675 name 676 (build-table-elements db-spec build-definition columns constraints)))) 677 678 (build-drop-statement [this behavior db-spec] 679 (DropStatement. db-spec :table name behavior nil))) 680 681(defn table? 682 "Returns true if the given object is a Table." 683 [o] 684 (instance? Table o)) 685 686(defn table* 687 "Constructs an abstract table definition. The `table-name` is 688 mandatory." 689 [name & [columns constraints indexes]] 690 (name-required name "table") 691 (Table. name 692 (or columns {}) 693 (or constraints {}) 694 (or indexes {}))) 695 696(defmacro table 697 "Constructs an abstract table definition containing the given 698 elements." 699 [name & elements] 700 `(-> (table* ~name) ~@(reverse elements))) 701 702;; ----------------------------------------------------------------------------- 703 704;; ## Schema Definition 705 706;; `Schema` records can be constructed using the `schema` function. 707;; *For internal use*. 708(defrecord Schema [sname tables indexes options] 709 Creatable Dropable 710 711 (build-create-statement [this db-spec] 712 (CreateSchemaStatement. 713 db-spec 714 sname 715 (flatten 716 (map #(build-create-statement (second %) db-spec) 717 (concat tables indexes))))) 718 719 (build-drop-statement [this behavior db-spec] 720 (DropStatement. db-spec :schema sname behavior nil))) 721 722(defn schema? 723 "Returns true if the given object is a Schema." 724 [o] 725 (instance? Schema o)) 726 727(defn- filtered-elements->map 728 [pred elements] 729 (into (sorted-map) 730 (map #(vector (:name %) %) 731 (filter pred elements)))) 732 733(defn schema 734 "Constructs an abstract schema definition." 735 {:arglists '([schema-name options? & elements])} 736 [schema-name & args] 737 (name-required schema-name "schema") 738 (let [[options elements] (optional (comp not definition?) args)] 739 (Schema. 740 schema-name 741 (filtered-elements->map table? elements) 742 (filtered-elements->map index? elements) 743 (or options {})))) 744 745;; ----------------------------------------------------------------------------- 746 747;; ## Definitions Hierarchy 748 749;; The definition hierarchy makes it easy to test if an object represent 750;; an abstract schema element definition. See the `definition?` 751;; predicate. 752(derive Index ::definition) 753(derive Constraint ::definition) 754(derive UniqueConstraint ::definition) 755(derive ForeignKeyConstraint ::definition) 756(derive CheckConstraint ::definition) 757(derive DataType ::definition) 758(derive Column ::definition) 759(derive Table ::definition) 760(derive Schema ::definition)