Refactor

mak08 · Dec 14, 2019 · e184b09 · e184b09
1 parent aa45ad4
commit e184b09
Show file tree

Hide file tree

Showing 12 changed files with 86 additions and 111 deletions.
diff --git a/cl-rdbms.asd b/cl-rdbms.asd
@@ -54,14 +54,14 @@
                         :components ((:file "hdb-odbc-package")
                                      (:file "hdb-odbc")
                                      (:file "sql-serialization")))
-               (:module "datamodel"
+               (:module "edm"
                         :serial t
                         :depends-on ("sql")
                         :components ((:file "package")
-                                     (:file "lifecycle")
                                      (:file "entity")   
                                      (:file "entity-api")
                                      (:file "entity-syntax")
+                                     (:file "datamodel")
                                      (:file "eeql")))))
 
 ;;; EOF

diff --git a/edm/datamodel.cl b/edm/datamodel.cl
@@ -0,0 +1,79 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Description
+;;; Author         Michael Kappert 2019
+;;; Last Modified <michael 2019-12-14 11:00:14>
+
+(in-package :datamodel)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; 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)))
+(defmethod use-schema ((schema schema))
+  (loop
+     :for tabdef :in (schema-tables schema)
+     :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))))
+
+
+;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
diff --git a/datamodel/eeql.cl → edm/eeql.cl b/datamodel/eeql.cl → edm/eeql.cl
diff --git a/datamodel/entity-api.cl → edm/entity-api.cl b/datamodel/entity-api.cl → edm/entity-api.cl
diff --git a/datamodel/entity-syntax.cl → edm/entity-syntax.cl b/datamodel/entity-syntax.cl → edm/entity-syntax.cl
diff --git a/datamodel/entity.cl → edm/entity.cl b/datamodel/entity.cl → edm/entity.cl
diff --git a/datamodel/notes.txt → edm/notes.txt b/datamodel/notes.txt → edm/notes.txt
diff --git a/datamodel/package.cl → edm/package.cl b/datamodel/package.cl → edm/package.cl
@@ -2,7 +2,7 @@
 ;;; Author         Michael Kappert
 ;;; Copyright      (c) Michael Kappert 2011
 ;;; Created        2011-10-19 23:43:23 23:43:23
-;;; Last Modified  <michael 2018-01-14 20:34:45>
+;;; Last Modified  <michael 2019-12-14 10:55:18>
 ;;; Description
 
 (defpackage "DATAMODEL"
@@ -38,7 +38,6 @@
    append-tuple
 
    ;; Schemas
-   *schema*
    create-db-schema
 
    ;; entity syntax

diff --git a/datamodel/sql.bnf → edm/sql.bnf b/datamodel/sql.bnf → edm/sql.bnf
diff --git a/datamodel/lifecycle.cl → pg-sql/lifecycle.cl b/datamodel/lifecycle.cl → pg-sql/lifecycle.cl
diff --git a/sql/sql-package.cl b/sql/sql-package.cl
@@ -1,7 +1,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Description
 ;;; Author         Michael 2014
-;;; Last Modified <michael 2019-12-12 23:51:40>
+;;; Last Modified <michael 2019-12-13 20:36:06>
 
 (defpackage "SQL"
   (:use "COMMON-LISP"
@@ -73,6 +73,7 @@
    load-db-schema
    find-db-schema
 
+   deftable
    tabdef
    make-tabdef
    tabdef-p

diff --git a/sql/sql-tuples.cl b/sql/sql-tuples.cl
@@ -1,114 +1,10 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Author         Michael Kappert
-;;; Copyright      (c) Michael Kappert 2011
-;;; Created        2011-10-20 22:15:22 22:15:22
-;;; Last Modified  <michael 2019-12-08 11:10:40>
 ;;; Description    db interface
+;;; Author         Michael Kappert 2011
+;;; Last Modified  <michael 2019-12-14 10:59:53>
 
 (in-package :sql)
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Use Case
-;;    - create form on UI, enter values, create table for form, persist entered values
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; - Architecture:
-;;   - who keeps db connection(s)?
-;;     -> client+db, client keep connections
-;;     -> client+server+db, client or server keeps connections
-;;
-;; - Think about setup procedure:
-;;   0- where do definitions come from?
-;;      when are they changed?
-;;      - predefined/user defined/patch&upgrade
-;;      who owns them?
-;;      - software author/ software user
-;;      on which level are they made?
-;;      -  cdoc > ? > table
-;;         * cdoc is the user interface level
-;;         * table is the database level
-;;         - is there anything in between?
-;;   1- when to define table struct?
-;;   2- when to create table?
-;;   3- other actions, eg store definition in repository, log etc?
-;;   4- when to populate table?
-;;
-;;   a. Execute definitions: Do 1+2 together, populate later
-;;   b. Partially execute: create struct, defer table creation?
-;;   b. Write definitions to repository: Decide later what to do when
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; 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))
-
-(defvar *schema* nil)
-
-(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)))
-(defmethod use-schema ((schema schema))
-  (loop
-     :for tabdef :in (schema-tables schema)
-     :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))))
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; SQL tables and tuples