Craig Oates
2 years ago
4 changed files with 284 additions and 9 deletions
@ -0,0 +1,236 @@ |
|||||||
|
;; (in-package :cl-user) ; Not sure if this needs to exist (Chapter 4) |
||||||
|
(defpackage :rails-to-caveman.model |
||||||
|
(:use #:cl |
||||||
|
#:rails-to-caveman.db) |
||||||
|
(:export #:seeds |
||||||
|
#:ids)) |
||||||
|
(in-package #:rails-to-caveman.model) |
||||||
|
|
||||||
|
;;; Defines the USER table class for the database. |
||||||
|
;;; Will be used by mito (an ORM). |
||||||
|
(defclass user () |
||||||
|
((number |
||||||
|
:col-type |
||||||
|
:integer |
||||||
|
:initarg |
||||||
|
:number |
||||||
|
:reader number-of) |
||||||
|
(name :col-type (:varchar 64) |
||||||
|
:initarg |
||||||
|
:name |
||||||
|
:reader name-of) |
||||||
|
(full-name :col-type |
||||||
|
(or (:varchar 128) :null) |
||||||
|
:initarg |
||||||
|
:full-name |
||||||
|
:reader full-name-of) |
||||||
|
(email :col-type |
||||||
|
(or :null :text) |
||||||
|
:initarg |
||||||
|
:email |
||||||
|
:accessor email-of) |
||||||
|
(birthday :col-type |
||||||
|
(or :null :date) |
||||||
|
:initarg |
||||||
|
:birthday |
||||||
|
:reader birthday-of) |
||||||
|
(sex :col-type |
||||||
|
:integer |
||||||
|
:initarg |
||||||
|
:sex |
||||||
|
:initform 1 |
||||||
|
:reader sex-of) |
||||||
|
|
||||||
|
#| CHANGED :ACCESSOR VALUE FROM TUTORIAL (CHAPTER 4) |
||||||
|
=================================================== |
||||||
|
The Chapter 4 tutorial has the :accessor value set to |
||||||
|
'administratorp'. Unfortunately, this causes initialisation |
||||||
|
argument errors when trying to seed the database. To fix this, I |
||||||
|
had to remove the 'p' part from that line. At the time of |
||||||
|
writing, I do not know if that will have a negative effect on |
||||||
|
future tutorials. |
||||||
|
|
||||||
|
I have left a note in the 'seeds' function below highlighting the |
||||||
|
change to the :accessor value. |
||||||
|
|# |
||||||
|
(administrator :col-type |
||||||
|
:boolean |
||||||
|
:initarg |
||||||
|
:administrator |
||||||
|
:initform nil |
||||||
|
:accessor administrator)) |
||||||
|
(:metaclass mito:dao-table-class)) |
||||||
|
|
||||||
|
|
||||||
|
(defun seeds() |
||||||
|
;; '#(' are ARRAY LITERALS. I keep forgetting this and need to look |
||||||
|
;; it up. |
||||||
|
(let ((names |
||||||
|
#("Taro" "Jiro" "Hana" "John" "Mike" "Sophy" "Bill" "Alex" "Mary" "Tom")) |
||||||
|
(fnames ; First Names |
||||||
|
#("Hippo" "Darling" "Lopez" "Jerry")) |
||||||
|
(gnames ; Given Names |
||||||
|
#("Orange" "Fox" "Snake"))) |
||||||
|
(with-connection (db) |
||||||
|
(dotimes (x 10) |
||||||
|
(mito:create-dao 'user |
||||||
|
:number (+ x 10) |
||||||
|
:name (aref names x) |
||||||
|
:full-name (format nil "~A ~A" |
||||||
|
(aref fnames (rem x 4)) |
||||||
|
(aref gnames (rem x 3))) |
||||||
|
:email (format nil "~A@example.com" (aref names x)) |
||||||
|
:birthday "1981-12-01" |
||||||
|
:sex (nth (rem x 3) '(1 1 2)) |
||||||
|
;; Removed 'p' from end of :administrator -- |
||||||
|
;; so the code differs from the code in the |
||||||
|
;; tutorial (Chapter 4). I had to change it |
||||||
|
;; because it produced errors when trying to |
||||||
|
;; seed the database (using 'seeds' |
||||||
|
;; function. I have, also, left a note in the |
||||||
|
;; 'user' class definition highlighting this. |
||||||
|
:administrator (zerop 0)))))) |
||||||
|
|
||||||
|
|
||||||
|
(defun rebuild () |
||||||
|
"Drops the current database table, recreates it and populates it using seeded data." |
||||||
|
(with-connection (db) |
||||||
|
(mito:recreate-table 'user)) |
||||||
|
(seeds)) |
||||||
|
|
||||||
|
(defun ids () |
||||||
|
"Produces a list of all the Id's in the database. Part of Chapter 4 |
||||||
|
tutorial and is a port of the 'ids method' in the Ruby on Rails book |
||||||
|
this tutorial was translated/ported from." |
||||||
|
(rails-to-caveman.db:with-connection (rails-to-caveman.db:db) |
||||||
|
(mapcar #'mito:object-id |
||||||
|
(mito:retrieve-dao 'rails-to-caveman.model::user)))) |
||||||
|
|
||||||
|
|
||||||
|
#| STAND ALONE BITS OF CODE |
||||||
|
=========================== |
||||||
|
The code below is to use in a live coding environment. Think of it as |
||||||
|
a persistent scratch pad -- for when you close Emacs but still want |
||||||
|
those little snippets of code which do not have a place in the main |
||||||
|
code base but are useful for little tests/proof-of-concepts. |
||||||
|
|
||||||
|
When you have loaded the system in SLIME, use c-c c-c to run the code |
||||||
|
below. |
||||||
|
|# |
||||||
|
|
||||||
|
(with-connection (db) ; Creates a table in the database called 'user'. |
||||||
|
(mito:ensure-table-exists 'user)) |
||||||
|
|
||||||
|
;; Retrieves the record with the specified Id. Change ':id' to |
||||||
|
;; retrieve different entries from the database. |
||||||
|
;; NOTE: EVAL. THIS IN SLIME BEFORE USING (DESCRIBE *) FURTHER DOWN |
||||||
|
;; THE FILE. |
||||||
|
(rails-to-caveman.db:with-connection (rails-to-caveman.db:db) |
||||||
|
(mito:find-dao 'rails-to-caveman.model::user :id 3)) |
||||||
|
|
||||||
|
;; Retrieves the database entry with the specified name. |
||||||
|
(rails-to-caveman.db:with-connection (rails-to-caveman.db:db) |
||||||
|
(mito:find-dao 'rails-to-caveman.model::user :name "Taro")) |
||||||
|
|
||||||
|
#| SQLITE DATABASE BOOLEAN TYPES |
||||||
|
================================ |
||||||
|
Use multiple columns to specify with data you want to retrieve. |
||||||
|
Because SQLite database does not have a Boolean type, |
||||||
|
|
||||||
|
:administrator : 0 = false |
||||||
|
1 = true |
||||||
|
:sex 1 = male |
||||||
|
2 = female |
||||||
|
|
||||||
|
SQLite type quirk and how the tutorial decided to model the data in |
||||||
|
the database. |
||||||
|
|# |
||||||
|
(rails-to-caveman.db:with-connection (rails-to-caveman.db:db) |
||||||
|
(mito:find-dao 'rails-to-caveman.model::user :sex 1 :administrator 1)) |
||||||
|
|
||||||
|
;; A common strategy to deal with SQLite Boolean types is to set |
||||||
|
;; constants and refer to them instead of passing hard coded 1 & 0. |
||||||
|
(defconstant +false+ 0) |
||||||
|
(defconstant +true+ 1) |
||||||
|
|
||||||
|
(rails-to-caveman.db:with-connection (rails-to-caveman.db:db) |
||||||
|
(mito:retrieve-dao 'rails-to-caveman.model::user :administrator +false+)) |
||||||
|
|
||||||
|
(ids) ; Lists out all the Id's (in SLIME) in the 'users' table. |
||||||
|
|
||||||
|
(seeds) ; Populates the database with seeded data (in 'users') |
||||||
|
|
||||||
|
;; Drops the current table, creates a new one and populates it with |
||||||
|
;; seeded data -- in the 'users' tables. |
||||||
|
(rebuild) |
||||||
|
|
||||||
|
#| SEEING THE CONTENTS OF A DATABASE ENTRY IN SLIME. |
||||||
|
==================================================== |
||||||
|
This is a bit picky. First of all, you need to retrieve a database |
||||||
|
entry (in SLIME) before checking the contents. Search for 'NOTE: |
||||||
|
EVAL.' for the code. After you have retrieved the entry from the |
||||||
|
database, calling (describe *) will produce something like the |
||||||
|
following, |
||||||
|
|
||||||
|
[standard-object] Slots with |
||||||
|
:INSTANCE allocation: |
||||||
|
CREATED-AT = @yyyy-mm-ddThh:mm:ss.ms+tz |
||||||
|
UPDATED-AT = @yyyy-mm-ddThh:mm:ss.ms+tz |
||||||
|
SYNCED = T |
||||||
|
ID = 3 |
||||||
|
NUMBER = 12 |
||||||
|
NAME = "Hana" |
||||||
|
FULL-NAME = "高橋 花子" |
||||||
|
EMAIL = "Hana@example.com" |
||||||
|
BIRTHDAY = @yyyy-mm-ddThh:mm:ss.ms+tz |
||||||
|
SEX = 2 |
||||||
|
ADMINISTRATOR = NIL |
||||||
|
|
||||||
|
THIS IS SPECIFIC TO SBCL -- OTHER IMPLEMENTATIONS MIGHT PRODUCE |
||||||
|
DIFFERENT OUTPUTS |
||||||
|
|# |
||||||
|
(describe *) |
||||||
|
|
||||||
|
|
||||||
|
#| BUILD QUERIES WITH SXQL AND MITO |
||||||
|
=================================== |
||||||
|
If you want to build a complex query, use it in combination |
||||||
|
MITO.DAO:SELECT-DAO with sxql . |
||||||
|
|
||||||
|
The one in the previous section MITO:RETRIEVE-DAOis equivalent to the |
||||||
|
following code. |
||||||
|
|
||||||
|
COPY THE CODE BELOW INTO SLIME OR WORK THEM INTO A FUNCTION. |
||||||
|
|# |
||||||
|
(rails-to-caveman.db:with-connection (rails-to-caveman.db:db) |
||||||
|
(mito:select-dao 'rails-to-caveman.model::user |
||||||
|
(sxql:where '(:= :administrator 0)))) |
||||||
|
|
||||||
|
(rails-to-caveman.db:with-connection (rails-to-caveman.db:db) |
||||||
|
(mito:select-dao 'rails-to-caveman.model::user |
||||||
|
(sxql:where |
||||||
|
'(:and (:= :name "Taro") |
||||||
|
(:< :number 20))))) |
||||||
|
|
||||||
|
(rails-to-caveman.db:with-connection (rails-to-caveman.db:db) |
||||||
|
(mito:select-dao 'rails-to-caveman.model::user |
||||||
|
(sxql:where '(:= :sex 2)) |
||||||
|
(sxql:order-by :number))) |
||||||
|
|
||||||
|
(rails-to-caveman.db:with-connection (rails-to-caveman.db:db) |
||||||
|
(mito:select-dao 'rails-to-caveman.model::user |
||||||
|
(sxql:where '(:= :sex 2)) |
||||||
|
(sxql:order-by (:desc :number)))) |
||||||
|
|
||||||
|
(rails-to-caveman.db:with-connection (rails-to-caveman.db:db) |
||||||
|
(mito:select-dao 'rails-to-caveman.model::user |
||||||
|
(sxql:where |
||||||
|
`(:or ,@(mapcar (lambda(num) |
||||||
|
`(:= :number ,num)) |
||||||
|
'(15 17 19)))))) |
||||||
|
|
||||||
|
(rails-to-caveman.db:with-connection (rails-to-caveman.db:db) |
||||||
|
(mito:select-dao 'rails-to-caveman.model::user |
||||||
|
(sxql:where |
||||||
|
`(:and (:<= 12 :number) |
||||||
|
(:<= :number 14)))) |
Loading…
Reference in new issue