SQLRat / src / main / clj / org / bituf / sqlrat / entity.clj

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
(ns org.bituf.sqlrat.entity
  "Support Data Types (defrecord) as database entities and provide functions to
  carry out database operations using the entities."
  (:use org.bituf.sqlrat.entity.internal)
  (:use org.bituf.sqlrat.util)
  (:use org.bituf.sqlrat.clause)
  (:use [clojure.contrib.sql :as sql :only ()])
  (:import [clojure.lang IFn Keyword IPersistentMap IPersistentVector]))


; ===== Utility functions and macros =====

(defn- as-vector*
  "Convert anything to a vector."
  [x]
  (if *assert-args* (do (assert (vector? x)) x)
    (as-vector x)))


(defmacro in-db
  "Create the context for executing database operations inside the macro body.
  It provides with a database connection, which is automatically closed once
  the body is executed completely. You must not return a lazy sequence that
  tries to access the database *after* the body is executed.
  Example: See the 'db-query' function
  See also: in-txn"
  [db & body]
  `(sql/with-connection ~db
    ~@body))


(defmacro in-txn
  "Same as 'in-db' macro, but it creates a transaction in which the database
  operations can take place. You should use this for executing write-operations
  in transactions.
  Example: See the 'save-row' function
  See also: in-db"
  [db & body]
  `(sql/with-connection ~db
    (sql/transaction
      ~@body)))


