-
Notifications
You must be signed in to change notification settings - Fork 2
/
human-1.lisp
76 lines (57 loc) · 2.47 KB
/
human-1.lisp
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
(in-package :pj-human)
;;; Set this if you have not already done so:
;;; (setf *postmodern-connection* '("mydb" "myusername" "" "localhost"))
;;; Then do (setup), (load-humans) and (model-test)
;;; Examples of user defined queries are in human-2.lisp, you might
;;; want to try them before running the cleanup or drop forms.
(defparameter *human-url* "http://gtod.github.io/human.json")
(defparameter *human-file* "/tmp/postgres-json-human.json")
(define-global-model human -human- (pgj-history-object-model))
(define-global-model gift -gift- (pgj-object-model))
;;;; Backend interface
(defun setup ()
(with-pj-connection ()
(ensure-backend -human-)
(ensure-backend -gift-)))
(defun cleanup ()
(with-pj-connection()
(excise-all -human-)
(excise-all -gift-)))
(defun drop ()
(with-pj-connection ()
(drop-backend -human-)
(drop-backend -gift-)))
;;;; Human model
(defun random-human ()
(let ((tally (tally -human-)))
(assert (not (zerop tally)))
(fetch -human- (elt (keys -human-) (random tally)))))
(defun load-humans ()
(unless (probe-file *human-file*)
(write-line "Fetching humans...")
(ql-http:fetch *human-url* *human-file*))
(with-input-from-file (stream *human-file*)
(with-pj-connection ()
(with-model-transaction ()
(write-line "Loading humans...")
(loop for human across (yason:parse stream :json-arrays-as-vectors t)
do (insert -human- human)
finally (return (tally -human-)))))))
;;;; Interface
(defun model-test ()
(with-pj-connection ()
(show (length (filter -human- :contains (obj "gender" "female"))))
(show (gethash "name" (random-human)))
(let ((human (show (first (filter -human- :contains (obj "name" "Marcella Marquez"))))))
(with-keys ((key "key") (friends "friends")) human
;; This is naughty because it requires knowing yason vectors are adjustable.
;; But specialize DESERIALIZE on your model and do what you like...
(vector-push-extend (obj "name" "Horace Morris" "id" (length friends)) friends)
(show (supersede -human- key human))
(show (gethash "friends" (fetch -human- key)))
(show (history -human- key))))
(show (filter -human- :contains (obj "tags" '("ut" "labore")) :properties '("age" "tags")))
(show (length (filter -human- :contains (obj "isActive" t "age" 21))))
(show (length (having-property -human- "eyeColor")))
(show (enumerate-property -human- "favoriteFruit")))
(values))