Skip to content

Commit

Permalink
Refactor continued; SQLite support WIP
Browse files Browse the repository at this point in the history
  • Loading branch information
@mak08
mak08 committed Dec 16, 2019
1 parent f066e48 commit 140c943
Show file tree
Hide file tree
Showing 21 changed files with 1,478 additions and 147 deletions.
3 changes: 2 additions & 1 deletion cl-rdbms.asd
View file
Original file line number Diff line number Diff line change
Expand Up @@ -18,7 +18,8 @@
(:file "sql-dml")
(:file "sql-tcl")
(:file "sql-tuples")
(:file "sql-serializer")))
(:file "sql-serializer")
(:file "sql-api")))

(:module "edm"
:serial t
Expand Down
57 changes: 1 addition & 56 deletions edm/datamodel.cl
View file
Original file line number Diff line number Diff line change
@@ -1,40 +1,14 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Description
;;; Author Michael Kappert 2019
;;; Last Modified <michael 2019-12-14 15:38:31>
;;; Last Modified <michael 2019-12-15 00:01:32>

(in-package :edm)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; DB Schema
;;
;; A schema is a collection of db table definitions, not a namespace.
;; The schema is used in two situations:
;; - When building the application, the types derived from the schema must
;; be created/imported.
;; - When deploying the application, the corresponding DB tables must be
;; created

(defvar *schema-lib* (make-hash-table :test #'equalp))

(defmacro defschema (name &rest definitions)
(let ((owner)
(tabdefs))
(loop :for definition :in definitions
:do (ecase (car definition)
(:owner
(setf owner (cadr definition)))
(:table
(push `(deftable ,@(cdr definition) :schema ,name)
tabdefs))))
`(setf (gethash ,name *schema-lib*)
(make-schema :name ,name
:owner ,owner
:tables (reverse (list ,@tabdefs))))))

(defun get-schema-by-name (name)
(gethash name *schema-lib*))

(defmethod use-schema ((name string))
(use-schema (get-schema-by-name name)))
Expand All @@ -44,35 +18,6 @@
:do (ensure-tuple-class tabdef))
(values schema))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Helper for defschema

(defmacro deftable (name &key schema columns constraints)
(let ((coldefs
(loop :for coldef :in columns
:collect `(make-coldef :name ,@coldef)))
(constraints
(loop :for constraint :in constraints :collect
(destructuring-bind (&key primary-key foreign-key unique-key
columns referenced-table referenced-columns)
constraint
(cond (primary-key
`(make-primary-key :name ,primary-key
:columns ',columns))
(foreign-key
`(make-foreign-key :name ,foreign-key
:schema ,schema
:columns ',columns
:referenced-table-schema ,schema
:referenced-table ',referenced-table
:referenced-columns ',referenced-columns))
(unique-key
`(make-unique-key :name ,unique-key
:columns ',columns)))))))
`(create-tabdef :name ,name
:schema ,schema
:columns (list ,@coldefs)
:constraints (list ,@constraints))))


;;;
Expand Down
173 changes: 173 additions & 0 deletions edm/examples/eeql-example.cl
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,173 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Description Extended Entity Query Language
;;; Copyright (c) Michael Kappert 2014
;;; Last Modified <michael 2019-12-14 21:32:41>

(setf logging:*log-level* 2)
(setf *print-circle* t)

;; namespace sap.example;
;;
;; @Schema: 'ABC'
;; context MyCompany {
;;
;; type MyName {
;; first : String(80);
;; middle : String(80);
;; last : String(80);
;; };
;;
;; entity MyAddress {
;; key id : Integer;
;; employee_id : Integer;
;; kind : String(10);
;; street : String(80);
;; number : Integer;
;; city : String(80);
;; zip : Integer;
;; };
;;
;; entity MyOrgunit {
;; key id : Integer;
;; name : String(80);
;; boardarea : String(20);
;; manager : Association[0..1] to MyEmployee { id };
;; };
;;
;; entity MyEmployee {
;; key id : Integer;
;; name : MyName;
;; salary : Decimal(22,2);
;; address : Association[0..2] to MyAddress { employee_id };
;; org : Association[0..1] to MyOrgunit { id };
;; };
;; };

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Translation of MyCompany example

(defpackage "MYCOMPANY"
(:use "COMMON-LISP" "SQL" "DBI" "ALCM"))

(in-package mycompany)

(defentity (MyName
(:schema "ABC"))
(:field first :type (string 80))
(:field middle :type (string 80))
(:field last :type (string 80)))

(defentity (MyAddress
(:schema "ABC"))
(:field kind :type (string 10))
(:field street :type (string 80))
(:field number :type integer)
(:field city :type (string 80))
(:field zip :type integer))

(defentity (MyOrgunit
(:schema "ABC")
(:key "name_key" (name)))
(:field name :type (string 80))
(:field boardarea :type (string 20))
(:reference manager :target-entity MyEmployee))

(defentity (MyEmployee
(:schema "ABC")
(:key "id_key" (id)))
(:field id :type integer)
(:field salary :type money)
(:composition name :target-entity MyName)
(:composition address :target-entity MyAddress :cardinality :many)
(:reference org :target-entity MyOrgunit))

(defparameter *abc-schema*
(dbi:create-db-schema "ABC"))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Create test data

(defun refresh-data ()
(alcm::redeploy "ABC" "crm" "crmadmin" "crmadmin" :redeploy t)
(pg-socket:with-open-connection (c "crm" :user "crmadmin" :password "crmadmin")
(with-connection (c)
(with-transaction ()
(let* ((org-unit (create-instance 'abc.myorgunit :name "TIP" :boardarea "TIP"))
(e1
(let* ((name (create-instance 'abc.myname :first "Woody" :last "Woodpecker"))
(address1 (create-instance 'abc.myaddress :street "Goethestraße" :number 8 :city "München" :zip 8000 :kind "home"))
(address2 (create-instance 'abc.myaddress :street "Goethestraße" :number 8 :city "München" :zip 8000 :kind "work"))
(employee (create-instance 'abc.myemployee :name name :address (list address1 address2) :org org-unit :salary 125000)))
employee))
(e2
(let* ((name (create-instance 'abc.myname :first "Mickey" :last "Mouse"))
(address (create-instance 'abc.myaddress :street "Lessingstraße" :number 7 :city "München" :zip 8000 :kind "home"))
(employee (create-instance 'abc.myemployee :name name :address (list address) :org org-unit :salary 42500)))
employee)))
(set-element org-unit 'manager e1)
(list e1 e2))))))

(defun test ()
(pg-socket:with-open-connection (c "crm" :user "crmadmin" :password "crmadmin")
(with-connection (c)
(?select '(first middle last city street salary abc.myorgunit.name) :from
(?inner-join
(?inner-join
(?inner-join
(?inner-join 'abc.myemployee
'abc.myemployee$n1$org
:on (?= 'entity_id 'source_id))
'abc.myorgunit
:on (?= 'target_id 'abc.myorgunit.entity_id))
'abc.myname
:on (?= 'abc.myemployee.entity_id 'abc.myname.parent_id))
'abc.myaddress
:on (?and (?= 'abc.myemployee.entity_id 'abc.myaddress.parent_id) (?= 'abc.myaddress.kind "home")))
:where (?and (?= 'boardarea "TIP")
(?>= 'salary 100000))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Example Query

;; SELECT FROM Employee[org.boardarea = 'TIP' AND salary > '100.000']
;; { name,
;; address[kind='home'] { street, city},
;; salary
;; }


(defun eequery (connection string)
(sql:sql-query connection
(dbi::translate-query
(dbi::parse-ee-query string))))



#+()(?filter (list 'name
(?filter (list 'street 'city)
:from 'address
:where (?= 'kind "home"))
'salary)
:from 'myemployee
:where (?and (?= (list 'org 'boardarea) "TIP") (?> 'salary 100000)))

"
SELECT
ABC.MYNAME.FIRST,
ABC.MYNAME.MIDDLE,
ABC.MYNAME.LAST,
ABC.MYADDRESS.CITY,
ABC.MYADDRESS.STREET,
ABC.MYEMPLOYEE.SALARY,
ABC.MYORGUNIT.NAME
FROM
ABC.MYEMPLOYEE
INNER JOIN ABC.MYEMPLOYEE$N1$ORG ON (ENTITY_ID = SOURCE_ID)
INNER JOIN ABC.MYORGUNIT ON (TARGET_ID = ABC.MYORGUNIT.ENTITY_ID)
INNER JOIN ABC.MYNAME ON (ABC.MYEMPLOYEE.ENTITY_ID = ABC.MYNAME.PARENT_ID)
INNER JOIN ABC.MYADDRESS ON (ABC.MYEMPLOYEE.ENTITY_ID = ABC.MYADDRESS.PARENT_ID) AND (ABC.MYADDRESS.KIND = 'home')
WHERE ((ABC.MYORGUNIT.BOARDAREA = 'TIP') AND (SALARY >= 100000))
"

;;; EOF
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
131 changes: 131 additions & 0 deletions edm/examples/hdb-example.cl
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,131 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Description Extended Entity Query Language
;;; Copyright (c) Michael Kappert 2014
;;; Last Modified <michael 2019-12-14 21:32:51>

(setf logging:*log-level* 3)
(setf *print-circle* t)

;; namespace sap.example;
;;
;; @Schema: 'D037165'
;; context MyCompany {
;;
;; type MyName {
;; first : String(80);
;; middle : String(80);
;; last : String(80);
;; };
;;
;; entity MyAddress {
;; key id : Integer;
;; employee_id : Integer;
;; kind : String(10);
;; street : String(80);
;; number : Integer;
;; city : String(80);
;; zip : Integer;
;; };
;;
;; entity MyOrgunit {
;; key id : Integer;
;; name : String(80);
;; boardarea : String(20);
;; manager : Association[0..1] to MyEmployee { id };
;; };
;;
;; entity MyEmployee {
;; key id : Integer;
;; name : MyName;
;; salary : Decimal(22,2);
;; address : Association[0..2] to MyAddress { employee_id };
;; org : Association[0..1] to MyOrgunit { id };
;; };
;; };

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Translation of MyCompany example

(defpackage "MYCOMPANY"
(:use "COMMON-LISP" "SQL" "DBI" "ALCM"))

(in-package mycompany)

(defentity (MyName
(:schema "D037165"))
(:field first :type (string 80))
(:field middle :type (string 80))
(:field last :type (string 80)))

(defentity (MyAddress
(:schema "D037165"))
(:field kind :type (string 10))
(:field street :type (string 80))
(:field number :type integer)
(:field city :type (string 80))
(:field zip :type integer))

(defentity (MyOrgunit
(:schema "D037165")
(:key "name_key" (name)))
(:field name :type (string 80))
(:field boardarea :type (string 20))
(:reference manager :target-entity MyEmployee))

(defentity (MyEmployee
(:schema "D037165")
(:key "id_key" (id)))
(:field id :type integer)
(:field salary :type money)
(:composition name :target-entity MyName)
(:composition address :target-entity MyAddress :cardinality :many)
(:reference org :target-entity MyOrgunit))

(defparameter *D037165-schema*
(dbi:create-db-schema "D037165"))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Create test data

(defun refresh-data ()
(alcm::clear-schema% (get-schema-by-name "D037165"))
(let* ((org-units
(list (create-instance 'D037165.myorgunit :name "Board" :boardarea "B")
(create-instance 'D037165.myorgunit :name "Sales" :boardarea "BS")
(create-instance 'D037165.myorgunit :name "Procurement" :boardarea "BP")))
(addresses (list
(create-instance 'D037165.myaddress :street "Goethestrasse" :number 8 :city "Muenchen" :zip 8000 :kind "work")
(create-instance 'D037165.myaddress :street "Goethestrasse" :number 8 :city "Muenchen" :zip 8000 :kind "home")
(create-instance 'D037165.myaddress :street "Lessingstrasse" :number 7 :city "Muenchen" :zip 8000 :kind "home")))
(e1
(let* ((name (create-instance 'D037165.myname :first "Woody" :last "Woodpecker")))
(create-instance 'D037165.myemployee :name name :address (list (first addresses) (second addresses)) :org (first org-units) :salary 125000)))
(e2
(let* ((name (create-instance 'D037165.myname :first "Mickey" :last "Mouse")))
(create-instance 'D037165.myemployee :name name :address (list (first addresses) (third addresses)) :org (second org-units) :salary 42500)))
(e3
(let* ((name (create-instance 'D037165.myname :first "Donald" :last "Duck")))
(create-instance 'D037165.myemployee :name name :address (list (first addresses) (third addresses)) :org (third org-units) :salary 34500))))
(set-element (second org-units) 'manager e2)
(set-element (third org-units) 'manager e3)
(list e1 e2 e3)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Example Query

(defparameter *ee-query*
;; SELECT FROM Employee[org.boardarea = 'TIP' AND salary > '100000']
;; { name,
;; address[kind='home']{ street, city},
;; salary
;; }
"D037165.MyEmployee[org.boardarea = 'B' AND salary > '100000'] { name, address[kind='home']{ street, city}, salary }")

(defun eequery (connection string)
(sql:sql-query connection
(dbi::translate-query
(dbi::parse-ee-query string))))


;;; EOF
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Loading

0 comments on commit 140c943

Please sign in to comment.