(defn db-query
  "Fetch rows from database. Execute this with 'in-db' or 'in-txn'. When the
  first argument is not a function (f) it simply collects the rows into a
  vector an returns it - amount of memory consumed varies with the row count.
  Arguments:
    f     Is called with 'rows' as the only argument for processing them. It
          must not return a lazy sequence that tries to access the database
          *after* the 'db-query' function is executed.
    query A vector containing the SQL in clojure.contrib.sql format. Examples
          are: [\"SELECT * FROM emp\"] and [\"SELECT * FROM emp WHERE id=?\" 56]
  Example:
    user=> (in-db mysql
             (db-query (fn [rows] (count rows))
               [\"SELECT * FROM emp WHERE id=?\" 56]))
    135 ;; returns the row-count
    user=> (in-db mysql
             (db-query [\"SELECT * FROM emp WHERE id=?\" 56]))
    [{<row1 data>} {<row2 data>} ...] ;; returns the rows as a vector
  See also: with-db-query-results"
  ([f query]
    (if *assert-args* (do
                        (assert (fn? f))
                        (assert (vector? query))))
    (if *show-sql* (mypp "Executing SQL..." query))
    (sql/with-query-results rows query
      (f rows)))
  ([query]
    (let [f (fn [rows]
              (let [result (if (nil? rows) nil (into [] rows))]
                (if *show-sql-results* (mypp "SQL Result..." rows))
                rows))]
      (db-query f query))))


(defmacro with-db-query-results
  "Wrapper macro for 'db-query'.
  Arguments:
    rows  Is bound to the rows fetched as a result of running the query
    query The SQL query as described in 'db-query' function
  Example:
    user=> (in-db mysql
             (with-db-query-results rows [\"SELECT * FROM emp\"]
               (println rows)))
    <rows-data>
  See also: db-query"
  [rows sql-params & body]
  `(db-query (fn [~rows] ~@body) ~sql-params))


;(defn save-row
;  "Save given row. Table should be specified as :tablename (keyword).
;  Row is simply a map of :columnName to value. Execute with in-txn or in-db."
;  [^Keyword table ^Map row ^Keyword id-column]
;  (let [id=? (str (name id-column) "=?")]
;    (sql/update-or-insert-values
;        table
;        [id=? (id-column row)]
;        row)))

(defn save-row
  "Save given row. Table should be specified as :tablename (keyword).
  Row is simply a map of :columnName to value. Execute with in-txn or in-db.
  Returns the saved row, which may have generated ID (if applicable).
  Arguments:
    table     The database table name (keyword)
    row       The row (map of column-name to column-value) to be saved
    id-column The primary ID column (keyword)
  Examples:
    user=> (in-txn mysql
             (save-row :emp {:code 9008 :name \"Joe Walker\"} :empid))
    {:empid 197 :code 9008 :name \"Joe Walker\"} ;; 197 is the generated ID
    user=> (in-txn mysql
             (save-row :emp {:empid 197 :code 9667 :name \"Joe Hacker\"} :empid))
    {:empid 197 :code 1337 :name \"Joe Hacker\"} ;; updated code and name
  See also: save"
  [table row id-column]
  (let [id=? (str (name id-column) "=?")]
    (let [result (update-or-insert-values-returnid
                   table [id=? (id-column row)] row)]
      (let [generated-key (:generated_key (first result))]
        (if (nil? generated-key) row
          (assoc row id-column generated-key))))))


;;; ===== Entity relationships =====

;; relation of this table with another table
(defrecord RelationMetadata
  [this-column   ; (keyword) column in this entity
   that-entity   ; EntityMetadata instance for the other entity
   that-column   ; (keyword) column name in that entity
   that-depends? ; whether the other entity depends on "this"
   ] )


(defprotocol Relation
  (rel-meta [this] "Return a sequence of Relation objects"))


(defn relation
  "Factory function for creating a RelationMetadata instance. A relation is
  defined between 'this' and 'that' entities. RelationMetadata is associated
  with a certain 'this' entity, hence you need not specify 'this' entity.
  Arguments:
    this-col      (Keyword) The column in 'this' entity
    that-ent      (EntityMetadata) The other entity
    that-col      (Keyword) The column in 'that' entity
    that-depends? (Boolean, optional, default false) Whether 'that' entity
                  logically depends on 'this' entity
  Example:
    (relation :orderid item-metadata :itemid true) ;; order to item relation
  See also: one-to-many, many-to-one, one-to-one, one-to-one-depends"
  ([this-col that-ent-meta that-col that-depends?]
    (RelationMetadata. this-col that-ent-meta that-col that-depends?))
  ([this-col that-ent-meta that-col]
    (RelationMetadata. this-col that-ent-meta that-col false)))


(defn one-to-many
  "Create one-to-many relation metadata.
  Arguments: See 'relation' function
  Example:
    (one-to-many :orderid item-metadata :itemid)
  See also: relation, many-to-one"
  [this-col that-ent-meta that-col]
  (relation this-col that-ent-meta that-col true))


(defn many-to-one
  "Create many-to-one relation metadata.
  Arguments: See 'relation' function
  Example:
    (many-to-one :itemid order-metadata :orderid)
  See also: relation, one-to-many"
  [this-col that-ent-meta that-col]
  (relation this-col that-ent-meta that-col false))


(def ^{:doc "An alias to 'one-to-many' function"}
      one-to-one-depends one-to-many)


(def ^{:doc "An alias to 'many-to-one' function"}
      one-to-one         many-to-one)


(defn rel-impl
  "Return implementation for the Relation protocol.
  Arguments:
    rels-vector  (Vector) of relation specs
  Example: See extend-entity
  See also: relation, extend-entity"
  [rels-vector]
  {:rel-meta (fn [this] (as-vector rels-vector))} )


;;; ===== Entity definition =====

(defn to-row
  "Default implementation for to-row-fn."
  [entity]
  (into {} entity))


(defmacro from-row
  "Return a function that merges a value-map into a data type instance.
  Arguments:
    entity-creator  Body of code that creates/returns a data type instance
  Example:
    (from-row OrderItem.)
  See also: entity-meta"
  [& entity-creator]
  `#(~@entity-creator {} %))


(defrecord EntityMetadata
  [name ;; :entry (keyword) name of the entity
   id   ;; :autoid (keyword) name of the ID column
   from-row-fn] ;; factory fn: IN row, OUT entity
                ;; (from-row Entity.)
   ;;;
   ;; ##### Optional items with examples #####
   ;;
   ;; ===== columns definition (required for create-table):
   ;;
   ;; :cols  [[:autoid     :int "NOT NULL PRIMARY KEY AUTO_INCREMENT"]
   ;;         [:entryid    :int           "NOT NULL"]
   ;;         [:content    "varchar(500)" "NOT NULL"]
   ;;         [:whenposted "DATETIME"     "NOT NULL"]
   ;;         [:isdeleted  "BOOLEAN"      "NOT NULL DEFAULT false"]
   ;;         [:name       "varchar(30)"  "NOT NULL"]
   ;;         [:email      "varchar(50)"  "NOT NULL"]
   ;;         [:url        "varchar(100)"]]
   ;;
   ;; ===== to-row function to convert from entity to row
   ;;       (default implementation is used if not specified)
   ;;
   ;; :to-row-fn  to-row
   )


(defn entity-meta
  "Factory function to create entity metadata. Arguments 'from-row-fn' and
  'to-row-fn' let you abstract the row data away from the entity (useful when
  entities cover a different perspective than the rows, for example during
  Domain-driven design).
  Arguments:
    name        (Keyword) table name
    id-col      (Keyword) ID column
    from-row-fn (Function) that accepts a row (col-value map) as the only
                argument and converts it into an entity (data type instance).
  Optional arguments:
    :cols <v>      (Vector) of column specs. Each colum spec is a vector too.
                   This is required *only* for the 'create-table' function.
    :to-row-fn <v> (Function) that accepts entity (data type instance) as the
                   only argument and converts into a row (key-value map).
  Example:
    (defrecord BlogEntry [])
    (def blog-entry-meta
      (entity-meta :entry :autoid (from-row BlogEntry.)
        :cols [[:autoid     :int           \"NOT NULL PRIMARY KEY AUTO_INCREMENT\"]
               [:title      \"varchar(30)\"  \"NOT NULL\"]
               [:content    \"varchar(500)\" \"NOT NULL\"]
               [:whenposted \"DATETIME\"     \"NOT NULL\"]
               [:isdeleted  \"BOOLEAN\"      \"NOT NULL DEFAULT false\"]] ))
  See also: Functions take entity metadata as argument."
  [name id from-row-fn
   & {:keys [cols to-row-fn]
      :or   {to-row-fn to-row}}]
  (EntityMetadata. name id from-row-fn
    {} {:cols cols :to-row-fn to-row-fn}))


(defprotocol Entity ;; represents a database table row
  (get-meta [this] "Get entity metadata"))


(defn entity?
  "Tell whether specified object is an entity"
  [obj]
  (and
    (extends? Entity (type obj))
    (map? obj)))


(defn entity-impl
  "!Factory function! Create implementation for Entity protocol.
  Arguments:
    ent-metadata  (EntityMetadata) the Entity metadata
  Example:
    (entity-impl e-meta) ;; where e-meta is the entity metadata
  See also: entity-meta"
  [ent-metadata]
  {:get-meta (fn [this] ent-metadata)} )


(defn extend-entity
  "Associate an entity data type (hence all instances) with entity metadata and
  relation metadata. This function may typically be called only once after the
  entity data type is defined.
  Arguments:
    ent-type     (Class) The entity data type (not an instance)
    ent-metadata (EntityMetadata) Entity metadata
    rel-metadata (Vector) Relation metadata
  Example:
    (extend-entity BlogEntry blog-entry-meta
      [(one-to-many :autoid  entry-comment-meta :entryid)] )
  See also: entity-meta"
  ([ent-type ent-metadata]
    (extend ent-type
      Entity   (entity-impl ent-metadata)))
  ([ent-type ent-metadata rel-metadata]
    (extend ent-type
      Entity   (entity-impl ent-metadata)
      Relation (rel-impl    rel-metadata))))


(def ^{:doc "The * (all columns) specifier"}
      star-col "*")


(def ^{:doc "The count-column expression clause"}
      count-col "COUNT(*) AS sqlratcnt")


(defn read-count-col
  "Read the value of count-col from specified row or entity."
  [row-or-entity]
  (if *assert-args* (assert-arg #(or (nil? %) (map? %))
                      row-or-entity))
  (:sqlratcnt row-or-entity))


(defn read-first-count-col
  "Read the value of count-col from the first row/entity of a vector. Useful
  when the count-col is not grouped by some column and hence there is just one
  row in the result set."
  [row-vector]
  (if *assert-args* (assert-arg #(or (nil? %) (vector? %))
                      row-vector))
  (read-count-col (first row-vector)))


(defn get-id-column
  "Return ID column from entity"
  [entity]
  (if *assert-args* (assert-arg entity? entity))
  (:id (get-meta entity)))


(defn get-id-value
  "Return ID column value from entity"
  [entity]
  (if *assert-args* (assert-arg entity? entity))
  ((get-id-column entity) entity))


;;; ===== Functions to work on entity and entity metadata.
;;;       Execute these with in-db / in-txn

;; function that accepts the (rel-meta entity) and returns a map
;; {:that-entity-name each-rel}
(def
  ^{:doc
  "Accept relation metadata as the only argument and return a map of
  that-entity-name to each relation object. This is a memoized fn.
  Example:
    user=> (let [rels (rel-meta entity)]
             (dbrel-lookup-by-that-entity rels))
    {:that-entity-name1 rel-involving-that-entity1
     :that-entity-name2 rel-involving-that-entity2
     ...}"
  }
  dbrel-lookup-by-that-entity
  (memoize
    (fn [rels-vector]
      (let [rel-vector (as-vector rels-vector)
            that-map (transient {})]
        (doseq [each rel-vector]
          (assoc! that-map (:name (:that-entity each)) each))
        (persistent! that-map)))))


(defn create-table
  "Create table"
  [entity-meta]
  (if *assert-args* (assert-as entity-meta EntityMetadata))
  (let [table-name (:name entity-meta)
        cols-spec  (:cols entity-meta)]
    (apply sql/create-table table-name cols-spec)))


(defn drop-table
  "Drop table"
  [entity-meta]
  (if *assert-args* (assert-as entity-meta EntityMetadata))
  (sql/drop-table (:name entity-meta)))


(defn find-by-sql
  "Find entities with custom SQL/criteria (in the same format as required by
  clojure.contrib.sql). When you do not pass a function as the first argument
  it retrieves all rows from the result set and returns a vector of entities.
  Arguments:
    f       (Function) that accepts result entities as the only argument and
            must not return something that lazily processes the entities.
    sql-vec (Vector) SQL vector in the format [\"SELECT * FROM e WHERE id=?\" 5]
  Example:
    (in-db mysql
      (println
        (find-by-sql employee-meta [\"SELECT * FROM emp\"])))
  See also: with-find-by-sql-results"
  ([f entity-meta sql-vec]
    (if *assert-args* (do
                        (assert (fn? f))
                        (assert-as entity-meta EntityMetadata)))
    (let [sql-vector (as-vector sql-vec)]
      (with-db-query-results results sql-vector
        (f (map #((:from-row-fn entity-meta) %) results)))))
  ([entity-meta sql-vec]
    (let [f (fn [entities] (into [] entities))]
      (find-by-sql f entity-meta sql-vec))))


(defmacro with-find-by-sql-results
  "Wrapper macro for find-by-sql. You must not return something that processes
  the result lazily.
  Arguments:
    entities     (Symbol) that is bound to the entities returned by the query 
    entity-meta  Metadata for the entity type being fetched
    sql-vec      (Vector) the SQL expression
    body         Function body to work on the entities
  Example:
    (in-db mysql
      (with-find-by-sql-results es emp-meta [\"SELECT * FROM emp\"]
        (println es)))
  See also: find-by-sql"
  [entities entity-meta sql-vec & body]
  `(find-by-sql (fn [~entities] ~@body) ~entity-meta ~sql-vec))


(defn find-by-criteria
  "Find entities using :cols, :where, :groupby and :other attributes and return
  a lazy sequence. If the first argument is not a function, it builds entities
  from the entire result set and returns them in a vector.
  Arguments:
    f             (Function) receives lazy-seq of entities as the only argument
                  and must not return something that processes them lazily.
    entity-meta   Metadata for the entity type
  Optional arguments (Criteria):
    :cols    <v>  (Vector) of column names (or clauses)
    :where   <v>  (Clause)
    :groupby <v>  (Vector) of expressions to group by
    :other   <v>  (Clause)
  Examples:
    (in-db mysql
      (println
        (find-by-criteria emp-meta {:where [\"salary>?\" 10000]} )))
  Examples of optional args:
    :cols  [:title :content \"whenposted\"]
    :where [\"whenposted < ?\" (new java.util.Date)]
    | OR | :where (<? :whenposted (new java.util.Date)) ; clause
    :other [\"ORDER BY whenposted\"]
    | OR | :other (merge-key-clause :order-by (cscols [:whenposted])) ; clause
  See also: with-find-by-criteria-results"
  ([f entity-meta {:keys [cols where groupby other]
                   :or   {cols    [star-col]     ;; vector of col names
                          where   (empty-clause) ;; clause
                          groupby []             ;; vector of expressions
                          other   (empty-clause) ;; clause
                          }}]
    (if *assert-args* (do
                        (assert (fn? f))
                        (assert-as entity-meta EntityMetadata)
                        (assert-criteria {:cols cols       :where where
                                          :groupby groupby :other other})))
    (let [where-clause (as-clause where)
          other-clause (as-clause other)
          sql-vector   (SELECT (csnames cols)
                         (FROM     (csnames [(:name entity-meta)]))
                         (WHERE    where-clause)
                         (GROUP-BY (csnames groupby))
                         other-clause)]
      (find-by-sql (fn [entities] (f entities)) entity-meta sql-vector)))
  ([entity-meta criteria]
    (find-by-criteria as-vector entity-meta criteria))
  ([entity-meta]
    (find-by-criteria entity-meta {})))


(defmacro with-find-by-criteria-results
  "Wrapper macro for find-by-criteria. You must not return something that
  processes the result lazily.
  Arguments:
    entities     (Symbol) that is bound to the entities returned by the query 
    entity-meta  Metadata for the entity type being fetched
    criteria     (Map) of optional criteria arguments (see find-by-criteria fn)
    body         Function body to work on the entities
  Example:
    (in-db mysql
      (with-find-by-criteria-results es emp-meta {:cols [:name :code]
                                                  :where [\"salary>?\" 10000]}
        (println es)))
  See also: find-by-criteria"
  [entities entity-meta criteria & body]
  `(find-by-criteria (fn [~entities] ~@body) ~entity-meta ~criteria))


(defn find-by-id
  "Find an entity of given type using specified ID. You can also pass :cols,
  :where, :groupby and :other attributes as in 'find-by-criteria' function.
  Arguments:
    entity-meta  Metadata for the entity type
    criteria     (Map) Optional arguments as described in find-by-criteria
  Example:
    (in-db mysql
      (println (find-by-idemp-meta 1197)))
  See also: find-by-criteria"
  ([entity-meta id {:keys [cols where groupby other]
                    :or   {cols    [star-col]     ;; vector of col names
                           where   (empty-clause) ;; clause
                           groupby []             ;; vector of expressions
                           other   (empty-clause) ;; clause
                           }}]
    (if *assert-args* (do
                        (assert-as entity-meta EntityMetadata)
                        (assert (not (nil? id)))
                        (assert-criteria {:cols    cols    :where where
                                          :groupby groupby :other other})))
    (let [id-clause    (=? (:id entity-meta) id)
          where-clause (if (empty-clause? where) id-clause
                         (AND id-clause where))
          rows         (find-by-criteria entity-meta
                         {:cols    cols    :where   where-clause
                          :groupby groupby :other   other} )]
      (if (empty? rows) nil
        ((:from-row-fn entity-meta) (first rows)))))
  ([entity-meta id]
    (find-by-id entity-meta id {})))


(defn save
  "Save given entity
  Example:
    (in-txn mysql
      (let [e (Employee. {} {:name \"Billy Norman\" :code 5564})]
        (save e)))
  See also: find-by-id"
  [entity]
  (if *assert-args* (assert-arg entity? entity))
  (let [ent-meta (get-meta entity)
        from-row-fn (:from-row-fn ent-meta)]
    (from-row-fn
      (save-row
        (:name ent-meta) ((:to-row-fn ent-meta) entity) (:id ent-meta)))))


(defn delete
  "Delete entity. Variants:
  [entity-meta id] >> delete by ID
  [entity] >> delete given entity
  See also: find-by-id"
  ([entity-meta id]
    (if *assert-args* (assert-as entity-meta EntityMetadata))
    (sql/delete-rows (:name entity-meta)
      [(str (name (:id entity-meta)) "=?") id]))
  ([entity]
    (if *assert-args* (assert-arg entity? entity))
    (delete (get-meta entity) (get-id-value entity))))


;;; ===== Relationship handling functions. Execute with in-db / in-txn

(defn- assert-same-type-entities
  "Assert that all entities are of the same type."
  [entities]
  (assert (vector? entities))
  (if (or
        (nil?   entities)
        (empty? entities)
        (nil?   (first entities))
        (let [entity-meta  (get-meta (first entities))
              invalid?    #(or
                             (nil? %)
                             (not= entity-meta (get-meta %)))]
          (some invalid? entities)))
    (bad-arg! "One or more non-null entities of same type expected")))


(defn entity-rels-map
  "Build entity-relation map. You pass [e1 e2 e3] as entities and
  [e1r1 e1r2 e2r1 e2r2 e2r3] as related entities, and you get back
  {e1 [e1r1 e1r2]
   e2 [e2r1 e2r2 e2r3]}
  Note: e3 is not a key in the map as it has no corresponding related entities"
  [entities rel-entities]
  (if *assert-args* (do
                      (assert-same-type-entities entities)
                      (assert-same-type-entities rel-entities)))
  (let [entity         (first entities)
        this-meta      (get-meta entity)
        that-meta      (get-meta (first rel-entities))
        that-table-map (dbrel-lookup-by-that-entity (rel-meta entity))
        rel-data       (that-table-map (:name that-meta))
        that-column    (:that-column rel-data)
        this-column    (:this-column rel-data)]
    (group-by #(get-original-entity
                 entities this-column % that-column)
      rel-entities)))


(defn find-rels
  "Fetch related entities. You can use the :cols, :where, :groupby and :other
  attributes as in find-by-criteria function. This avoids N+1 Selects. Return
  a sequence of related entities. 'f' is a function that takes one argument
  (the sequence) and must not return something that processes the arg lazily.
  Arguments:
    f          (Function) that accepts only one argument (entities) and must not
               return something that processes them lazily.
    entities   (Vector) of entities to find related entities for
    that-meta  (EntityMetadata) related entity
  Optional arguments: See find-by-criteria
  Example:
    (in-db mysql
      (let [es (find-by-criteria order-meta
                 {:where (=? :orderdt (java.util.Date.))} ) ; orders today
            rs (find-rels es order-line-meta {:where (>? :qty 5)})] ; qty > 5
        (println rs)))
  See also: with-find-rels-results"
  ([f entities that-meta {:keys [cols where groupby other]
                          :or   {cols    [star-col]     ;; vector of col names
                                 where   (empty-clause) ;; clause
                                 groupby []             ;; vector of expressions
                                 other   (empty-clause) ;; clause
                                 }}]
    (if *assert-args* (do
                        (assert (fn? f))
                        (assert (vector? entities))
                        (assert-as that-meta EntityMetadata)
                        (assert-criteria {:cols    cols    :where where
                                          :groupby groupby :other other})
                        (assert-same-type-entities entities)))
    ;; actual processing
    (let [entity         (first entities)
          this-meta      (get-meta entity)
          that-table-map (dbrel-lookup-by-that-entity (rel-meta entity))
          rel-data       (that-table-map (:name that-meta))
          that-column    (:that-column rel-data)
          this-column    (:this-column rel-data)
          rel-col-values (map #(this-column %) entities)
          ;; add 'that-col IN (vals-in-entities)' expression to the WHERE clause
          new-where      (in? that-column rel-col-values)
          where-clause   (if (empty-clause? where) new-where
                           (AND new-where where))
          ;; add 'that-col' to the cols being fetched
          add-rel-column (fn [few-cols]
                           (if (some #(or
                                        (= that-column %)  ;; that-col
                                        (= star-col %))    ;; OR star-col
                                 few-cols)                 ;; found in cols?
                             few-cols                      ;; then cols are fine
                             (conj few-cols that-column))) ;; prefix otherwise
          cols-vector    (add-rel-column cols)
          ;; add 'that-col' to GROUP BY if 'count-col' is being fetched
          new-groupby    (if (and
                               (some #(= count-col %)
                                 cols-vector)         ;; count-col being fetched?
                               (< 1 (count entities)) ;; AND more than 1 entity?
                               (not (some #(= that-column %)
                                      groupby))) ;; AND that-col not in group-by?
                           [that-column] [])
          groupby-vector (into new-groupby groupby) ;; new col comes first
          ;; criteria
          criteria       {:cols    cols-vector    :where where-clause
                          :groupby groupby-vector :other other}
          ]
      (with-find-by-criteria-results ents that-meta criteria
        (f ents))))
  ([entities that-meta criteria]
    (find-rels as-vector entities that-meta criteria))
  ([entities that-meta]
    (find-rels entities that-meta {})))


(defmacro with-find-rels-results
  "Wrapper macro for find-rels. You must not return something that processes
  the result lazily.
  Arguments:
    rel-entities (Symbol) that is bound to the entities returned by the query
    entities     (Vector) of entities for which related entities to be fetched 
    that-meta    (EntityMetadata) for the related entity type
    criteria     (Map) of optional criteria arguments (see find-by-criteria fn)
    body         Function body to work on the result
  Example:
    (in-db mysql
      (let [es (find-by-criteria order-meta
                 {:where (=? :orderdt (java.util.Date.))} ) ; orders today]
        (with-find-rels-results rs es order-line-meta {:where (>? :qty 5)}
          (println rs))))
  See also: find-rels"
  [rel-entities entities that-meta criteria & body]
  `(find-rels (fn [~rel-entities] ~@body) ~entities ~that-meta ~criteria))


(defn find-entity-rels-map
  "Find related entities for the given set of entities and return a map of
  entity versus related-entities (see entity-rel-map function for details).
  See also: entity-rel-map, find-rels"
  ([entities that-meta criteria]
    (entity-rels-map entities (find-rels entities that-meta criteria)))
  ([entities that-meta]
    (find-entity-rels-map entities that-meta {})))


(defn save-deps
  "Save dependents (dep-entities) in a 1-to-many scenario for a given entity."
  [entity dep-entities]
  (if *assert-args* (do
                      (assert (map? entity))
                      (assert (vector? dep-entities))
                      (assert (not (empty? dep-entities)))
                      (assert (every? #(map? %) dep-entities))))
  (let [rels (rel-meta entity)
        that-table-map (dbrel-lookup-by-that-entity rels)]
    (into [] (for [each dep-entities]
      (if-let [each-rel (that-table-map (:name (get-meta each)))]
        (let [child (assoc each
                      (:that-column each-rel)
                      ((:this-column each-rel) entity))]
          (save child)))))))


(defn find-siblings
  "Fetch sibling entities in a Many-to-1 scenario. You can use the :cols,
  :where, :groupby and :other attributes as in find-by-criteria function.
  'entity' has a many-to-1 relation with 'rel-entity' here and siblings of
  'entity' are fetched with respect to 'rel-entity'. Unless you mention in the
  criteria, the argument entity is also included in the result.
  Arguments:
    f                (Function) that accepts only one argument, i.e. entities
                     and must not return something that processes them lazily
    entity           (Entity) - 'Many' side of Many-to-1 scenario
    rel-entity-meta  (EntityMetadata) - '1' side of Many-to-1 scenario
    criteria         (Map) optional attributes as described in find-by-criteria
  Example:
    (in-db mysql
      (let [e (find-by-id employee-meta 446)
            r (find-siblings e department-meta)]
        (println r)))
  See also: with-find-siblings-results"
  ([f entity rel-entity-meta {:keys [cols where groupby other]
                              :or   {cols    [star-col]     ;; vector of col names
                                     where   (empty-clause) ;; clause
                                     groupby []             ;; vector of expressions
                                     other   (empty-clause) ;; clause
                                     }}]
    (if *assert-args* (do
                        (assert (fn? f))
                        (assert (map? entity))
                        (assert-as rel-entity-meta EntityMetadata)
                        (assert-criteria {:cols    cols    :where where
                                          :groupby groupby :other other})))
    (let [this-meta       (get-meta entity)
          that-table-map  (dbrel-lookup-by-that-entity (rel-meta entity))
          rel-data        (that-table-map (:name rel-entity-meta))
          this-table-name (name (:name this-meta))
          this-col-name   (name (:this-column rel-data))
          ;that-id-value   ((:that-column rel-data) rel-entity)
          this-col-value  ((:this-column rel-data) entity)
          ;_               (assert (= this-col-valu that-id-value))
          ;; add 'this-col = that-id-value' expression to the WHERE clause
          old-where    (as-clause where)
          new-where    (=? this-col-name this-col-value)
          where-clause (if (empty-clause? old-where) new-where
                         (AND new-where old-where))
          criteria     {:cols    cols    :where where-clause
                        :groupby groupby :other other}
          ]
      (with-find-by-criteria-results ents this-meta criteria
        (f ents))))
  ([entity rel-entity-meta criteria]
    (find-siblings #(into [] %) entity rel-entity-meta criteria))
  ([entity rel-entity-meta]
    (find-siblings #(into [] %) entity rel-entity-meta {})))


(defmacro with-find-siblings-results
  "Wrapper macro for find-siblings. You must not return something that processes
  the result lazily.
  Arguments:
    sibling-entities (Symbol) that is bound to the entities returned by the query
    entity           (Entity) for which sibling entities to be fetched 
    rel-entity-meta  (EntityMetadata) for the related entity type
    criteria         (Map) of optional criteria arguments (see find-by-criteria)
    body             Function body to work on the result
  Example:
    (in-db mysql
      (let [e (find-by-id employee-meta 446)]
        (with-find-siblings-results sib e department-meta {}
          (println sib))))
  See also: find-rels"
  [sibling-entities entity rel-entity-meta criteria & body]
  `(find-siblings (fn [~sibling-entities] ~@body) ~entity ~rel-entity-meta
     ~criteria))


(defn delete-cascade
  "Delete a given entity (cascaded, i.e. also deep-delete dependent relations)"
  [entity]
  (if *assert-args* (assert-arg entity? entity))
  (let [rels (rel-meta entity)]
    (doseq [each rels]
      (if (:that-depends? each)
        (let [c ((find-entity-rels-map [entity] (:that-entity each)) entity)]
          (doseq [each-child c]
            (delete-cascade each-child))))))
  (delete entity))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; pretty-printing for rows

(def max-col-print-width 40)
(def delim " | ")

(defn print-entities
  "Print homogenous entities in a table format. Keys from the first entity are
  used as title. Passing an empty sequence of entities prints nothing at all.
  Arguments:
    entities  (Vector) of entities"
  [entities]
  ;(mypp "\nENTITIES ***\n" entities)
  (if *assert-args*
    (do
      (assert (vector? entities))
      (assert (every? (fn [entity] (and (map? entity)
                         (every? (fn [col-entry]
                                   (let [not-coll? #(not (coll? %))]
                                     (and
                                       (not-coll? (first col-entry))
                                       (not-coll? (last col-entry)))))
                           entity))) entities))))
  (if-let [rows (map to-row (as-vector (if (map? entities) [entities] entities)))]
    (let [cols-count  (count (first rows))
          cols-width  (atom (into [] (take cols-count (repeat 0))))
          keys-as-str (map name (keys (first rows)))
          keys-n-vals (conj (map vals rows) keys-as-str)
          ;; translate non-printable chars http://hyperpolyglot.wikidot.com/lisp
          xlate-np-chars (fn [fs]
                           (let [xl {"\b" "\\b" "\f" "\\f" "\n" "\\n"
                                     "\r" "\\r" "\t" "\\t"}
                                 ks (keys xl)]
                             (apply str
                               (map #(let [s (str %)]
                                       (if (.contains ks s) (get xl s) s))
                                 fs))))
          ;(fn [s] (.replace (.replace s "\n" "\\n") "\t" "\\t"))
          ]
      ;; pass #1 -- calculate width of columns
      (doseq [each keys-n-vals]
        (let [each-cols-width (map #(count (xlate-np-chars (str %))) each)
              max-cols-width (map max each-cols-width @cols-width)]
          ;; keep the maximum col width under limits
          (reset! cols-width
            (map min
              max-cols-width (take cols-count (repeat max-col-print-width))))))
      ;; pass #2 -- actually print the cols
      (let [fixed-width-str (fn [text width]
                              (let [padded-text (apply str (xlate-np-chars text)
                                                  (take width (repeat \ )))]
                                (apply str (take width padded-text))))
            print-cols (fn [cols]
                         (println
                           (apply str
                             (interpose delim
                               (map fixed-width-str cols @cols-width)))))]
        ;; print titles and rows
        (print-cols keys-as-str) ;; column titles
        (print-cols (map #(apply str (repeat % "-")) @cols-width)) ;; dashes
        (doseq [each-row rows] ;; column values
          (print-cols (map str (vals each-row))))))))
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.