diff --git a/CHANGELOG.md b/CHANGELOG.md index 210b9b3..e266569 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,10 @@ +# Changelog v. 1.33.2 + +Fix bug in export functions when user tries to export nil into a database + +Fix bug in import functions when functions are called but the current package has changed. +Note to self. Pay attention to needs for fully qualified symbols (including package names) and how to test them for equality. + # Changelog v. 1.33.1 Dao Export and Import Functions (Postmodern v. 1.33.1 and newer) diff --git a/cl-postgres.asd b/cl-postgres.asd index db96178..de0e29c 100644 --- a/cl-postgres.asd +++ b/cl-postgres.asd @@ -54,7 +54,7 @@ (test-op "cl-postgres/simple-date-tests")))) (defsystem "cl-postgres/tests" - :depends-on ("cl-postgres" "fiveam") + :depends-on ("cl-postgres" "fiveam" "uiop") :components ((:module "cl-postgres/tests" :components ((:file "test-package") diff --git a/cl-postgres/errors.lisp b/cl-postgres/errors.lisp index 8d22d2a..12ef2ab 100644 --- a/cl-postgres/errors.lisp +++ b/cl-postgres/errors.lisp @@ -201,6 +201,7 @@ giving them a database-connection-error superclass.")) (deferror "42P01" undefined-table syntax-error-or-access-violation) (deferror "42601" columns-error syntax-error-or-access-violation) (deferror "42703" undefined-column syntax-error-or-access-violation) +(deferror "42704" unrecognized-configuration-parameter data-exception) (deferror "42701" duplicate-column syntax-error-or-access-violation) (deferror "42P03" duplicate-cursor syntax-error-or-access-violation) (deferror "42P04" duplicate-database syntax-error-or-access-violation) diff --git a/doc/array-notes.html b/doc/array-notes.html index 7d8b432..e77309b 100644 --- a/doc/array-notes.html +++ b/doc/array-notes.html @@ -1,11 +1,12 @@ - + S-SQL and Postgresql Arrays + @@ -234,71 +224,72 @@

S-SQL and Postgresql Arrays

Table of Contents

@@ -306,10 +297,19 @@

Table of Contents

Return to s-sql.html +Return to dao-classes.html +Return to postmodern.html

-
-

Summary

-
+ +
+

Summary

+
+

+Arrays are a first class datatype within postgresql. The contents can only be of a single +datatype. Postgresql will enforce that typing. They can be multidimensional. The starting index is 1, not 0. Regardless of whether you specify an array length when you create a table, +Postgresql will always treat them as variable length. +

+

Postmodern/s-sql can be used to insert common lisp arrays into postgresql databases, pull postgresql database arrays out of databases into a common lisp array, @@ -318,6 +318,10 @@

Summary< and https://www.postgresql.org/docs/current/static/functions-array.html.

+

+The Postmodern dao-classes can also have slots that are common lisp arrays with the same utility. +

+

This page will go into more detail on how to use the available operators and functions in s-sql. @@ -325,19 +329,16 @@

Summary<

-
-

Use cases for arrays in a database

-
+
+

Use cases for arrays in a database

+
-
-

General Usage

-
+
+

General Usage

+

-Arrays are a first class datatype within postgresql. The contents can only be of a single -datatype and postgresql will enforce that typing. You can either use arrays as a datatype -stored in the database or there may be reasons why you want to use them as an intermediate -datatype in a query. +You can either use arrays as a datatype stored in the database or there may be reasons why you want to use them as an intermediate datatype in a query.

@@ -392,9 +393,9 @@

General one-dimensional array and the schedule is a two dimensional array.

-
CREATE TABLE sal_emp (
-    name            text,
-    pay_by_quarter  integer[],
+
CREATE TABLE sal_emp (
+    name            text,
+    pay_by_quarter  integer[],
     schedule        text[][]
 );
 

@@ -405,13 +406,13 @@ 
General
 relationships, e.g.
 

 

-
CREATE TABLE posts (
+
CREATE TABLE posts (
     title TEXT,
     tags TEXT[]
 );
 
--- Select all posts with tag 'kitty'
-SELECT * FROM posts WHERE tags @> '{kitty}';
+-- Select all posts with tag 'kitty'
+SELECT * FROM posts WHERE tags @> '{kitty}';
 

 

 

@@ -445,17 +446,17 @@ 
General
 two separate create index commands
 

 

-
(query (:create-table documents
-                      ((doc-id :type integer :constraint 'dockey-id :primary-key 't :unique)
-                       (text :type text))))
+
(query (:create-table documents
+                      ((doc-id :type integer :constraint 'dockey-id :primary-key 't :unique)
+                       (text :type text))))
 
-(query (:create-table doc-tags-array ((doc-id :type integer :references ((documents doc-id)))
-                                      (tags :type text[] :default "{}"))))
+(query (:create-table doc-tags-array ((doc-id :type integer :references ((documents doc-id)))
+                                      (tags :type text[] :default "{}"))))
 
 
-(query (:create-unique-index 'doc-tags-id-doc-id :on "doc-tags-array"  :fields 'doc-id))
+(query (:create-unique-index 'doc-tags-id-doc-id :on "doc-tags-array"  :fields 'doc-id))
 
-(query (:create-index 'doc-tags-id-tags :on "doc-tags-array" :using gin :fields 'tags))
+(query (:create-index 'doc-tags-id-tags :on "doc-tags-array" :using gin :fields 'tags))
 
 

 

@@ -463,19 +464,19 @@ 
General
 And then the corresponding searches for one tag and two (or more) tags would be:
 

 

-
(query (:limit
-        (:order-by
-         (:select 'doc-id
-                  :from 'doc-tags-array
-                  :where (:@> 'tags (:array[] "math")))
+
(query (:limit
+        (:order-by
+         (:select 'doc-id
+                  :from 'doc-tags-array
+                  :where (:@> 'tags (:array[] "math")))
          'doc-id)
         25 0))
 
-(query (:limit
-        (:order-by
-         (:select 'doc-id
-                  :from 'doc-tags-array
-                  :where (:@> 'tags (:array[] "math" "physics")))
+(query (:limit
+        (:order-by
+         (:select 'doc-id
+                  :from 'doc-tags-array
+                  :where (:@> 'tags (:array[] "math" "physics")))
          'doc-id)
         25))
 
@@ -534,9 +535,9 @@ 
General
-
-

Rules of Thumb - Do Not Use Arrays If:

-
+
+

Rules of Thumb - Do Not Use Arrays If:

+
  • Do not use arrays where you need to maintain integrity for foreign relationships. That is what
@@ -556,24 +557,20 @@

Rules of

- -
-

Data Type Enforcement

-
+
+

Data Type Enforcement

+

-Compared to jsonb, postgresql arrays allow you to enforce -the data type. This can be critical in both maintaining -the integrity of your data as well as optimization -in your appliction code. This database enforeced type -safety does not, however, enforce the dimensionality -of the array. +Compared to jsonb, postgresql arrays enforce the data type. This can be critical in both maintaining the integrity of your data as well as optimization in your appliction code. +This database enforced type safety does not, however, enforce the dimensionality of +the array.

-
-

Indices on Arrays

-
+
+

Indices on Arrays

+

It is highly recommended that you use GIN or GIST indexes to search for items in array column. You should remember that GIST indices are @@ -584,9 +581,9 @@

Indices

-
-

S-SQL Array Support

-
+
+

S-SQL Array Support

+

S-sql can feel a little messy with respect to arrays but that is in large part because (a) sql dealing with arrays is messy and @@ -605,56 +602,56 @@

S-SQL Ar

-
-

:array (used inside a query calling a subquery, selecting into an array)

-
+
+

:array (used inside a query calling a subquery, selecting into an array)

+

The format of the call is:

-
(:array (query))
+
(:array (query))

Example:

-
(query (:order-by
-        (:select 'r.rolename
-                 (:as (:array
-                       (:select 'b.rolename
-                                :from (:as 'pg_catalog.pg-auth-members 'm)
-                                :inner-join (:as 'pg-catalog.pg-roles 'b)
-                                :on (:= 'm.roleid 'b.oid)
-                                :where (:= 'm.member 'r.oid )))
+
(query (:order-by
+        (:select 'r.rolename
+                 (:as (:array
+                       (:select 'b.rolename
+                                :from (:as 'pg_catalog.pg-auth-members 'm)
+                                :inner-join (:as 'pg-catalog.pg-roles 'b)
+                                :on (:= 'm.roleid 'b.oid)
+                                :where (:= 'm.member 'r.oid )))
                       'memberof)
-                 :from (:as 'pg-catalog.pg-roles 'r))
+                 :from (:as 'pg-catalog.pg-roles 'r))
         1))
-
-

:array[] (declares an array and returns an array

-
+
+

:array[] (declares an array and returns an array

+

The format of the call is:

-
(:array[] (&rest args))
+
(:array[] (&rest args))

Examples:

-
(query (:select (:array[] 2 6))
-       :single)
+
(query (:select (:array[] 2 6))
+       :single)
 #(2 6)
 
-(query (:select (:array[] (:/ 15 3) (:pi) 6))
-       :single)
+(query (:select (:array[] (:/ 15 3) (:pi) 6))
+       :single)
 
 #(5.0d0 3.141592653589793d0 6.0d0)
 

@@ -666,38 +663,38 @@ 
:array[]
-
-

:[] (used when you want a slice of an array

-
+
+

:[] (used when you want a slice of an array

+

The format of the call is:

-
(:[] (form start &optional end))
+
(:[] (form start &optional end))

Example:

-
(let ((arry1 #(2 6 7 12)))
-     (query (:select (:[] arry1 2 3))
-            :single))
+
(let ((arry1 #(2 6 7 12)))
+     (query (:select (:[] arry1 2 3))
+            :single))
 
 #(6 7)
-
-

General Usage Examples

-
+
+

General Usage Examples

+

Just to make these usage examples really simple, we will use the simplest use case version discussed above, with a tags array in a table with the name of the item. In this case the name is the name of a -receipe and the tags are ingredients that either go in the receipe -or accompany the receipe. +recipe and the tags are ingredients that either go in the recipe +or accompany the recipe.

@@ -706,18 +703,18 @@

General

-
(query (:create-table receipes
-                       ((name :type text)
-                        (tags :type text[] :default "{}"))))
-
-(query (:create-unique-index 'receipe-tags-id-name
-                              :on "receipes"
-                              :fields 'name))
-
-(query (:create-index 'receipe-tags-id-tags
-                       :on "receipes"
-                       :using gin
-                       :fields 'tags))
+
(query (:create-table recipes
+                       ((name :type text)
+                        (tags :type text[] :default "{}"))))
+
+(query (:create-unique-index 'recipe-tags-id-name
+                              :on "recipes"
+                              :fields 'name))
+
+(query (:create-index 'recipe-tags-id-tags
+                       :on "recipes"
+                       :using gin
+                       :fields 'tags))

@@ -726,25 +723,24 @@

General as a postgresql array.

-
(query (:insert-rows-into
-        'receipes
-        :columns 'name 'tags
-        :values
-        '(("Fattoush" #("greens" "pita bread" "olive oil" "garlic" "lemon" "salt" "spices"))
-          ("Shawarma" #("meat" "tahini sauce" "pita bread"))
-          ("Baba Ghanoush" #("pita bread" "olive oil" "eggplant" "tahini sauce"))
-          ("Shish Taouk" #("chicken" "lemon juice" "garlic" "paprika" "yogurt" "tomato paste" "pita bread"))
-          ("Kibbe nayeh" #("raw meat" "bulgur" "onion" "spices" "pita bread"))
-          ("Manakeesh" #("meat" "cheese" "zaatar" "kishik" "tomatoes" "cucumbers" "mint leaves" "olives"))
-          ("Fakafek" #("chickpeas" "pita bread" "tahini sauce"))
-          ("Tabbouleh" #("bulgur" "tomatoes" "onions" "parsley"))
-          ("Kofta" #("minced meat" "parsley" "spices" "onions"))
-          ("Kunafeh" #("cheese" "sugar syrup" "pistachios"))
-          ("Baklava" #("filo dough" "honey" "nuts")))))
+
(query (:insert-rows-into
+        'recipes
+        :columns 'name 'tags
+        :values
+        '(("Fattoush" #("greens" "pita bread" "olive oil" "garlic" "lemon" "salt" "spices"))
+          ("Shawarma" #("meat" "tahini sauce" "pita bread"))
+          ("Baba Ghanoush" #("pita bread" "olive oil" "eggplant" "tahini sauce"))
+          ("Shish Taouk" #("chicken" "lemon juice" "garlic" "paprika" "yogurt" "tomato paste" "pita bread"))
+          ("Kibbe nayeh" #("raw meat" "bulgur" "onion" "spices" "pita bread"))
+          ("Manakeesh" #("meat" "cheese" "zaatar" "kishik" "tomatoes" "cucumbers" "mint leaves" "olives"))
+          ("Fakafek" #("chickpeas" "pita bread" "tahini sauce"))
+          ("Tabbouleh" #("bulgur" "tomatoes" "onions" "parsley"))
+          ("Kofta" #("minced meat" "parsley" "spices" "onions"))
+          ("Kunafeh" #("cheese" "sugar syrup" "pistachios"))
+          ("Baklava" #("filo dough" "honey" "nuts")))))
-

This will automatically insert the required square brackets into the sql statement being passed to postgresql. This automatic translation between lisp and @@ -757,14 +753,14 @@

General Sample desired sql statement:

-
(SELECT ARRAY[(1 / 2)]::FLOATS[]);
+
(SELECT ARRAY[(1 / 2)]::FLOATS[]);

S-sql version

-
(query (:select (:type (:array[] (:/ 1 2)) float[])))
+
(query (:select (:type (:array[] (:/ 1 2)) float[])))
@@ -772,12 +768,12 @@

General First we can start by checking for records that have a specific tag

-
(query (:select 'receipe-id 'tags
-                :from 'receipe-tags-array
-                :where (:@> 'tags
-                            (:array[] "bulgur"))))
-(("Tabbouleh" #("bulgur" "tomatoes" "onions" "parsley"))
- ("Kibbe nayeh" #("raw meat" "bulgur" "onions" "spices" "pita bread")))
+
(query (:select 'recipe-id 'tags
+                :from 'recipe-tags-array
+                :where (:@> 'tags
+                            (:array[] "bulgur"))))
+(("Tabbouleh" #("bulgur" "tomatoes" "onions" "parsley"))
+ ("Kibbe nayeh" #("raw meat" "bulgur" "onions" "spices" "pita bread")))
@@ -792,12 +788,12 @@

General Extending this to checking for items with two specific tags:

-
(query (:select 'receipe-id 'tags
-                :from 'receipe-tags-array
-                :where (:@> 'tags
-                            (:array[] "bulgur" "parsley"))))
+
(query (:select 'recipe-id 'tags
+                :from 'recipe-tags-array
+                :where (:@> 'tags
+                            (:array[] "bulgur" "parsley"))))
 
-(("Tabbouleh" #("bulgur" "tomatoes" "onions" "parsley")))
+(("Tabbouleh" #("bulgur" "tomatoes" "onions" "parsley")))

@@ -806,17 +802,17 @@

General acts as an 'or' logical test:

-
(let ((tst-arry #("parsley" "cheese")))
-  (query (:order-by (:select '*
-                             :from 'receipes
-                             :where (:&& 'tags tst-arry))
+
(let ((tst-arry #("parsley" "cheese")))
+  (query (:order-by (:select '*
+                             :from 'recipes
+                             :where (:&& 'tags tst-arry))
                     'name)))
-'(("Manakeesh"
-   #("meat" "cheese" "zaatar" "kishik" "tomatoes" "cucumbers" "mint leaves"
-     "olives"))
-  ("Tabbouleh" #("bulgur" "tomatoes" "onions" "parsley"))
-  ("Kofta" #("minced meat" "parsley" "spices" "onions"))
-  ("Kunafeh" #("cheese" "sugar syrup" "pistachios")))
+'(("Manakeesh"
+   #("meat" "cheese" "zaatar" "kishik" "tomatoes" "cucumbers" "mint leaves"
+     "olives"))
+  ("Tabbouleh" #("bulgur" "tomatoes" "onions" "parsley"))
+  ("Kofta" #("minced meat" "parsley" "spices" "onions"))
+  ("Kunafeh" #("cheese" "sugar syrup" "pistachios")))
@@ -826,10 +822,10 @@

General Validating that this is returning a vector:

-
(type-of (query (:select 'tags
-                         :from 'receipes
-                         :where (:= 'name "Manakeesh"))
-                :single))
+
(type-of (query (:select 'tags
+                         :from 'recipes
+                         :where (:= 'name "Manakeesh"))
+                :single))
 
 '(SIMPLE-VECTOR 8)
 

@@ -838,10 +834,10 @@ 
General
 We can also check the length of the array or cardinality:
 

 

-
(query (:select (:cardinality 'tags)
-                :from 'receipes
-                :where (:= 'name "Manakeesh"))
-       :single)
+
(query (:select (:cardinality 'tags)
+                :from 'recipes
+                :where (:= 'name "Manakeesh"))
+       :single)
 

 

 
@@ -849,21 +845,21 @@ 
General
 Updating the array can be done either explicitly:
 

 

-
;;; Update array with an lisp array (changing onion to onions in the one row where it is singular
-(query (:update 'receipes
-                :set 'tags #("raw meat" "bulgur" "onions" "spices" "pita bread")
-                :where (:= 'name "Kibbe nayeh")))
+
;;; Update array with an lisp array (changing onion to onions in the one row where it is singular
+(query (:update 'recipes
+                :set 'tags #("raw meat" "bulgur" "onions" "spices" "pita bread")
+                :where (:= 'name "Kibbe nayeh")))
 

 

 

 or passing in a lisp variable:
 

 

-
;;; checking passing a lisp array as a variable
-(let ((lisp-arry #("wine" "garlic" "soy sauce")))
-  (query (:update 'receipes
-                  :set 'tags '$1
-                  :where (:= 'name 11))
+
;;; checking passing a lisp array as a variable
+(let ((lisp-arry #("wine" "garlic" "soy sauce")))
+  (query (:update 'recipes
+                  :set 'tags '$1
+                  :where (:= 'name 11))
          lisp-arry))
 

 

@@ -878,17 +874,17 @@ 
General
 

 
 

-
(query (:select (:[] 'tags 2)
-                :from 'receipes
-                :where (:= 'name 3)))
+
(query (:select (:[] 'tags 2)
+                :from 'recipes
+                :where (:= 'name 3)))
 
-'(("olive oil"))
+'(("olive oil"))
 
-(query (:select (:[] 'tags 2 3)
-                :from 'receipes
-                :where (:= 'name 3)))
+(query (:select (:[] 'tags 2 3)
+                :from 'recipes
+                :where (:= 'name 3)))
 
-'((#("olive oil" "eggplant")))
+'((#("olive oil" "eggplant")))
 
 

 

@@ -903,13 +899,13 @@ 
General
 

 

 
-SELECT r.rolname,
-  ARRAY(SELECT b.rolname
-        FROM pg_catalog.pg_auth_members m
-        JOIN pg_catalog.pg_roles b ON (m.roleid = b.oid)
-        WHERE m.member = r.oid) as memberof
-FROM pg_catalog.pg_roles r
-ORDER BY 1;
+SELECT r.rolname,
+  ARRAY(SELECT b.rolname
+        FROM pg_catalog.pg_auth_members m
+        JOIN pg_catalog.pg_roles b ON (m.roleid = b.oid)
+        WHERE m.member = r.oid) as memberof
+FROM pg_catalog.pg_roles r
+ORDER BY 1;
 **************************
 

 

@@ -919,16 +915,16 @@ 
General
 we need to use just :array
 

 

-
(query (:order-by
-        (:select 'r.rolename
-                 (:as (:array
-                       (:select 'b.rolename
-                                :from (:as 'pg_catalog.pg-auth-members 'm)
-                                :inner-join (:as 'pg-catalog.pg-roles 'b)
-                                :on (:= 'm.roleid 'b.oid)
-                                :where (:= 'm.member 'r.oid )))
+
(query (:order-by
+        (:select 'r.rolename
+                 (:as (:array
+                       (:select 'b.rolename
+                                :from (:as 'pg_catalog.pg-auth-members 'm)
+                                :inner-join (:as 'pg-catalog.pg-roles 'b)
+                                :on (:= 'm.roleid 'b.oid)
+                                :where (:= 'm.member 'r.oid )))
                       'memberof)
-                 :from (:as 'pg-catalog.pg-roles 'r))
+                 :from (:as 'pg-catalog.pg-roles 'r))
         1))
 

 

@@ -939,17 +935,17 @@ 
General
 the distinct tags in a list of lists where every list has a single tag entry.
 

 

-
(query (:order-by
-        (:select (:as (:unnest 'tags) 'tag) :distinct
-                 :from 'receipes)
+
(query (:order-by
+        (:select (:as (:unnest 'tags) 'tag) :distinct
+                 :from 'recipes)
         'tag))
 
-'(("bulgur") ("cheese") ("chicken") ("chickpeas") ("cucumbers") ("eggplant")
-  ("filo dough") ("garlic") ("greens") ("honey") ("kishik") ("lemon")
-  ("lemon juice") ("meat") ("minced meat") ("mint leaves") ("nuts")
-  ("olive oil") ("olives") ("onions") ("paprika") ("parsley")
-  ("pistachios") ("pita bread") ("raw meat") ("salt") ("spices") ("sugar syrup")
-  ("tahini sauce") ("tomatoes") ("tomato paste") ("yogurt") ("zaatar"))
+'(("bulgur") ("cheese") ("chicken") ("chickpeas") ("cucumbers") ("eggplant")
+  ("filo dough") ("garlic") ("greens") ("honey") ("kishik") ("lemon")
+  ("lemon juice") ("meat") ("minced meat") ("mint leaves") ("nuts")
+  ("olive oil") ("olives") ("onions") ("paprika") ("parsley")
+  ("pistachios") ("pita bread") ("raw meat") ("salt") ("spices") ("sugar syrup")
+  ("tahini sauce") ("tomatoes") ("tomato paste") ("yogurt") ("zaatar"))
 

 

 
@@ -957,22 +953,22 @@ 
General
 We can use with and group-by operators to count the unique tags:
 

 

-
(query (:order-by
-        (:with
-         (:as 'p
-              (:select (:as (:unnest 'tags) 'tag)
-                       :from 'receipes))
-         (:select 'tag (:as (:count 'tag) 'cnt)
-                  :from 'p
-                  :group-by 'tag))
-        (:desc 'cnt) 'tag))
-'(("pita bread" 6) ("onions" 3) ("spices" 3) ("tahini sauce" 3) ("bulgur" 2)
-  ("cheese" 2) ("garlic" 2) ("meat" 2) ("olive oil" 2) ("parsley" 2)
-  ("tomatoes" 2) ("chicken" 1) ("chickpeas" 1) ("cucumbers" 1) ("eggplant" 1)
-  ("filo dough" 1) ("greens" 1) ("honey" 1) ("kishik" 1) ("lemon" 1)
-  ("lemon juice" 1) ("minced meat" 1) ("mint leaves" 1) ("nuts" 1) ("olives" 1)
-  ("paprika" 1) ("pistachios" 1) ("raw meat" 1) ("salt" 1) ("sugar syrup" 1)
-  ("tomato paste" 1) ("yogurt" 1) ("zaatar" 1))
+
(query (:order-by
+        (:with
+         (:as 'p
+              (:select (:as (:unnest 'tags) 'tag)
+                       :from 'recipes))
+         (:select 'tag (:as (:count 'tag) 'cnt)
+                  :from 'p
+                  :group-by 'tag))
+        (:desc 'cnt) 'tag))
+'(("pita bread" 6) ("onions" 3) ("spices" 3) ("tahini sauce" 3) ("bulgur" 2)
+  ("cheese" 2) ("garlic" 2) ("meat" 2) ("olive oil" 2) ("parsley" 2)
+  ("tomatoes" 2) ("chicken" 1) ("chickpeas" 1) ("cucumbers" 1) ("eggplant" 1)
+  ("filo dough" 1) ("greens" 1) ("honey" 1) ("kishik" 1) ("lemon" 1)
+  ("lemon juice" 1) ("minced meat" 1) ("mint leaves" 1) ("nuts" 1) ("olives" 1)
+  ("paprika" 1) ("pistachios" 1) ("raw meat" 1) ("salt" 1) ("sugar syrup" 1)
+  ("tomato paste" 1) ("yogurt" 1) ("zaatar" 1))
 

 

 
@@ -980,12 +976,12 @@ 
General
 Yes, there are array-append, array-replace etc operators
 

 

-
(query (:update 'receipes
-                :set 'tags (:array-append 'tags "appended-items")
-                :where (:= 'name "Kibbe nayeh")))
+
(query (:update 'recipes
+                :set 'tags (:array-append 'tags "appended-items")
+                :where (:= 'name "Kibbe nayeh")))
 
-(query (:update 'receipes
-                :set 'tags (:array-replace 'tags "spices" "chocolate")))
+(query (:update 'recipes
+                :set 'tags (:array-replace 'tags "spices" "chocolate")))
 

 

 

@@ -998,9 +994,9 @@ 
General
 just touches the rows with the targeted string in the array:
 

 

-
(query (:update 'receipes
-                :set 'tags (:array-replace 'tags  "chocolate" "spices")
-                :where (:<@ "{\"chocolate\"}" 'tags)))
+
(query (:update 'recipes
+                :set 'tags (:array-replace 'tags  "chocolate" "spices")
+                :where (:<@ "{\"chocolate\"}" 'tags)))
 

 

 
@@ -1016,23 +1012,23 @@ 
General
 operators :any* and :any
 

 

-
(sql (:select '*
-                :from 'receipes
-                :where (:= "chicken" (:any* 'tags ))))
+
(sql (:select '*
+                :from 'recipes
+                :where (:= "chicken" (:any* 'tags ))))
 
-"(SELECT * FROM receipes WHERE (E'chicken' = ANY(tags)))"
+"(SELECT * FROM recipes WHERE (E'chicken' = ANY(tags)))"
 
-(sql (:select '*
-                :from 'receipes
-                :where (:= "chicken" (:any 'tags ))))
+(sql (:select '*
+                :from 'recipes
+                :where (:= "chicken" (:any 'tags ))))
 
-"(SELECT * FROM receipes WHERE (E'chicken' = ANY tags))"
+"(SELECT * FROM recipes WHERE (E'chicken' = ANY tags))"
 

 

 
 

 In the following two cases we want to use ':any*'. In the first simple query,
-we are looking for everything in the rows where the name of the receipe is in
+we are looking for everything in the rows where the name of the recipe is in
 the lisp array we passed in.
 

 
@@ -1041,23 +1037,23 @@ 
General
 appears in any of the tag arrays.
 

 

-
(query (:select '*
-                :from 'receipes
-                :where (:= 'name (:any* '$1)))
-       #("Trout" "Shish Taouk" "Hamburger"))
-
-'(("Shish Taouk"
-   #("chicken" "lemon juice" "garlic" "paprika" "yogurt" "tomato paste"
-     "pita bread")))
-
-(query (:select '*
-                :from 'receipes
-                :where (:= '$1 (:any* 'tags )))
-       "chicken")
-
-'(("Shish Taouk"
-   #("chicken" "lemon juice" "garlic" "paprika" "yogurt" "tomato paste"
-     "pita bread")))
+
(query (:select '*
+                :from 'recipes
+                :where (:= 'name (:any* '$1)))
+       #("Trout" "Shish Taouk" "Hamburger"))
+
+'(("Shish Taouk"
+   #("chicken" "lemon juice" "garlic" "paprika" "yogurt" "tomato paste"
+     "pita bread")))
+
+(query (:select '*
+                :from 'recipes
+                :where (:= '$1 (:any* 'tags )))
+       "chicken")
+
+'(("Shish Taouk"
+   #("chicken" "lemon juice" "garlic" "paprika" "yogurt" "tomato paste"
+     "pita bread")))
 

 

 
@@ -1066,18 +1062,18 @@ 
General
 the or operator which looks like :&&.
 

 

-
(query (:order-by
-        (:select '*
-                 :from 'receipes
-                 :where (:&& 'tags (:array[] '$1 '$2)))
+
(query (:order-by
+        (:select '*
+                 :from 'recipes
+                 :where (:&& 'tags (:array[] '$1 '$2)))
         'name)
-       "parsley" "cheese")
-'(("Manakeesh"
-   #("meat" "cheese" "zaatar" "kishik" "tomatoes" "cucumbers" "mint leaves"
-     "olives"))
-  ("Tabbouleh" #("bulgur" "tomatoes" "onions" "parsley"))
-  ("Kofta" #("minced meat" "parsley" "spices" "onions"))
-  ("Kunafeh" #("cheese" "sugar syrup" "pistachios")))
+       "parsley" "cheese")
+'(("Manakeesh"
+   #("meat" "cheese" "zaatar" "kishik" "tomatoes" "cucumbers" "mint leaves"
+     "olives"))
+  ("Tabbouleh" #("bulgur" "tomatoes" "onions" "parsley"))
+  ("Kofta" #("minced meat" "parsley" "spices" "onions"))
+  ("Kunafeh" #("cheese" "sugar syrup" "pistachios")))
 

 

 
@@ -1104,27 +1100,27 @@ 
General
 of an array composed of the two strings passed in as parameters.
 

 

-
(query (:order-by
-        (:select '* :from 'receipes
-                 :where (:<@ (:array[] '$1 '$2)
+
(query (:order-by
+        (:select '* :from 'recipes
+                 :where (:<@ (:array[] '$1 '$2)
                              'tags))
         'name)
-       "tomatoes" "cheese")
+       "tomatoes" "cheese")
 
-'(("Manakeesh"
-   #("meat" "cheese" "zaatar" "kishik" "tomatoes" "cucumbers" "mint leaves"
-     "olives")))
+'(("Manakeesh"
+   #("meat" "cheese" "zaatar" "kishik" "tomatoes" "cucumbers" "mint leaves"
+     "olives")))
 
-(query (:order-by
-        (:select '* :from 'receipes
-                 :where (:@> 'tags
-                             (:array[] '$1 '$2)))
+(query (:order-by
+        (:select '* :from 'recipes
+                 :where (:@> 'tags
+                             (:array[] '$1 '$2)))
         'name)
-       "tomatoes" "cheese")
+       "tomatoes" "cheese")
 
-'(("Manakeesh"
-   #("meat" "cheese" "zaatar" "kishik" "tomatoes" "cucumbers" "mint leaves"
-     "olives")))
+'(("Manakeesh"
+   #("meat" "cheese" "zaatar" "kishik" "tomatoes" "cucumbers" "mint leaves"
+     "olives")))
 

 

 

@@ -1134,21 +1130,21 @@ 
General
 

 
 

-
(query (:order-by
-        (:select '* :from 'receipes
-                 :where (:@> (:array[] '$1 '$2)
+
(query (:order-by
+        (:select '* :from 'recipes
+                 :where (:@> (:array[] '$1 '$2)
                              'tags))
         'name)
-       "tomatoes" "cheese")
+       "tomatoes" "cheese")
 
 nil
 
-(query (:order-by
-        (:select '* :from 'receipes
-                 :where (:<@ 'tags
-                             (:array[] '$1 '$2)))
+(query (:order-by
+        (:select '* :from 'recipes
+                 :where (:<@ 'tags
+                             (:array[] '$1 '$2)))
         'name)
-       "tomatoes" "cheese")
+       "tomatoes" "cheese")
 
 nil
 

@@ -1156,13 +1152,18 @@ 
General

-
-

Array Operators

-
+
+

Dao Class Support for Arrays

+
+
+
+
+

Array Operators

+
-
-

Array Comparison Operators

-
+
+

Array Comparison Operators

+

Per postgresql documentation array comparisons compare the array contents element-by-element, using the default B-tree comparison function for the @@ -1176,136 +1177,136 @@

Array Co Form is (:operator array1 array2)

-
-

:= Equality Comparison (Are two arrays equal on an element by element basis)

-
+
+

:= Equality Comparison (Are two arrays equal on an element by element basis)

+
-
(query (:select (:= (:array[] 1 2 3) (:array[] 1 2 3)))
-       :single)
+
(query (:select (:= (:array[] 1 2 3) (:array[] 1 2 3)))
+       :single)
 T
 
-(query (:select (:= (:array[] "a" "b" "c") (:array[] "a" "b" "c")))
-       :single)
+(query (:select (:= (:array[] "a" "b" "c") (:array[] "a" "b" "c")))
+       :single)
 T
 
-(query (:select (:= (:type (:array[] 1 2 3) integer[]) (:array[] 1 2 3)))
-       :single)
+(query (:select (:= (:type (:array[] 1 2 3) integer[]) (:array[] 1 2 3)))
+       :single)
 T
 
-(query (:select (:= (:array[] 1 2 3) (:array[] 1 4 3)))
-       :single)
+(query (:select (:= (:array[] 1 2 3) (:array[] 1 4 3)))
+       :single)
 nil
 
-(query (:select (:= (:type (:array[] 1 2 3) integer[]) (:array[] 1 2 3 5)))
-       :single)
+(query (:select (:= (:type (:array[] 1 2 3) integer[]) (:array[] 1 2 3 5)))
+       :single)
 
 nil
 
-(let ((arry1 #(1 2 3)) (arry2 #(1 2 3)))
-  (query (:select (:= arry1 arry2))
-         :single))
+(let ((arry1 #(1 2 3)) (arry2 #(1 2 3)))
+  (query (:select (:= arry1 arry2))
+         :single))
 T
-
-

:<> Not Equal Comparison

-
+
+

:<> Not Equal Comparison

+
-
(query (:select (:<> (:array[] 1 2 3) (:array[] 1 2 4)))
-       :single)
+
(query (:select (:<> (:array[] 1 2 3) (:array[] 1 2 4)))
+       :single)
 T
-
-

:< Less Than Comparison

-
+
+

:< Less Than Comparison

+
-
(query (:select (:< (:array[] 1 2 3) (:array[] 1 2 4)))
-       :single)
+
(query (:select (:< (:array[] 1 2 3) (:array[] 1 2 4)))
+       :single)
 T
-
-

:> Greater Than Comparison

-
+
+

:> Greater Than Comparison

+
-
(query (:select (:> (:array[] 1 4 3) (:array[] 1 2 4)))
-       :single)
+
(query (:select (:> (:array[] 1 4 3) (:array[] 1 2 4)))
+       :single)
 T
-
-

:>= Greater Than or Equal to Comparison

-
+
+

:>= Greater Than or Equal to Comparison

+
-
(query (:select (:>= (:array[] 1 4 3) (:array[] 1 4 3)))
-       :single)
+
(query (:select (:>= (:array[] 1 4 3) (:array[] 1 4 3)))
+       :single)
 T
-
-

:<= Less Than or Equal To Comparison

-
+
+

:<= Less Than or Equal To Comparison

+
-
(query (:select (:<= (:array[] 1 2 3) (:array[] 1 2 3)))
-       :single)
+
(query (:select (:<= (:array[] 1 2 3) (:array[] 1 2 3)))
+       :single)
 T
-
-

:@> Contains Comparison

-
+
+

:@> Contains Comparison

+
-
(query (:select (:@> (:array[] 1 4 3) (:array[] 3 1)))
-       :single)
+
(query (:select (:@> (:array[] 1 4 3) (:array[] 3 1)))
+       :single)
 T
 
-(query (:select (:@> (:array[] 1 4 73) (:array[] 3 0)))
-       :single)
+(query (:select (:@> (:array[] 1 4 73) (:array[] 3 0)))
+       :single)
 nil
-
-

:<@ Is Contained By Comparison

-
+
+

:<@ Is Contained By Comparison

+
-
(query (:select (:<@ (:array[] 2 7) (:array[] 1 7 4 2 6)))
-        :single)
+
(query (:select (:<@ (:array[] 2 7) (:array[] 1 7 4 2 6)))
+        :single)
 T
 
-(query (:select (:<@ (:array[] 1 4 3) (:array[] 3 1)))
-       :single)
+(query (:select (:<@ (:array[] 1 4 3) (:array[] 3 1)))
+       :single)
 nil
-
-

:&& Has Elements in Common Comparison

-
+
+

:&& Has Elements in Common Comparison

+
-
(query (:select (:&& (:array[] 1 4 3) (:array[] 3 1)))
-       :single)
+
(query (:select (:&& (:array[] 1 4 3) (:array[] 3 1)))
+       :single)
 T
@@ -1313,51 +1314,51 @@

:&&a

-
-

Array Concatenation Operators

-
+
+

Array Concatenation Operators

+

Form (:|| item1 item2 …)

-
-

:|| Concatentation Arrays and Elements

-
+
+

:|| Concatentation Arrays and Elements

+
-
(query (:select (:|| 3 (:array[] 4 5 6)))
-       :single)
+
(query (:select (:|| 3 (:array[] 4 5 6)))
+       :single)
 
 #(3 4 5 6)
 
-(query (:select (:|| (:array[] 4 5 6) 7))
-       :single)
+(query (:select (:|| (:array[] 4 5 6) 7))
+       :single)
 
 #(4 5 6 7)
 
-(query (:select (:|| (:array[] 1 2) (:array[] 3 4)))
-       :single)
+(query (:select (:|| (:array[] 1 2) (:array[] 3 4)))
+       :single)
 
 #(1 2 3 4)
 
-(query (:select (:|| 1 (:type "[0:1]={2,3}" int[])))
-       :single)
+(query (:select (:|| 1 (:type "[0:1]={2,3}" int[])))
+       :single)
 
 #(1 2 3)
 
-(query (:select (:|| 3 (:array[] 4 5 6) (:array[] 7 8 9) 10))
-       :single)
+(query (:select (:|| 3 (:array[] 4 5 6) (:array[] 7 8 9) 10))
+       :single)
 #(3 4 5 6 7 8 9 10)
-
-

:|| Concatenation with Multi-Dimensional Arrays

-
+
+

:|| Concatenation with Multi-Dimensional Arrays

+
-
(query (:select (:|| (:array[] 1 2 3) (:array[] (:array[] 4 5 6) (:array[] 7 8 9))))
-       :single)
+
(query (:select (:|| (:array[] 1 2 3) (:array[] (:array[] 4 5 6) (:array[] 7 8 9))))
+       :single)
 
 #2A((1 2 3) (4 5 6) (7 8 9))
 

@@ -1367,21 +1368,21 @@ 
:|| Conc
-
-

Array functions

-
+
+

Array functions

+
-
-

Array-prepend

-
+
+

Array-prepend

+

Form: (:array-prepend (array1 element)) Appends an element to the beginning of an array

-
(query (:select (:array-prepend 1 (:array[] 2 3)))
-       :single)
+
(query (:select (:array-prepend 1 (:array[] 2 3)))
+       :single)
 
 #(1 2 3)
 

@@ -1389,16 +1390,16 @@ 
Array-pr
-
-

array-append

-
+
+

array-append

+

Form: (:array-append (array1 element)) Appends an element to the end of an array.

-
(query (:select (:array-append (:array[] 4 5 6) 7))
-       :single)
+
(query (:select (:array-append (:array[] 4 5 6) 7))
+       :single)
 
 #(4 5 6 7)
 

@@ -1406,27 +1407,27 @@ 
array-ap
-
-

array-cat

-
+
+

array-cat

+

Form: (:array-cat (array1 array2)) Concatenates two arrays. No more, no less. Both arrays need to have the same data type. They do not need to be the same length.

-
(query (:select (:array-cat (:array[] 1 2) (:array[] 3 4)))
-       :single)
+
(query (:select (:array-cat (:array[] 1 2) (:array[] 3 4)))
+       :single)
 
 #(1 2 3 4)
 
-(query (:select (:array-cat (:array[] (:array[] 1 2) (:array[] 3 4)) (:array[] 5 6)))
-       :single)
+(query (:select (:array-cat (:array[] (:array[] 1 2) (:array[] 3 4)) (:array[] 5 6)))
+       :single)
 
 #2A((1 2) (3 4) (5 6))
 
-(query (:select (:array-cat (:array[] 1 2) (:array[] 3 4 5)))
-       :single)
+(query (:select (:array-cat (:array[] 1 2) (:array[] 3 4 5)))
+       :single)
 
 #(1 2 3 4 5)
 

@@ -1434,41 +1435,41 @@ 
array-ca
-
-

array-ndims

-
+
+

array-ndims

+

Form: (:array-ndims (array)) Array-ndims returns the number of dimensions of an array.

-
(query (:select (:array-ndims (:array[] (:array[] 1 2 3) (:array[] 4 5 6))))
-       :single)
+
(query (:select (:array-ndims (:array[] (:array[] 1 2 3) (:array[] 4 5 6))))
+       :single)
 2
-
-

array-dims

-
+
+

array-dims

+

Form: (:array-dims (array1)) Array-dims returns a text representation of an array's dimensions.

-
(query (:select (:array-dims (:array[] (:array[] 1 2 3) (:array[] 4 5 6))))
-       :single)
-"[1:2][1:3]"
+
(query (:select (:array-dims (:array[] (:array[] 1 2 3) (:array[] 4 5 6))))
+       :single)
+"[1:2][1:3]"
-
-

array-fill

-
+
+

array-fill

+

Form: (:array-fill (value array-dimension)) Array-fill returns an array initialized with supplied value and length. @@ -1488,9 +1489,9 @@

array-fi

-
-

array-length

-
+
+

array-length

+

Form: (:array-length (array1 array-dimension)) Returns the length of the requested array dimension. @@ -1498,15 +1499,15 @@

array-le dimension.

-
(query (:select (:array-length (:array[] 1 2 3) 1 ))
-       :single)
+
(query (:select (:array-length (:array[] 1 2 3) 1 ))
+       :single)
 3
 
-(query (:select (:array-length (:array[] #(#(1 2 3)#(4 5 6))) 1)) :single)
+(query (:select (:array-length (:array[] #(#(1 2 3)#(4 5 6))) 1)) :single)
 
 1
 
-(query (:select (:array-length (:array[] #(#(1 2 3)#(4 5 6))) 2)) :single)
+(query (:select (:array-length (:array[] #(#(1 2 3)#(4 5 6))) 2)) :single)
 
 2
 

@@ -1514,25 +1515,25 @@ 
array-le

-
-

array-lower

-
+
+

array-lower

+

Form: (:array-lower (&rest args)) Array-lower returns the lower bound of the requested array dimension.

-
(query (:select (:array-lower (:type "[0:2]={1,2,3}" integer[]) 1))
-       :single)
+
(query (:select (:array-lower (:type "[0:2]={1,2,3}" integer[]) 1))
+       :single)
 0
-
-

array-position

-
+
+

array-position

+

Form: (:array-position (array element starting-point-if-not-one)) Array-position returns the subscript of the first occurrence of the @@ -1541,8 +1542,8 @@

array-po Requires postgresql version 9.5 or newer.

-
(query (:select (:array-position (:array[] "sun" "mon" "tue" "wed" "thu" "fri" "sat") "mon"))
-       :single)
+
(query (:select (:array-position (:array[] "sun" "mon" "tue" "wed" "thu" "fri" "sat") "mon"))
+       :single)
 2
@@ -1550,9 +1551,9 @@

array-po

-
-

array-positions

-
+
+

array-positions

+

Form: (:array-positions (array element)) Array-positions (note the plural) returns an array of subscripts @@ -1561,8 +1562,8 @@

array-po Requires postgresql version 9.5 or newer.

-
(query (:select (:array-positions (:array[] "A" "A" "B" "A") "A"))
-       :single)
+
(query (:select (:array-positions (:array[] "A" "A" "B" "A") "A"))
+       :single)
 
 #(1 2 4)
 

@@ -1570,9 +1571,9 @@ 
array-po

-
-

array-remove

-
+
+

array-remove

+

Form: (:array-remove (array element)) Array-remove removes all elements equal to the given value @@ -1580,10 +1581,10 @@

array-re Requires postgresql 9.3 or newer.

-
(query (:select (:array-remove (:array[] "A" "A" "B" "A") "B"))
-       :single)
+
(query (:select (:array-remove (:array[] "A" "A" "B" "A") "B"))
+       :single)
 
-#("A" "A" "A")
+#("A" "A" "A")

@@ -1593,17 +1594,17 @@

array-re

-
-

array-replace

-
+
+

array-replace

+

Form: (:array-replace (array element-to-be-replaced element-used-as-replacement)) Array-replaces replaces each array element equal to the given value with a new value. Requires postgresql 9.3 or newer.

-
(query (:select (:array-replace (:array[] 1 2 5 4) 5 3))
-       :single)
+
(query (:select (:array-replace (:array[] 1 2 5 4) 5 3))
+       :single)
 
 #(1 2 3 4)
 

@@ -1611,85 +1612,85 @@ 
array-re
-
-

array-to-string

-
+
+

array-to-string

+

Form: (:array-to-string (array delimiter optional-null-string)) Array-to-string concatenates array elements using supplied delimiter and optional null string.

-
(query (:select (:array-to-string (:array[] 1 2 3 :NULL 5) "," "*"))
-       :single)
+
(query (:select (:array-to-string (:array[] 1 2 3 :NULL 5) "," "*"))
+       :single)
 
-"1,2,3,*,5"
+"1,2,3,*,5"
-
-

array-upper

-
+
+

array-upper

+

Form: (:array-upper (array int)) Array-upper returns upper bound of the requested array dimension.

-
(query (:select (:array-upper (:array[] 1 8 3 7) 1))
-       :single)
+
(query (:select (:array-upper (:array[] 1 8 3 7) 1))
+       :single)
 4
-
-

cardinality

-
+
+

cardinality

+

Form: (:cardinality (array)) Returns the total number of elements in the array or 0 if the array is empty. Requires postgresql 9.4 or newer.

-
(query (:select (:array-length (:array[] 1 2 3) 1 ))
-       :single)
+
(query (:select (:array-length (:array[] 1 2 3) 1 ))
+       :single)
 3
-
-

string-to-array

-
+
+

string-to-array

+

Form: (:string-to-array (text delimiter optional-null-string)) String-to-array splits a string into array elements using the supplied delimiter and optional null string.

-
(query (:select (:string-to-array "xx~^~yy~^~zz" "~^~" "yy"))
-       :single)
+
(query (:select (:string-to-array "xx~^~yy~^~zz" "~^~" "yy"))
+       :single)
 
-#("xx" :NULL "zz")
+#("xx" :NULL "zz")
-
-

unnest

-
+
+

unnest

+

Form: (:unnest (array)) Unnest expands an array to a set of rows.

-
(query (:select (:unnest (:array[] 1 2))))
+
(query (:select (:unnest (:array[] 1 2))))
 
 '((1) (2))
 

@@ -1702,9 +1703,9 @@ 
unnest
-
-

array-agg

-
+
+

array-agg

+

Form: (:array-agg (expression)) Array-agg returns the result in an array (both sql and, in postmodern, a lisp array). @@ -1721,37 +1722,37 @@

array-ag

-
(query (:select (:array-agg 'name) :from 'receipes) :single)
+
(query (:select (:array-agg 'name) :from 'recipes) :single)
 
-#("Fattoush" "Shawarma" "Baba Ghanoush" "Shish Taouk" "Kibbe nayeh" "Manakeesh"
-  "Fakafek" "Tabbouleh" "Kofta" "Kunafeh" "Baklava")
+#("Fattoush" "Shawarma" "Baba Ghanoush" "Shish Taouk" "Kibbe nayeh" "Manakeesh"
+  "Fakafek" "Tabbouleh" "Kofta" "Kunafeh" "Baklava")
 
-(query (:select (:array-agg 'city :distinct)
-        :from 'employee)
-  :single)
+(query (:select (:array-agg 'city :distinct)
+        :from 'employee)
+  :single)
 
-#("New York" "Toronto" "Vancouver")
+#("New York" "Toronto" "Vancouver")
 
-(query (:select (:array-agg 'city :distinct :order-by (:desc 'city))
-        :from 'employee)
-  :single)
+(query (:select (:array-agg 'city :distinct :order-by (:desc 'city))
+        :from 'employee)
+  :single)
 
-#("Vancouver" "Toronto" "New York")
+#("Vancouver" "Toronto" "New York")
 
-(query (:select 'city (:array-agg 'salary :filter (:< 'salary 50000))
-        :from 'employee
-        :group-by 'city))
+(query (:select 'city (:array-agg 'salary :filter (:< 'salary 50000))
+        :from 'employee
+        :group-by 'city))
 
-(("Vancouver" #(14420 26020)) ("New York" #(40420 40620)) ("Toronto" #(24020)))
+(("Vancouver" #(14420 26020)) ("New York" #(40420 40620)) ("Toronto" #(24020)))

-
-

NULL and nil

-
+
+

NULL and nil

+

An empty array will be returned by postmodern as nil.

diff --git a/doc/array-notes.org b/doc/array-notes.org index 3208b81..ca21d25 100644 --- a/doc/array-notes.org +++ b/doc/array-notes.org @@ -5,32 +5,38 @@ #+OPTIONS: ^:nil [[file:s-sql.html][Return to s-sql.html]] +[[file:dao-classes.html][Return to dao-classes.html]] +[[file:postmodern.html][Return to postmodern.html]] + * Summary :PROPERTIES: - :ID: 25ed4f42-9f8d-43e0-93df-593e8af1d200 + :ID: array-summary :END: +Arrays are a first class datatype within postgresql. The contents can only be of a single +datatype. Postgresql will enforce that typing. They can be multidimensional. The starting index is 1, not 0. Regardless of whether you specify an array length when you create a table, +Postgresql will always treat them as variable length. + Postmodern/s-sql can be used to insert common lisp arrays into postgresql databases, pull postgresql database arrays out of databases into a common lisp array, and generally engage in all the ways that sql can use postgresql arrays. Postgresql arrays are documented at https://www.postgresql.org/docs/current/static/arrays.html and https://www.postgresql.org/docs/current/static/functions-array.html. +The Postmodern dao-classes can also have slots that are common lisp arrays with the same utility. + This page will go into more detail on how to use the available operators and functions in s-sql. * Use cases for arrays in a database :PROPERTIES: - :ID: 9d616ea8-b581-4d78-b83f-2a1bb550c5a7 + :ID: array-use-cases :END: ** General Usage :PROPERTIES: - :ID: e5fa6a9b-8773-473a-aa9c-7bdaf3aa203e + :ID: general-array-usage :END: -Arrays are a first class datatype within postgresql. The contents can only be of a single -datatype and postgresql will enforce that typing. You can either use arrays as a datatype -stored in the database or there may be reasons why you want to use them as an intermediate -datatype in a query. +You can either use arrays as a datatype stored in the database or there may be reasons why you want to use them as an intermediate datatype in a query. There is a bit of controversy over the use of the array datatype in a database. There are those who adamantly oppose it, claiming that it is a violation of 1NF form (normalization). @@ -180,7 +186,7 @@ See also [[https://www.compose.com/articles/take-a-dip-into-postgresql-arrays/]] ** Rules of Thumb - Do Not Use Arrays If: :PROPERTIES: - :ID: 1022eae8-7780-44e5-874e-207df82a4bea + :ID: do-not-use-arrays-if :END: - Do not use arrays where you need to maintain integrity for foreign relationships. That is what @@ -192,21 +198,17 @@ foreign keys are for. that the ORM can utilize arrays. - ** Data Type Enforcement :PROPERTIES: - :ID: 58701df2-c03f-4326-9cc9-efa7f2fa4f5b + :ID: data-type-enforcement :END: -Compared to jsonb, postgresql arrays allow you to enforce -the data type. This can be critical in both maintaining -the integrity of your data as well as optimization -in your appliction code. This database enforeced type -safety does not, however, enforce the dimensionality -of the array. +Compared to jsonb, postgresql arrays enforce the data type. This can be critical in both maintaining the integrity of your data as well as optimization in your appliction code. +This database enforced type safety does not, however, enforce the dimensionality of +the array. ** Indices on Arrays :PROPERTIES: - :ID: b8b2a4c0-60c7-429b-9bcd-f98763438b7d + :ID: array-indices :END: It is highly recommended that you use GIN or GIST indexes to search for items in array column. You should remember that GIST indices are @@ -215,7 +217,7 @@ lossy while GIN indices are lossless. * S-SQL Array Support :PROPERTIES: - :ID: aa6cb2e2-fc06-4948-92e7-3f378aca5ee3 + :ID: s-sql-array-support :END: S-sql can feel a little messy with respect to arrays but that is in large part because (a) sql dealing with arrays is messy and @@ -292,28 +294,28 @@ Example: #+END_SRC ** General Usage Examples :PROPERTIES: - :ID: 1b396eff-19d5-4653-be90-8c6406dffa60 + :ID: s-sql-array-general-usage-examples :END: Just to make these usage examples really simple, we will use the simplest use case version discussed above, with a tags array in a table with the name of the item. In this case the name is the name of a -receipe and the tags are ingredients that either go in the receipe -or accompany the receipe. +recipe and the tags are ingredients that either go in the recipe +or accompany the recipe. First to create the table and the indexes. The index on 'name is the default B-tree index. The index on the tags is a GIN index. #+BEGIN_SRC sql -(query (:create-table receipes +(query (:create-table recipes ((name :type text) (tags :type text[] :default "{}")))) -(query (:create-unique-index 'receipe-tags-id-name - :on "receipes" +(query (:create-unique-index 'recipe-tags-id-name + :on "recipes" :fields 'name)) -(query (:create-index 'receipe-tags-id-tags - :on "receipes" +(query (:create-index 'recipe-tags-id-tags + :on "recipes" :using gin :fields 'tags)) #+END_SRC @@ -322,7 +324,7 @@ passing in lisp arrays and it is automatically inserted in the table as a postgresql array. #+BEGIN_SRC lisp (query (:insert-rows-into - 'receipes + 'recipes :columns 'name 'tags :values '(("Fattoush" #("greens" "pita bread" "olive oil" "garlic" "lemon" "salt" "spices")) @@ -338,7 +340,6 @@ as a postgresql array. ("Baklava" #("filo dough" "honey" "nuts"))))) #+END_SRC - This will automatically insert the required square brackets into the sql statement being passed to postgresql. This automatic translation between lisp and postgresql arrays does not work where you need a postgresql function in a query. @@ -356,8 +357,8 @@ S-sql version First we can start by checking for records that have a specific tag #+BEGIN_SRC lisp -(query (:select 'receipe-id 'tags - :from 'receipe-tags-array +(query (:select 'recipe-id 'tags + :from 'recipe-tags-array :where (:@> 'tags (:array[] "bulgur")))) (("Tabbouleh" #("bulgur" "tomatoes" "onions" "parsley")) @@ -371,8 +372,8 @@ a lisp array. Extending this to checking for items with two specific tags: #+BEGIN_SRC lisp -(query (:select 'receipe-id 'tags - :from 'receipe-tags-array +(query (:select 'recipe-id 'tags + :from 'recipe-tags-array :where (:@> 'tags (:array[] "bulgur" "parsley")))) @@ -384,7 +385,7 @@ acts as an 'or' logical test: #+BEGIN_SRC lisp (let ((tst-arry #("parsley" "cheese"))) (query (:order-by (:select '* - :from 'receipes + :from 'recipes :where (:&& 'tags tst-arry)) 'name))) '(("Manakeesh" @@ -400,7 +401,7 @@ acts as an 'or' logical test: Validating that this is returning a vector: #+BEGIN_SRC lisp (type-of (query (:select 'tags - :from 'receipes + :from 'recipes :where (:= 'name "Manakeesh")) :single)) @@ -409,7 +410,7 @@ Validating that this is returning a vector: We can also check the length of the array or cardinality: #+BEGIN_SRC lisp (query (:select (:cardinality 'tags) - :from 'receipes + :from 'recipes :where (:= 'name "Manakeesh")) :single) #+END_SRC @@ -417,7 +418,7 @@ We can also check the length of the array or cardinality: Updating the array can be done either explicitly: #+BEGIN_SRC lisp ;;; Update array with an lisp array (changing onion to onions in the one row where it is singular -(query (:update 'receipes +(query (:update 'recipes :set 'tags #("raw meat" "bulgur" "onions" "spices" "pita bread") :where (:= 'name "Kibbe nayeh"))) #+END_SRC @@ -425,7 +426,7 @@ or passing in a lisp variable: #+BEGIN_SRC lisp ;;; checking passing a lisp array as a variable (let ((lisp-arry #("wine" "garlic" "soy sauce"))) - (query (:update 'receipes + (query (:update 'recipes :set 'tags '$1 :where (:= 'name 11)) lisp-arry)) @@ -440,13 +441,13 @@ starting point). #+BEGIN_SRC lisp (query (:select (:[] 'tags 2) - :from 'receipes + :from 'recipes :where (:= 'name 3))) '(("olive oil")) (query (:select (:[] 'tags 2 3) - :from 'receipes + :from 'recipes :where (:= 'name 3))) '((#("olive oil" "eggplant"))) @@ -491,7 +492,7 @@ the distinct tags in a list of lists where every list has a single tag entry. #+BEGIN_SRC lisp (query (:order-by (:select (:as (:unnest 'tags) 'tag) :distinct - :from 'receipes) + :from 'recipes) 'tag)) '(("bulgur") ("cheese") ("chicken") ("chickpeas") ("cucumbers") ("eggplant") @@ -508,7 +509,7 @@ We can use with and group-by operators to count the unique tags: (:with (:as 'p (:select (:as (:unnest 'tags) 'tag) - :from 'receipes)) + :from 'recipes)) (:select 'tag (:as (:count 'tag) 'cnt) :from 'p :group-by 'tag)) @@ -524,11 +525,11 @@ We can use with and group-by operators to count the unique tags: Yes, there are array-append, array-replace etc operators #+BEGIN_SRC lisp -(query (:update 'receipes +(query (:update 'recipes :set 'tags (:array-append 'tags "appended-items") :where (:= 'name "Kibbe nayeh"))) -(query (:update 'receipes +(query (:update 'recipes :set 'tags (:array-replace 'tags "spices" "chocolate"))) #+END_SRC The above two versions checked all the row, even those without the target string, @@ -537,7 +538,7 @@ effectively the equivalent of not using the index. You can use a different operator that more effectively uses the GIN index and just touches the rows with the targeted string in the array: #+BEGIN_SRC lisp -(query (:update 'receipes +(query (:update 'recipes :set 'tags (:array-replace 'tags "chocolate" "spices") :where (:<@ "{\"chocolate\"}" 'tags))) #+END_SRC @@ -551,27 +552,27 @@ To show the difference, look at the sql statements that are generated by the two operators :any* and :any #+BEGIN_SRC lisp (sql (:select '* - :from 'receipes + :from 'recipes :where (:= "chicken" (:any* 'tags )))) -"(SELECT * FROM receipes WHERE (E'chicken' = ANY(tags)))" +"(SELECT * FROM recipes WHERE (E'chicken' = ANY(tags)))" (sql (:select '* - :from 'receipes + :from 'recipes :where (:= "chicken" (:any 'tags )))) -"(SELECT * FROM receipes WHERE (E'chicken' = ANY tags))" +"(SELECT * FROM recipes WHERE (E'chicken' = ANY tags))" #+END_SRC In the following two cases we want to use ':any*'. In the first simple query, -we are looking for everything in the rows where the name of the receipe is in +we are looking for everything in the rows where the name of the recipe is in the lisp array we passed in. In the second query we look for all the rows where the string "chicken" appears in any of the tag arrays. #+BEGIN_SRC lisp (query (:select '* - :from 'receipes + :from 'recipes :where (:= 'name (:any* '$1))) #("Trout" "Shish Taouk" "Hamburger")) @@ -580,7 +581,7 @@ appears in any of the tag arrays. "pita bread"))) (query (:select '* - :from 'receipes + :from 'recipes :where (:= '$1 (:any* 'tags ))) "chicken") @@ -594,7 +595,7 @@ the or operator which looks like :&&. #+BEGIN_SRC lisp (query (:order-by (:select '* - :from 'receipes + :from 'recipes :where (:&& 'tags (:array[] '$1 '$2))) 'name) "parsley" "cheese") @@ -622,7 +623,7 @@ We are looking for rows from the database table which contain the elements of an array composed of the two strings passed in as parameters. #+BEGIN_SRC lisp (query (:order-by - (:select '* :from 'receipes + (:select '* :from 'recipes :where (:<@ (:array[] '$1 '$2) 'tags)) 'name) @@ -633,7 +634,7 @@ of an array composed of the two strings passed in as parameters. "olives"))) (query (:order-by - (:select '* :from 'receipes + (:select '* :from 'recipes :where (:@> 'tags (:array[] '$1 '$2))) 'name) @@ -649,7 +650,7 @@ the small two element array we are passing in. The answer is nil. #+BEGIN_SRC lisp (query (:order-by - (:select '* :from 'receipes + (:select '* :from 'recipes :where (:@> (:array[] '$1 '$2) 'tags)) 'name) @@ -658,7 +659,7 @@ the small two element array we are passing in. The answer is nil. nil (query (:order-by - (:select '* :from 'receipes + (:select '* :from 'recipes :where (:<@ 'tags (:array[] '$1 '$2))) 'name) @@ -666,13 +667,17 @@ nil nil #+END_SRC +* Dao Class Support for Arrays + :PROPERTIES: + :ID: dao-class-support + :END: * Array Operators :PROPERTIES: - :ID: 0b311d6a-57e5-44b3-aa03-321274cd4800 + :ID: array-operators :END: ** Array Comparison Operators :PROPERTIES: - :ID: cbdab925-dd3b-4531-8844-29f5f5e61b01 + :ID: array-comparison-operators :END: Per postgresql [[https://www.postgresql.org/docs/current/static/functions-array.html][documentation]] array comparisons compare the array contents @@ -1121,7 +1126,7 @@ Like all the aggregate functions, you can pass :filter, :distinct or :order-by (in that order) as additional parameters. #+BEGIN_SRC lisp -(query (:select (:array-agg 'name) :from 'receipes) :single) +(query (:select (:array-agg 'name) :from 'recipes) :single) #("Fattoush" "Shawarma" "Baba Ghanoush" "Shish Taouk" "Kibbe nayeh" "Manakeesh" "Fakafek" "Tabbouleh" "Kofta" "Kunafeh" "Baklava") diff --git a/doc/dao-classes.html b/doc/dao-classes.html index c587ad6..1202515 100644 --- a/doc/dao-classes.html +++ b/doc/dao-classes.html @@ -1,7 +1,7 @@ - + DAO Classes @@ -227,7 +227,7 @@

Table of Contents

  • Overview
  • Metaclass dao-class @@ -320,9 +320,9 @@

    Overview

    Metaclass dao-class

    -
    -

    Basic Dao Definition Examples

    -
    +
    +

    Basic Dao Definition Examples

    +

    A simple dao definition could look like this:

    @@ -330,7 +330,9 @@

    Basic Dao Definition Examples

    (defclass users ()
   ((name :col-type string :initarg :name :accessor name)
    (creditcard :col-type (or db-null integer) :initarg :card :col-default :null)
-   (score :col-type bigint :col-default 0 :accessor score))
+   (score :col-type bigint :col-default 0 :accessor score)
+   (payment-history :col-type (or (array integer) db-null)
+                    :initarg :payment-history :accessor payment-history))
   (:metaclass dao-class)
   (:keys name))
    @@ -345,14 +347,29 @@

    Basic Dao Definition Examples

    -The name and score slots cannot be null because :col-type does not provide for db-null -as an optiona. The creditcard slot can be null and actually defaults to null. +In our example, the name and score slots cannot be null because :col-type does not provide for db-null as an optiona. The creditcard slot can be null and actually defaults to null. The :col-default :null specification ensures that the default in the database for this field is null, but it does not bound the slot to a default form. Thus, making an instance of the class without initializing this slot will leave it in an unbound state.

    +

    +The payment-history slot is matched to a Postgresql column named payment_history +(remember that Postgresql uses underscores rather than hyphens) and that Postgresql +column is an array of integers. If we wanted a two dimensional array of integers, +the col-type would look like: +

    +
    +
    :col-type (or (array (array integer)) db-null)
+
    +
    +

    +If the value contained in the Postgresql slot payment-history is a common lisp array, +Postmodern will seamless handle the conversion to and from the common lisp array and +the Postgresql array. +

    +

    An example of a class where the keys are set as multiple column keys is here:

    @@ -429,7 +446,15 @@

    Basic Dao Definition Examples

    We also specified that the table name is not "country" but "countries". (Some style guides recommend that table names be plural and references to rows -be singular.) +be singular.) NOTE: You can provide a fully qualified table name. In other words, +if you have +

    +
    +
    (:table-name a.countries)
+
    +
    +

    +Postmodern will look for the countries table in the "A" schema.

    @@ -593,7 +618,7 @@

    Slot Options

    (defclass test-data-col-identity-with-references ()
-  ((id :col-type integer :col-identity t :accessor id)
+  ((id :col-type integer :col-identity t :accessor id :col-primary-key t)
    (username :col-type text :unique t :initarg :username :accessor username)
    (department-id :col-type integer :col-references ((departments id))
                   :initarg :department-id :accessor department-id))
@@ -663,47 +688,71 @@ 
    Dao Export and Import Functions (Postmo
 
    
 
 
    
-Consider the following dao-class definition. We have added additional column keyword parameters :col-export and :col-import. These parameters refer to functions which will convert the values from that slot to a valid Postgresql type (in our example, a string) on export to the database and from that Postgresql type to the type we want in this slot on import from the database..
+Consider the following dao-class definition. We have added additional column keyword parameters :col-export and :col-import. These parameters refer to functions which will convert the values from that slot to a valid Postgresql type (in our example, a string) on export to the database and from that Postgresql type to the type we want in this slot on import from the database.
+
    
+
+
    
+To make things slightly more interesting, we have two slots which are going to contain
+lists, but one will export to a Postgresql column that contains strings and the other
+will export to a Postgresql column that contains arrays of integers.
 
    
 
    
 
    (defclass listy ()
-  ((id :col-type integer :col-identity t :accessor id)
+  ((id :col-type integer :col-identity t :accessor id :col-primary-key t)
    (name :col-type text :col-unique t :col-check (:<> 'name "")
          :initarg :name :accessor name)
-   (rlist :type list :col-type (or text db-null) :initarg :rlist :accessor rlist
-          :col-export list-to-string :col-import string-to-list)
-   (alist :type alist :col-type (or text db-null) :initarg :alist :accessor alist
-          :col-export list-to-string :col-import string-to-alist)
-   (plist :type plist :col-type (or text db-null) :initarg :plist :accessor plist
-          :col-export list-to-string :col-import string-to-plist))
+   (r-list :col-type (or text db-null) :initarg :r-list :accessor r-list
+           :col-export list->string :col-import string->list)
+   (l-array :col-type (or (array integer) db-null)
+            :initarg :l-array :accessor l-array
+            :col-export list->arr :col-import array->list))
   (:metaclass dao-class)
   (:table-name listy))
 
    
 
    
 
    
-Now we need to define the import functions. When writing your import functions, pay attention to how you want to handle nil or :NULL values as well as how you might want to error check the conversion from a Postgresql datatype to a CL datatype.
+Now we are going to define the import functions. When writing your import functions, pay attention to how you want to handle nil or :NULL values as well as how you might want to error check the conversion from a Postgresql datatype to a CL datatype. Just to show some of the
+differences, we are going to translate :NULL strings in Postgresql to :NULL in common lisp
+and we are going to translate :NULL arrays in Postgresql to nil in common lisp.
 
    
 
    
-
    (defun string-to-list (str)
+
    (defun string->list (str)
   "Take a string representation of a list and return a lisp list.
-Note that you need to handle :NULLs."
+  Note that you need to handle :NULLs."
   (cond ((eq str :NULL)
          :NULL)
         (str
-         (with-input-from-string (s str)
-           (read s)))
+         (with-input-from-string (s str) (read s)))
+        (t nil)))
+
+(defun array->list (arry)
+  "Here we have decided that we want the list be be nil rather than :NULL if the array is empty."
+  (cond ((eq arry :NULL)
+         nil)
+        ((vectorp arry)
+         (coerce arry 'list))
         (t nil)))
 
    
 
    
 
    
-And now we need to define the export function. In our example we are just going to be using format to write the CL value to a string. You are responsible for writing an export function that does what you need. This example just tells Postgresql to insert a string "unknown" if the slot value is not a list. In real life you would need more error checking and condition handling.
+And now the export functions. In our example we are just going to be using format to write the CL value to a string unless it is not a list. You are responsible for writing an export function that does what you need. This example just tells Postgresql to insert :NULL if the slot value is not a list. In real life you would need more error checking and condition handling.
+
    
+
+
    
+The list to array export function inserts :NULL if not a list and otherwise coerces the
+list to a vector so that Postgresql will accept it as an array.
 
    
 
    
-
    (defun list-to-string (val)
-  "Simply uses (format ..) to write a list out as a string"
-  (if (listp val)
-      (format nil "~a" val)
-      "unknown"))
+
    (defun list->string (lst)
+  "Here we have decided to insert :null if the input list is nil."
+  (if (listp lst)
+      (format nil "~a" lst)
+      :null))
+
+(defun list->arr (lst)
+  (if (null lst)
+      :null
+      (coerce lst 'vector)))
    diff --git a/doc/dao-classes.org b/doc/dao-classes.org index 8ce4171..1c3d3a2 100644 --- a/doc/dao-classes.org +++ b/doc/dao-classes.org @@ -28,12 +28,14 @@ slots in these classes will refer to columns in the database. ** Basic Dao Definition Examples A simple dao definition could look like this: #+BEGIN_SRC lisp - (defclass users () - ((name :col-type string :initarg :name :accessor name) - (creditcard :col-type (or db-null integer) :initarg :card :col-default :null) - (score :col-type bigint :col-default 0 :accessor score)) - (:metaclass dao-class) - (:keys name)) + (defclass users () + ((name :col-type string :initarg :name :accessor name) + (creditcard :col-type (or db-null integer) :initarg :card :col-default :null) + (score :col-type bigint :col-default 0 :accessor score) + (payment-history :col-type (or (array integer) db-null) + :initarg :payment-history :accessor payment-history)) + (:metaclass dao-class) + (:keys name)) #+END_SRC In this case the name of the users will be treated as the primary key (the :keys parameter at the end) and the database table is assumed to be named users because @@ -42,13 +44,23 @@ that is the name of the class and there was no :table-name parameter provided. reserved words, while possible using quotes, is generally not worth the additional trouble they cause.) -The name and score slots cannot be null because :col-type does not provide for db-null -as an optiona. The creditcard slot can be null and actually defaults to null. +In our example, the name and score slots cannot be null because :col-type does not provide for db-null as an optiona. The creditcard slot can be null and actually defaults to null. The :col-default :null specification ensures that the default in the database for this field is null, but it does not bound the slot to a default form. Thus, making an instance of the class without initializing this slot will leave it in an unbound state. +The payment-history slot is matched to a Postgresql column named =payment_history= +(remember that Postgresql uses underscores rather than hyphens) and that Postgresql +column is an array of integers. If we wanted a two dimensional array of integers, +the col-type would look like: +#+begin_src lisp +:col-type (or (array (array integer)) db-null) +#+end_src +If the value contained in the Postgresql slot payment-history is a common lisp array, +Postmodern will seamless handle the conversion to and from the common lisp array and +the Postgresql array. + An example of a class where the keys are set as multiple column keys is here: #+BEGIN_SRC lisp (defclass points () @@ -106,7 +118,12 @@ Now you can see why the double parens. We also specified that the table name is not "country" but "countries". (Some style guides recommend that table names be plural and references to rows -be singular.) +be singular.) NOTE: You can provide a fully qualified table name. In other words, +if you have +#+begin_src lisp +(:table-name a.countries) +#+end_src +Postmodern will look for the countries table in the "A" schema. When inheriting from DAO classes, a subclass' set of columns also contains all the columns of its superclasses. The primary key for such a class is the union @@ -241,7 +258,7 @@ The slot definitions in a table have several additional optional keyword paramet the departments table: #+begin_src lisp (defclass test-data-col-identity-with-references () - ((id :col-type integer :col-identity t :accessor id) + ((id :col-type integer :col-identity t :accessor id :col-primary-key t) (username :col-type text :unique t :initarg :username :accessor username) (department-id :col-type integer :col-references ((departments id)) :initarg :department-id :accessor department-id)) @@ -292,40 +309,60 @@ There may be times when the types of values in a dao slot do not have comparable One method would be to use text columns or jsonb columns in Postgresql and have functions that convert as necessary going back and forth. In the following example we will use text columns in Postgresql and write CL list data to string when we "export" the data to Postgresql and then convert from string when we "import" the data from Postgresql into a dao-class instance. -Consider the following dao-class definition. We have added additional column keyword parameters :col-export and :col-import. These parameters refer to functions which will convert the values from that slot to a valid Postgresql type (in our example, a string) on export to the database and from that Postgresql type to the type we want in this slot on import from the database.. +Consider the following dao-class definition. We have added additional column keyword parameters :col-export and :col-import. These parameters refer to functions which will convert the values from that slot to a valid Postgresql type (in our example, a string) on export to the database and from that Postgresql type to the type we want in this slot on import from the database. + +To make things slightly more interesting, we have two slots which are going to contain +lists, but one will export to a Postgresql column that contains strings and the other +will export to a Postgresql column that contains arrays of integers. #+begin_src lisp -(defclass listy () - ((id :col-type integer :col-identity t :accessor id) - (name :col-type text :col-unique t :col-check (:<> 'name "") - :initarg :name :accessor name) - (rlist :type list :col-type (or text db-null) :initarg :rlist :accessor rlist - :col-export list-to-string :col-import string-to-list) - (alist :type alist :col-type (or text db-null) :initarg :alist :accessor alist - :col-export list-to-string :col-import string-to-alist) - (plist :type plist :col-type (or text db-null) :initarg :plist :accessor plist - :col-export list-to-string :col-import string-to-plist)) - (:metaclass dao-class) - (:table-name listy)) + (defclass listy () + ((id :col-type integer :col-identity t :accessor id :col-primary-key t) + (name :col-type text :col-unique t :col-check (:<> 'name "") + :initarg :name :accessor name) + (r-list :col-type (or text db-null) :initarg :r-list :accessor r-list + :col-export list->string :col-import string->list) + (l-array :col-type (or (array integer) db-null) + :initarg :l-array :accessor l-array + :col-export list->arr :col-import array->list)) + (:metaclass dao-class) + (:table-name listy)) #+end_src -Now we need to define the import functions. When writing your import functions, pay attention to how you want to handle nil or :NULL values as well as how you might want to error check the conversion from a Postgresql datatype to a CL datatype. +Now we are going to define the import functions. When writing your import functions, pay attention to how you want to handle nil or :NULL values as well as how you might want to error check the conversion from a Postgresql datatype to a CL datatype. Just to show some of the +differences, we are going to translate :NULL strings in Postgresql to :NULL in common lisp +and we are going to translate :NULL arrays in Postgresql to nil in common lisp. #+begin_src lisp - (defun string-to-list (str) + (defun string->list (str) "Take a string representation of a list and return a lisp list. - Note that you need to handle :NULLs." + Note that you need to handle :NULLs." (cond ((eq str :NULL) :NULL) (str - (with-input-from-string (s str) - (read s))) + (with-input-from-string (s str) (read s))) + (t nil))) + + (defun array->list (arry) + "Here we have decided that we want the list be be nil rather than :NULL if the array is empty." + (cond ((eq arry :NULL) + nil) + ((vectorp arry) + (coerce arry 'list)) (t nil))) #+end_src -And now we need to define the export function. In our example we are just going to be using format to write the CL value to a string. You are responsible for writing an export function that does what you need. This example just tells Postgresql to insert a string "unknown" if the slot value is not a list. In real life you would need more error checking and condition handling. +And now the export functions. In our example we are just going to be using format to write the CL value to a string unless it is not a list. You are responsible for writing an export function that does what you need. This example just tells Postgresql to insert :NULL if the slot value is not a list. In real life you would need more error checking and condition handling. + +The list to array export function inserts :NULL if not a list and otherwise coerces the +list to a vector so that Postgresql will accept it as an array. #+begin_src lisp - (defun list-to-string (val) - "Simply uses (format ..) to write a list out as a string" - (if (listp val) - (format nil "~a" val) - "unknown")) + (defun list->string (lst) + "Here we have decided to insert :null if the input list is nil." + (if (listp lst) + (format nil "~a" lst) + :null)) + + (defun list->arr (lst) + (if (null lst) + :null + (coerce lst 'vector))) #+end_src ** method dao-keys (class) diff --git a/doc/json-from-postgres.html b/doc/json-from-postgres.html new file mode 100644 index 0000000..a47ca3e --- /dev/null +++ b/doc/json-from-postgres.html @@ -0,0 +1,777 @@ + + + + + + +Json From Postgresql/Postmodern + + + + + + + + +
    +
    +

    Json From Postgresql/Postmodern

    +
    + +
    +

    Intro

    +
    +

    +Suppose the front end of an app needs data as a json string and you need to get the data out of a database and convert it to that format. There are several ways to do that. We will look at doing it with basic sql, s-sql and a dao class. For purposes of this note, we are not looking at jsonb type columns in Postgresql. +

    + +

    +To make things a little more interesting, we are going to have a private column which we do not want to pass to the front-end, a Postgresql point datatype column and we will have a geometry type (using postgis) to compare that to the point type. If you do not have postgis installed, you can find installation instruction here: https://postgis.net/install/ or just read the the postgis stuff without trying to run the code. +

    + +

    +I am going to use the local-time library to deal with dates, so we need to do a little housework on that side as well. +

    +
    +
    (ql:quickload '(local-time cl-postgres+local-time))
+(local-time:set-local-time-cl-postgres-readers)
+
    +
    +
    +
    + +
    +

    The Basic SQL Version

    +
    +

    +Assuming you already have a database to use, let's create a couple of tables and insert some data. +

    +
    +
    (pomo:query "CREATE TABLE departments (
+      department_id bigint primary key,
+      name text
+      )")
+
+(pomo:query "CREATE TABLE employees (
+        employee_id serial primary key,
+        department_id integer references departments(department_id),
+        name text,
+        start_date date,
+        contact text[],
+        private text,
+        lat_long point,
+        geom geometry(point, 4326)json-from-p
+        );")
+
+(pomo:query "INSERT INTO departments
+   (department_id, name)
+  VALUES
+   (1, 'spatial'),
+   (2, 'cloud')")
+
+(pomo:query "INSERT INTO employees
+ (department_id, name, start_date, contact, private, lat_long, geom)
+VALUES
+ (1, 'Maja',   '2018/09/02', '{"084-767-734","071-334-8473"}', 'not allowed',
+ '(59.334591, 18.063240)', 'POINT(59.334591 18.063240)'),
+ (1, 'Liam', '2019/09/02', '{"084-767-734","071-334-8472"}','private',
+ '(57.708870, 11.974560)','POINT(57.708870 11.974560)'),
+ (2, 'Matteo',  '2019/11/01', '{"084-767-734","071-334-8476"}', 'burn before reading',
+   '(58.283489,12.285821)','POINT(58.283489 12.285821)'),
+ (2, 'Astrid',    '2020/10/01',  '{"084-767-734","071-334-8465"}', 'abandon all hope',
+  '(57.751442, 16.628838)', 'POINT(57.751442 16.628838)');")
+
    +
    +

    +One difference to note is that the data for the lat_long point data type has a comma, but the geom geometry data type does not have a comma. No, I do not know why the syntax difference. +

    + +

    +I want to flag something that can surprise people. The lat_long column is a Postgresql point datatype. That means it is an array. As you may recall, Postgresql arrays start at 1, not 0. Except here. If you wanted just the latitude for the row with the employee_id of 1, you would actually call for array 0. +

    +
    +
    (pomo:query "select lat_long[0] from employees where employee_id=1" :single)
+59.334591d0
+
    +
    +

    +If you wanted to get the latitude and longitude in a list, it would look like: +

    +
    +
    (pomo:query "select lat_long[0], lat_long[1] from employees where employee_id=1")
+((59.334591d0 18.06324d0))
+
    +
    + +

    +If you ran a basic query to see how Postgresql was storing that geometry type, it would look something like this: +

    + +
    +
      (pomo:query "select geom from employees where employee_id=1" :single)
+"0101000020E61000009A44BDE0D3AA4D408ECC237F30103240"
+
    +
    +

    +To actually get the separate latitude and longitude from the geom column, you need to use Postgresql functions st_x and st_y like so: +

    +
    +
    (query "select st_x(geom), st_y(geom) from employees where employee_id=1")
+((59.334591d0 18.06324d0))
+
    +
    + +

    +Now on to getting this information as json. Postgresql gives you a json generator function that takes a tuple and returns a json dictionary. So, for example: +

    +
    +
    (query "select row_to_json(employees) from employees where employee_id=1")
+(("{\"employee_id\":1,
+    \"department_id\":1,
+    \"name\":\"Maja\",
+    \"start_date\":\"2018-09-02\",
+    \"contact\":[\"084-767-734\",\"071-334-8473\"],
+    \"private\":\"not allowed\",
+    \"lat_long\":\"(59.334591,18.06324)\",
+    \"geom\":{\"type\":\"Point\",\"coordinates\":[59.334591,18.06324]}}"))
+
    +
    +

    +You can see that it would automatically break out the geom data. However, as written, it has the fatal flaw of also collecting the private info. That can get solved with a slight modification: +

    +
    +
    (query "select row_to_json(e)
+        from
+          (select employee_id, department_id, name, start_date, contact, lat_long, geom
+           from employees where employee_id=1) e")
+(("{\"employee_id\":1,
+ \"department_id\":1,
+ \"name\":\"Maja\",
+ \"start_date\":\"2018-09-02\",
+ \"contact\":[\"084-767-734\",\"071-334-8473\"],
+ \"lat_long\":\"(59.334591,18.06324)\",
+ \"geom\":{\"type\":\"Point\",\"coordinates\":[59.334591,18.06324]}}"))
+
    +
    +

    +You can also aggregate rows using the Postgresql json_agg function. +

    +
    +
    (query "select json_agg(e)
+        from
+          (select employee_id, department_id, name, start_date, contact, lat_long, geom
+           from employees)
+        e")
+
    +
    +

    +You could skip the Postgresql json function and ask Postmodern to return the query as a json object expressed as a string. One thing to note is that Postmodern will return the labels as camelCase rather than Postgresql returning them as underscores: +

    +
    +
     (query "select employee_id, department_id, name, start_date, contact, lat_long, geom
+         from employees
+         where employee_id=1"
+        :json-str)
+"{\"employeeId\":1,\"departmentId\":1,\"name\":\"Maja\",\"startDate\":\"{2018-09-01T20:00:00.000000-04:00}\",\"contact\":[\"084-767-734\",\"071-334-8473\"],\"latLong\":[59.334591,18.06324],\"geom\":\"0101000020E61000009A44BDE0D3AA4D408ECC237F30103240\"}"
+
    +
    +

    +You would need to do a little more work in order to get the desired latitude and longitude out of the geom value. +

    +
    +
    (query "select employee_id, department_id, name, start_date, contact, lat_long, st_x(geom) as lat, st_y(geom) as long
+             from employees where employee_id=1" :json-str)
+
+"{\"employeeId\":1,\"departmentId\":1,\"name\":\"Maja\",\"startDate\":\"{2018-09-01T20:00:00.000000-04:00}\",\"contact\":[\"084-767-734\",\"071-334-8473\"],\"latLong\":[59.334591,18.06324],\"lat\":59.334591,\"long\":18.06324}"
+
    +
    +

    +Both the Postgresql function and the Postmodern return type approach can be applied to the end result of more complicated queries with joins, CTEs and other tools of the trade. Which is actually why we have the department table in this example. Instead of having the department-id in the json we are sending to the front end, let's have the department name. +

    + +

    +First the using the Postgresql row-to-json function: +

    +
    +
    (query "select row_to_json(e)
+        from  (select employee_id, departments.name as department_name, employees.name as employee_name,
+                      start_date, contact, lat_long, geom
+               from employees
+               left join departments
+               on departments.department_id = employees.department_id
+               where employee_id=1) e")
+(("{\"employee_id\":1,\"department_name\":\"spatial\",\"employee_name\":\"Maja\",\"start_date\":\"2018-09-02\",\"contact\":[\"084-767-734\",\"071-334-8473\"],\"lat_long\":\"(59.334591,18.06324)\",\"geom\":{\"type\":\"Point\",\"coordinates\":[59.334591,18.06324]}}"))
+
    +
    +

    +Now the sql using the Postmodern :json-str keyword parameter for query: +

    +
    +
    (query "select employee_id, departments.name as department_name, employees.name as employee_name,
+               start_date, contact, lat_long, geom
+        from employees
+        left join departments
+        on departments.department_id = employees.department_id
+        where employee_id=1"
+     :json-str))
+"{\"employeeId\":1,\"departmentName\":\"spatial\",\"employeeName\":\"Maja\",\"startDate\":\"{2018-09-01T20:00:00.000000-04:00}\",\"contact\":[\"084-767-734\",\"071-334-8473\"],\"latLong\":[59.334591,18.06324],\"geom\":\"0101000020E61000009A44BDE0D3AA4D408ECC237F30103240\"}"
+
    +
    +
    +
    + +
    +

    The Basic S-SQL Version

    +
    +

    +Assuming you already have a database to use, let's create a couple of tables and insert some data. +

    +
    +
      (pomo:query (:create-table 'departments
+                             ((department-id :type (or pomo:db-null bigint) :primary-key t)
+                              (name :type (or pomo:db-null text)))))
+
+  (pomo:query (:create-table employees
+                             ((employee_id :type serial :primary-key t)
+                              (department_id :type (or pomo:db-null integer) :references ((departments department_id)))
+                              (name :type (or pomo:db-null text))
+                              (start_date :type (or pomo:db-null date))
+                              (contact :type (or pomo:db-null text[]))
+                              (private :type (or pomo:db-null text))
+                              (lat_long :type (or pomo:db-null point))
+                              (geom :type (or pomo:db-null (geometry point 4326))))))
+
+  (pomo:query (:insert-rows-into 'departments
+               :columns 'deparment-id 'name
+               :values '((1 "spatial") (2 "cloud"))))
+
+(pomo:sql (:insert-rows-into 'employees
+               :columns 'department-id 'name 'start-date 'contact 'private 'lat_long 'geom
+               :values
+         '((1 "Maja"   "2018/09/02" #("084-767-734""071-334-8473") "not allowed"
+         "(59.334591, 18.063240)" "POINT(59.334591 18.063240)")
+         (1 "Liam" "2019/09/02" #("084-767-734" "071-334-8472") "private"
+         "(57.708870, 11.974560)" "POINT(57.708870 11.974560)")
+         (2 "Matteo"  "2019/11/01" #("084-767-734""071-334-8476") "burn before reading"
+            "(58.28348912.285821)" "POINT(58.283489 12.285821)")
+         (2 "Astrid"    "2020/10/01"  #("084-767-734""071-334-8465") "abandon all hope"
+            "(57.751442, 16.628838)" "POINT(57.751442 16.628838)"))))
+
    +
    +

    +One difference to note is that the data for the lat_long point data type has a comma, but the geom geometry data type does not have a comma. No, I do not know why the syntax difference in Postgresql (Postmodern needs it to properly match Postgresql's syntax here). +

    + +

    +I want to flag something that can surprise people. The lat_long column is a Postgresql point datatype. That means it is an array. As you may recall, Postgresql arrays start at 1, not 0. Except here. If you wanted just the latitude for the row with the employee_id of 1, you would actually call for array 0. +

    +
    +
    (pomo:query (:select (:[] 'lat_long 0) :from 'employees :where (:= 'employee_id 1)) :single)
+59.334591d0
+
    +
    +

    +If you wanted the latitude and longitude in alist, the query would look like: +

    +
    +
    (pomo:query (:select (:[] 'lat_long 0) (:[] 'lat_long 1) :from 'employees :where (:= 'employee_id 1)))
+((59.334591d0 18.06324d0))
+
    +
    +

    +If you ran a basic query to see how Postgresql was storing that geometry type, it would look something like this: +

    +
    +
    (pomo:query (:select 'geom :from 'employees :where (:= 'employee-id 1)) :single)
+  "0101000020E61000009A44BDE0D3AA4D408ECC237F30103240"
+
    +
    +

    +To actually get the separate latitude and longitude from the geom column, you need to use Postgresql functions st_x and st_y like so: +

    +
    +
    (with-connection *dba-connection* (query (:select (:st-x 'geom) (:st-y 'geom) :from 'employees :where (:= 'employee_id 1))))
+((59.334591d0 18.06324d0))
+
    +
    +

    +Now on to getting this information as json. Postgresql gives you a json generator function that takes a tuple and returns a json dictionary. So, for example: +

    +
    +
    (pomo:query (:select (:row-to-json 'employees) :from 'employees :where (:= 'employee-id 1)))
+  (("{\"employee_id\":1,
+      \"department_id\":1,
+      \"name\":\"Maja\",
+      \"start_date\":\"2018-09-02\",
+      \"contact\":[\"084-767-734\",\"071-334-8473\"],
+      \"private\":\"not allowed\",
+      \"lat_long\":\"(59.334591,18.06324)\",
+      \"geom\":{\"type\":\"Point\",\"coordinates\":[59.334591,18.06324]}}"))
+
    +
    +

    +You can see that it would automatically break out the geom data. However, as written, it has the fatal flaw of also collecting the private info. That can get solved with a slight modification: +

    +
    +
    (query (:select (:row-to-json 'e)
+        :from (:as (:select 'employee-id 'department-id 'name 'start-date 'contact
+                            'lat-long 'geom
+                    :from 'employees
+                    :where (:= 'employee-id 1))
+                   'e)))
+(("{\"employee_id\":1,
+   \"department_id\":1,
+   \"name\":\"Maja\",
+   \"start_date\":\"2018-09-02\",
+   \"contact\":[\"084-767-734\",\"071-334-8473\"],
+   \"lat_long\":\"(59.334591,18.06324)\",
+   \"geom\":{\"type\":\"Point\",\"coordinates\":[59.334591,18.06324]}}"))
+
    +
    +

    +You can also aggregate rows using the Postgresql json_agg function. +

    +
    +
    (query (:select (:json-agg 'e)
+        :from (:as (:select 'employee-id 'department-id 'name 'start-date 'contact
+                            'lat-long 'geom
+                    :from 'employees)
+                   'e)))
+
    +
    +

    +You could skip the Postgresql json function and ask Postmodern to return the query as a json object expressed as a string. One thing to note is that Postmodern will return the labels as camelCase rather than Postgresql returning them as underscores: +

    +
    +
      (query (:select 'employee-id 'department-id 'name 'start-date 'contact 'lat-long 'geom
+          :from 'employees
+          :where (:= 'employee-id 1)) :json-str)
+
+"{\"employeeId\":1,\"departmentId\":1,\"name\":\"Maja\",\"startDate\":\"{2018-09-01T20:00:00.000000-04:00}\",\"contact\":[\"084-767-734\",\"071-334-8473\"],\"latLong\":[59.334591,18.06324],\"geom\":\"0101000020E61000009A44BDE0D3AA4D408ECC237F30103240\"}"
+
    +
    +

    +You would need to do a little more work in order to get the desired latitude and longitude out of the geom value. +

    +
    +
    (query (:select 'employee-id 'department-id 'name 'start-date 'contact 'lat-long
+                (:st-x 'geom) (:st-y 'geom)
+                :from 'employees
+                :where (:= 'employee-id 1))
+       :json-str)
+"{\"employeeId\":1,\"departmentId\":1,\"name\":\"Maja\",\"startDate\":\"{2018-09-01T20:00:00.000000-04:00}\",\"contact\":[\"084-767-734\",\"071-334-8473\"],\"latLong\":[59.334591,18.06324],\"stX\":59.334591,\"stY\":18.06324}"
+
    +
    +

    +Both the Postgresql function and the Postmodern return type approach can be applied to the end result of more complicated queries with joins, CTEs and other tools of the trade. Which is actually why we have the department table in this example. Instead of having the department-id in the json we are sending to the front end, let's have the department name. +

    + +

    +First the s-sql using the Postgresql row-to-json function: +

    +
    +
     (query (:select (:row-to-json 'e)
+         :from (:as (:select 'employee-id (:as 'departments.name 'department_name)
+                             (:as 'employees.name 'employee-name)
+                             'start-date 'contact 'lat-long
+                             (:st-x 'geom) (:st-y 'geom)
+                     :from 'employees
+                     :left-join 'departments
+                     :on (:= 'departments.department-id 'employees.department-id)
+                     :where (:= 'employee-id 1))
+                'e)))
+
+(("{\"employee_id\":1,\"department_name\":\"spatial\",\"employee_name\":\"Maja\",\"start_date\":\"2018-09-02\",\"contact\":[\"084-767-734\",\"071-334-8473\"],\"lat_long\":\"(59.334591,18.06324)\",\"st_x\":59.334591,\"st_y\":18.06324}"))
+
    +
    +

    +Now the s-sql using the Postmodern :json-str keyword parameter for query: +

    +
    +
    (query (:select 'employee-id (:as 'departments.name 'department-name)
+                (:as 'employees.name 'employee-name)
+                'start-date 'contact 'lat-long (:st-x 'geom) (:st-y 'geom)
+        :from 'employees
+        :left-join 'departments
+        :on (:= 'departments.department-id 'employees.department-id)
+        :where (:= 'employee-id 1))
+       :json-str)
+"{\"employeeId\":1,\"departmentName\":\"spatial\",\"employeeName\":\"Maja\",\"startDate\":\"{2018-09-01T20:00:00.000000-04:00}\",\"contact\":[\"084-767-734\",\"071-334-8473\"],\"latLong\":[59.334591,18.06324],\"stX\":59.334591,\"stY\":18.06324}"
+
    +
    +
    +
    + +
    +

    The Basic Dao-class Version

    +
    +

    +Assuming you already have a database to use, let's create a couple of dao classes, their associated tables and insert some data. Assume we decide we want to keep the geom as a list of latitude and longitude in the geom slot. That means we need import and export functions. +

    +
    +
    (defclass departments ()
+  ((department-id :col-type serial :initarg :department-id :accessor department-id
+                  :col-primary-key t)
+   (name :col-type (or text pomo:db-null) :initarg :name :accessor name))
+  (:metaclass pomo:dao-class))
+
+(pomo:execute (dao-table-definition 'departments))
+
+(defclass employees ()
+  ((employee-id :col-type serial :initarg :employee-id :accessor employee-id
+                :col-primary-key t)
+   (department-id :col-type integer :initarg :department-id :accessor department-id
+                  :col-references ((departments department-id)))
+   (name :col-type text :initarg name :accessor name)
+   (start-date :col-type (or date pomo:db-null) :initarg start-date :accessor start-date)
+   (contact :col-type (or pomo:db-null (array text)) :initarg contact :accessor contact)
+   (private :col-type (or pomo:db-null text) :initarg private :accessor private)
+   (lat-long :col-type (or pomo:db-null point) :initarg lat-long :accessor lat-long)
+   (geom :col-type (or pomo:db-null (geometry point 4326)) :initarg geom :accessor geom
+         :col-import geom->wkb-point))
+  (:metaclass pomo:dao-class))
+
+;; make-doa creates an instance of the dao and saves it in the database
+(pomo:make-dao 'departments :department-id 1 :name "spatial")
+(pomo:make-dao 'departments :department-id 2 :name "cloud")
+
+(pomo:make-dao 'employees :department-id 1 :name "Maja" :start-date "2018/09/02"
+                          :contact #("084-767-734","071-334-8473")
+                          :private "not allowed" :lat-long "(59.334591, 18.063240)"
+                          :geom "POINT(59.334591 18.063240)")
+
+(pomo:make-dao 'employees :department-id 1 :name "Liam" :start-date "2019/09/02"
+                          :contact #("084-767-734","071-334-8472")
+                          :private "private" :lat-long "(57.708870, 11.974560)"
+                          :geom "POINT((57.708870 11.974560)")
+
+(pomo:make-dao 'employees :department-id 2 :name "Matteo" :start-date "2019/11/01"
+                          :contact #("084-767-734","071-334-8476")
+                          :private "burn before reading" :lat-long "(58.283489, 12.285821)"
+                          :geom "POINT(58.283489 12.285821)")
+
+(pomo:make-dao 'employees :department-id 2 :name "Astrid" :start-date "2020/10/01"
+                          :contact #("084-767-734","071-334-8465")
+                          :private "abandon all hope" :lat-long "(57.751442, 16.628838)"
+                          :geom "POINT(57.751442 16.628838)")
+
    +
    +

    +One difference to note is that the data for the lat_long point data type has a comma, but the geom geometry data type does not have a comma. No, I do not know why the syntax difference. +

    + +

    +Now the problem. If you ran a basic query to see how Postgresql was storing that geometry type, it would look something like this: +

    + +
    +
      (pomo:query "select geom from employees where employee_id=1" :single)
+"0101000020E61000009A44BDE0D3AA4D408ECC237F30103240"
+
    +
    + +

    +We need import and export functions that implement the opengis specification in order to implement the import and export functions for the geom slot. See https://www.ogc.org/standards/sfs. Fortunately J.P. Larocue created the cl-wkb package (accessed via quicklisp with quickloading the +cl-ewkb system) and we can create an import function with a combination of using ironclad's hex-string-to-byte-array and cl-wkb's decode function. So let's do that. +

    +
    +
    (defun geom->wkb-point (input)
+  "Takes a hexstring that represents a geometry point from postgresql and returns a cl-wkb:point class instance"
+  (cl-wkb:decode (ironclad:hex-string-to-byte-array input)))
+
    +
    +

    +Now we can check whether we succeeded by seeing whether the x point is the latitude we expected: +

    +
    +
      (cl-wkb:x (geom (pomo:get-dao 'employees 1)))
+59.334591d0
+
    +
    + +

    +We still need to get from the dao-class to json. You could do something like just run cl-json's =encode-json=function on a dao-object like so: +

    +
    +
    (cl-json:encode-json (pomo:get-dao 'employees 1))
+
+{"employeeId":1,
+ "departmentId":1,
+ "name":"Maja",
+ "startDate":{"day":6759,"sec":0,"nsec":0},
+ "contact":["084-767-734","071-334-8473"],
+ "private":"not allowed",
+ "latLong":[59.334591,18.06324],
+ "geom":{"geomtype":536870913,"srid":4326,"pointPrimitive":{"x":59.334591,"y":18.06324,"z":0.0,"m":0.0}}}
+
    +
    +

    +Looking at the result, we have two issues. First, the start date seems to have lost its senses. Second, it is collecting and passing on the private data to the front end, which we explicitly did not want to do. +

    + +

    +Just checking on the date situation: +

    +
    +
    (start-date (pomo:get-dao 'employees 1)))
+@2018-09-01T20:00:00.000000-04:00
+
    +
    +

    +That works, so it is something on the cl-json side that we will have to work around. Let's turn to the private data issue. +

    + +

    +One solution would be to create a dao-class that is only a subset of the employees table (minus the private data) and set pomo:*ignore-unknonw-columns* to t. (If we did not set pomo:*ignore-unknonw-columns*, we would generate an error complaining that the dao +was not in sync with the table.) Let's do that: +

    +
    +
      (defclass employees-minus-private ()
+            ((employee-id :col-type serial :initarg :employee-id :accessor employee-id :col-primary-key t)
+             (department-id :col-type integer :initarg :department-id :accessor department-id :col-references ((departments department-id)))
+             (name :col-type text :initarg name :accessor name)
+             (start-date :col-type (or date pomo:db-null) :initarg start-date :accessor start-date)
+             (contact :col-type (or pomo:db-null (array text)) :initarg contact :accessor contact)
+             (lat-long :col-type (or pomo:db-null point) :initarg lat-long :accessor lat-long)
+             (geom :col-type (or pomo:db-null (geometry point 4326)) :initarg geom :accessor geom
+                   :col-import geom->wkb-point))
+            (:table-name employees)
+            (:metaclass pomo:dao-class))
+
+(setf pomo:*IGNORE-UNKNOWN-COLUMNS* t)
+
    +
    +

    +And now cl-json generates a json string without the +

    +
    +
    (cl-json:encode-json (pomo:get-dao 'employees-minus-private 1))
+{"employeeId":1,"departmentId":1,"name":"Maja","startDate":3744835200,"contact":["084-767-734","071-334-8473"],"latLong":[59.334591,18.06324],"geom":{"geomtype":536870913,"srid":4326,"pointPrimitive":{"x":59.334591,"y":18.06324,"z":0.0,"m":0.0}}}
+
    +
    +

    +If you are using a different CL json library, you would have to write your own functions to convert from a dao-class object to something that, e.g. jonathan or jsown could use. +

    + +

    +Handling joins in a dao-class are more complicated - the Postmodern dao-class is intended to be simple, not recreate Hibernate or SQLAlchemy. You can see an example at https://marijnhaverbeke.nl/postmodern/dao-classes.html#multi-table-dao-class-object. +

    +
    +
    +
    + + diff --git a/doc/json-from-postgres.org b/doc/json-from-postgres.org new file mode 100644 index 0000000..36964b4 --- /dev/null +++ b/doc/json-from-postgres.org @@ -0,0 +1,420 @@ +#+TITLE: Json From Postgresql/Postmodern +#+OPTIONS: num:nil +#+HTML_HEAD: +#+HTML_HEAD: +#+OPTIONS: ^:nil +#+OPTIONS: toc:2 + +* Intro + +Suppose the front end of an app needs data as a json string and you need to get the data out of a database and convert it to that format. There are several ways to do that. We will look at doing it with basic sql, s-sql and a dao class. For purposes of this note, we are not looking at jsonb type columns in Postgresql. + +To make things a little more interesting, we are going to have a private column which we do not want to pass to the front-end, a Postgresql point datatype column and we will have a geometry type (using postgis) to compare that to the point type. If you do not have postgis installed, you can find installation instruction here: [[https://postgis.net/install/]] or just read the the postgis stuff without trying to run the code. + +I am going to use the local-time library to deal with dates, so we need to do a little housework on that side as well. +#+begin_src lisp +(ql:quickload '(local-time cl-postgres+local-time)) +(local-time:set-local-time-cl-postgres-readers) +#+end_src + +* The Basic SQL Version +:PROPERTIES: +:CUSTOM_ID: sql-version +:END: +Assuming you already have a database to use, let's create a couple of tables and insert some data. +#+begin_src lisp + (pomo:query "CREATE TABLE departments ( + department_id bigint primary key, + name text + )") + + (pomo:query "CREATE TABLE employees ( + employee_id serial primary key, + department_id integer references departments(department_id), + name text, + start_date date, + contact text[], + private text, + lat_long point, + geom geometry(point, 4326)json-from-p + );") + + (pomo:query "INSERT INTO departments + (department_id, name) + VALUES + (1, 'spatial'), + (2, 'cloud')") + + (pomo:query "INSERT INTO employees + (department_id, name, start_date, contact, private, lat_long, geom) + VALUES + (1, 'Maja', '2018/09/02', '{"084-767-734","071-334-8473"}', 'not allowed', + '(59.334591, 18.063240)', 'POINT(59.334591 18.063240)'), + (1, 'Liam', '2019/09/02', '{"084-767-734","071-334-8472"}','private', + '(57.708870, 11.974560)','POINT(57.708870 11.974560)'), + (2, 'Matteo', '2019/11/01', '{"084-767-734","071-334-8476"}', 'burn before reading', + '(58.283489,12.285821)','POINT(58.283489 12.285821)'), + (2, 'Astrid', '2020/10/01', '{"084-767-734","071-334-8465"}', 'abandon all hope', + '(57.751442, 16.628838)', 'POINT(57.751442 16.628838)');") +#+end_src +One difference to note is that the data for the lat_long point data type has a comma, but the geom geometry data type does not have a comma. No, I do not know why the syntax difference. + +I want to flag something that can surprise people. The lat_long column is a Postgresql point datatype. That means it is an array. As you may recall, Postgresql arrays start at 1, not 0. Except here. If you wanted just the latitude for the row with the employee_id of 1, you would actually call for array 0. +#+begin_src lisp + (pomo:query "select lat_long[0] from employees where employee_id=1" :single) + 59.334591d0 +#+end_src +If you wanted to get the latitude and longitude in a list, it would look like: +#+begin_src lisp +(pomo:query "select lat_long[0], lat_long[1] from employees where employee_id=1") +((59.334591d0 18.06324d0)) +#+end_src + +If you ran a basic query to see how Postgresql was storing that geometry type, it would look something like this: + +#+begin_src lisp + (pomo:query "select geom from employees where employee_id=1" :single) +"0101000020E61000009A44BDE0D3AA4D408ECC237F30103240" +#+end_src +To actually get the separate latitude and longitude from the geom column, you need to use Postgresql functions st_x and st_y like so: +#+begin_src lisp +(query "select st_x(geom), st_y(geom) from employees where employee_id=1") +((59.334591d0 18.06324d0)) +#+end_src + +Now on to getting this information as json. Postgresql gives you a json generator function that takes a tuple and returns a json dictionary. So, for example: +#+begin_src lisp +(query "select row_to_json(employees) from employees where employee_id=1") +(("{\"employee_id\":1, + \"department_id\":1, + \"name\":\"Maja\", + \"start_date\":\"2018-09-02\", + \"contact\":[\"084-767-734\",\"071-334-8473\"], + \"private\":\"not allowed\", + \"lat_long\":\"(59.334591,18.06324)\", + \"geom\":{\"type\":\"Point\",\"coordinates\":[59.334591,18.06324]}}")) +#+end_src +You can see that it would automatically break out the geom data. However, as written, it has the fatal flaw of also collecting the private info. That can get solved with a slight modification: +#+begin_src lisp +(query "select row_to_json(e) + from + (select employee_id, department_id, name, start_date, contact, lat_long, geom + from employees where employee_id=1) e") +(("{\"employee_id\":1, + \"department_id\":1, + \"name\":\"Maja\", + \"start_date\":\"2018-09-02\", + \"contact\":[\"084-767-734\",\"071-334-8473\"], + \"lat_long\":\"(59.334591,18.06324)\", + \"geom\":{\"type\":\"Point\",\"coordinates\":[59.334591,18.06324]}}")) +#+end_src +You can also aggregate rows using the Postgresql json_agg function. +#+begin_src lisp +(query "select json_agg(e) + from + (select employee_id, department_id, name, start_date, contact, lat_long, geom + from employees) + e") +#+end_src +You could skip the Postgresql json function and ask Postmodern to return the query as a json object expressed as a string. One thing to note is that Postmodern will return the labels as camelCase rather than Postgresql returning them as underscores: +#+begin_src lisp + (query "select employee_id, department_id, name, start_date, contact, lat_long, geom + from employees + where employee_id=1" + :json-str) + "{\"employeeId\":1,\"departmentId\":1,\"name\":\"Maja\",\"startDate\":\"{2018-09-01T20:00:00.000000-04:00}\",\"contact\":[\"084-767-734\",\"071-334-8473\"],\"latLong\":[59.334591,18.06324],\"geom\":\"0101000020E61000009A44BDE0D3AA4D408ECC237F30103240\"}" +#+end_src +You would need to do a little more work in order to get the desired latitude and longitude out of the geom value. +#+begin_src lisp + (query "select employee_id, department_id, name, start_date, contact, lat_long, st_x(geom) as lat, st_y(geom) as long + from employees where employee_id=1" :json-str) + + "{\"employeeId\":1,\"departmentId\":1,\"name\":\"Maja\",\"startDate\":\"{2018-09-01T20:00:00.000000-04:00}\",\"contact\":[\"084-767-734\",\"071-334-8473\"],\"latLong\":[59.334591,18.06324],\"lat\":59.334591,\"long\":18.06324}" + #+end_src +Both the Postgresql function and the Postmodern return type approach can be applied to the end result of more complicated queries with joins, CTEs and other tools of the trade. Which is actually why we have the department table in this example. Instead of having the department-id in the json we are sending to the front end, let's have the department name. + +First the using the Postgresql =row-to-json= function: +#+begin_src lisp + (query "select row_to_json(e) + from (select employee_id, departments.name as department_name, employees.name as employee_name, + start_date, contact, lat_long, geom + from employees + left join departments + on departments.department_id = employees.department_id + where employee_id=1) e") + (("{\"employee_id\":1,\"department_name\":\"spatial\",\"employee_name\":\"Maja\",\"start_date\":\"2018-09-02\",\"contact\":[\"084-767-734\",\"071-334-8473\"],\"lat_long\":\"(59.334591,18.06324)\",\"geom\":{\"type\":\"Point\",\"coordinates\":[59.334591,18.06324]}}")) +#+end_src +Now the sql using the Postmodern :json-str keyword parameter for query: +#+begin_src lisp +(query "select employee_id, departments.name as department_name, employees.name as employee_name, + start_date, contact, lat_long, geom + from employees + left join departments + on departments.department_id = employees.department_id + where employee_id=1" + :json-str)) +"{\"employeeId\":1,\"departmentName\":\"spatial\",\"employeeName\":\"Maja\",\"startDate\":\"{2018-09-01T20:00:00.000000-04:00}\",\"contact\":[\"084-767-734\",\"071-334-8473\"],\"latLong\":[59.334591,18.06324],\"geom\":\"0101000020E61000009A44BDE0D3AA4D408ECC237F30103240\"}" +#+end_src + +* The Basic S-SQL Version +:PROPERTIES: +:CUSTOM_ID: s-sql-version +:END: +Assuming you already have a database to use, let's create a couple of tables and insert some data. +#+begin_src lisp + (pomo:query (:create-table 'departments + ((department-id :type (or pomo:db-null bigint) :primary-key t) + (name :type (or pomo:db-null text))))) + + (pomo:query (:create-table employees + ((employee_id :type serial :primary-key t) + (department_id :type (or pomo:db-null integer) :references ((departments department_id))) + (name :type (or pomo:db-null text)) + (start_date :type (or pomo:db-null date)) + (contact :type (or pomo:db-null text[])) + (private :type (or pomo:db-null text)) + (lat_long :type (or pomo:db-null point)) + (geom :type (or pomo:db-null (geometry point 4326)))))) + + (pomo:query (:insert-rows-into 'departments + :columns 'deparment-id 'name + :values '((1 "spatial") (2 "cloud")))) + +(pomo:sql (:insert-rows-into 'employees + :columns 'department-id 'name 'start-date 'contact 'private 'lat_long 'geom + :values + '((1 "Maja" "2018/09/02" #("084-767-734""071-334-8473") "not allowed" + "(59.334591, 18.063240)" "POINT(59.334591 18.063240)") + (1 "Liam" "2019/09/02" #("084-767-734" "071-334-8472") "private" + "(57.708870, 11.974560)" "POINT(57.708870 11.974560)") + (2 "Matteo" "2019/11/01" #("084-767-734""071-334-8476") "burn before reading" + "(58.28348912.285821)" "POINT(58.283489 12.285821)") + (2 "Astrid" "2020/10/01" #("084-767-734""071-334-8465") "abandon all hope" + "(57.751442, 16.628838)" "POINT(57.751442 16.628838)")))) +#+end_src +One difference to note is that the data for the lat_long point data type has a comma, but the geom geometry data type does not have a comma. No, I do not know why the syntax difference in Postgresql (Postmodern needs it to properly match Postgresql's syntax here). + +I want to flag something that can surprise people. The lat_long column is a Postgresql point datatype. That means it is an array. As you may recall, Postgresql arrays start at 1, not 0. Except here. If you wanted just the latitude for the row with the employee_id of 1, you would actually call for array 0. +#+begin_src lisp +(pomo:query (:select (:[] 'lat_long 0) :from 'employees :where (:= 'employee_id 1)) :single) +59.334591d0 +#+end_src +If you wanted the latitude and longitude in alist, the query would look like: +#+begin_src lisp + (pomo:query (:select (:[] 'lat_long 0) (:[] 'lat_long 1) :from 'employees :where (:= 'employee_id 1))) + ((59.334591d0 18.06324d0)) +#+end_src +If you ran a basic query to see how Postgresql was storing that geometry type, it would look something like this: +#+begin_src lisp + (pomo:query (:select 'geom :from 'employees :where (:= 'employee-id 1)) :single) + "0101000020E61000009A44BDE0D3AA4D408ECC237F30103240" +#+end_src +To actually get the separate latitude and longitude from the geom column, you need to use Postgresql functions st_x and st_y like so: +#+begin_src lisp +(with-connection *dba-connection* (query (:select (:st-x 'geom) (:st-y 'geom) :from 'employees :where (:= 'employee_id 1)))) +((59.334591d0 18.06324d0)) +#+end_src +Now on to getting this information as json. Postgresql gives you a json generator function that takes a tuple and returns a json dictionary. So, for example: +#+begin_src lisp +(pomo:query (:select (:row-to-json 'employees) :from 'employees :where (:= 'employee-id 1))) + (("{\"employee_id\":1, + \"department_id\":1, + \"name\":\"Maja\", + \"start_date\":\"2018-09-02\", + \"contact\":[\"084-767-734\",\"071-334-8473\"], + \"private\":\"not allowed\", + \"lat_long\":\"(59.334591,18.06324)\", + \"geom\":{\"type\":\"Point\",\"coordinates\":[59.334591,18.06324]}}")) +#+end_src +You can see that it would automatically break out the geom data. However, as written, it has the fatal flaw of also collecting the private info. That can get solved with a slight modification: +#+begin_src lisp + (query (:select (:row-to-json 'e) + :from (:as (:select 'employee-id 'department-id 'name 'start-date 'contact + 'lat-long 'geom + :from 'employees + :where (:= 'employee-id 1)) + 'e))) + (("{\"employee_id\":1, + \"department_id\":1, + \"name\":\"Maja\", + \"start_date\":\"2018-09-02\", + \"contact\":[\"084-767-734\",\"071-334-8473\"], + \"lat_long\":\"(59.334591,18.06324)\", + \"geom\":{\"type\":\"Point\",\"coordinates\":[59.334591,18.06324]}}")) +#+end_src +You can also aggregate rows using the Postgresql json_agg function. +#+begin_src lisp + (query (:select (:json-agg 'e) + :from (:as (:select 'employee-id 'department-id 'name 'start-date 'contact + 'lat-long 'geom + :from 'employees) + 'e))) +#+end_src +You could skip the Postgresql json function and ask Postmodern to return the query as a json object expressed as a string. One thing to note is that Postmodern will return the labels as camelCase rather than Postgresql returning them as underscores: +#+begin_src lisp + (query (:select 'employee-id 'department-id 'name 'start-date 'contact 'lat-long 'geom + :from 'employees + :where (:= 'employee-id 1)) :json-str) + +"{\"employeeId\":1,\"departmentId\":1,\"name\":\"Maja\",\"startDate\":\"{2018-09-01T20:00:00.000000-04:00}\",\"contact\":[\"084-767-734\",\"071-334-8473\"],\"latLong\":[59.334591,18.06324],\"geom\":\"0101000020E61000009A44BDE0D3AA4D408ECC237F30103240\"}" +#+end_src +You would need to do a little more work in order to get the desired latitude and longitude out of the geom value. +#+begin_src lisp + (query (:select 'employee-id 'department-id 'name 'start-date 'contact 'lat-long + (:st-x 'geom) (:st-y 'geom) + :from 'employees + :where (:= 'employee-id 1)) + :json-str) + "{\"employeeId\":1,\"departmentId\":1,\"name\":\"Maja\",\"startDate\":\"{2018-09-01T20:00:00.000000-04:00}\",\"contact\":[\"084-767-734\",\"071-334-8473\"],\"latLong\":[59.334591,18.06324],\"stX\":59.334591,\"stY\":18.06324}" +#+end_src +Both the Postgresql function and the Postmodern return type approach can be applied to the end result of more complicated queries with joins, CTEs and other tools of the trade. Which is actually why we have the department table in this example. Instead of having the department-id in the json we are sending to the front end, let's have the department name. + +First the s-sql using the Postgresql =row-to-json= function: +#+begin_src lisp + (query (:select (:row-to-json 'e) + :from (:as (:select 'employee-id (:as 'departments.name 'department_name) + (:as 'employees.name 'employee-name) + 'start-date 'contact 'lat-long + (:st-x 'geom) (:st-y 'geom) + :from 'employees + :left-join 'departments + :on (:= 'departments.department-id 'employees.department-id) + :where (:= 'employee-id 1)) + 'e))) + + (("{\"employee_id\":1,\"department_name\":\"spatial\",\"employee_name\":\"Maja\",\"start_date\":\"2018-09-02\",\"contact\":[\"084-767-734\",\"071-334-8473\"],\"lat_long\":\"(59.334591,18.06324)\",\"st_x\":59.334591,\"st_y\":18.06324}")) +#+end_src +Now the s-sql using the Postmodern :json-str keyword parameter for query: +#+begin_src lisp + (query (:select 'employee-id (:as 'departments.name 'department-name) + (:as 'employees.name 'employee-name) + 'start-date 'contact 'lat-long (:st-x 'geom) (:st-y 'geom) + :from 'employees + :left-join 'departments + :on (:= 'departments.department-id 'employees.department-id) + :where (:= 'employee-id 1)) + :json-str) + "{\"employeeId\":1,\"departmentName\":\"spatial\",\"employeeName\":\"Maja\",\"startDate\":\"{2018-09-01T20:00:00.000000-04:00}\",\"contact\":[\"084-767-734\",\"071-334-8473\"],\"latLong\":[59.334591,18.06324],\"stX\":59.334591,\"stY\":18.06324}" +#+end_src + +* The Basic Dao-class Version +:PROPERTIES: +:CUSTOM_ID: dao-class-version +:END: +Assuming you already have a database to use, let's create a couple of dao classes, their associated tables and insert some data. Assume we decide we want to keep the geom as a list of latitude and longitude in the geom slot. That means we need import and export functions. +#+begin_src lisp + (defclass departments () + ((department-id :col-type serial :initarg :department-id :accessor department-id + :col-primary-key t) + (name :col-type (or text pomo:db-null) :initarg :name :accessor name)) + (:metaclass pomo:dao-class)) + + (pomo:execute (dao-table-definition 'departments)) + + (defclass employees () + ((employee-id :col-type serial :initarg :employee-id :accessor employee-id + :col-primary-key t) + (department-id :col-type integer :initarg :department-id :accessor department-id + :col-references ((departments department-id))) + (name :col-type text :initarg name :accessor name) + (start-date :col-type (or date pomo:db-null) :initarg start-date :accessor start-date) + (contact :col-type (or pomo:db-null (array text)) :initarg contact :accessor contact) + (private :col-type (or pomo:db-null text) :initarg private :accessor private) + (lat-long :col-type (or pomo:db-null point) :initarg lat-long :accessor lat-long) + (geom :col-type (or pomo:db-null (geometry point 4326)) :initarg geom :accessor geom + :col-import geom->wkb-point)) + (:metaclass pomo:dao-class)) + + ;; make-doa creates an instance of the dao and saves it in the database + (pomo:make-dao 'departments :department-id 1 :name "spatial") + (pomo:make-dao 'departments :department-id 2 :name "cloud") + + (pomo:make-dao 'employees :department-id 1 :name "Maja" :start-date "2018/09/02" + :contact #("084-767-734","071-334-8473") + :private "not allowed" :lat-long "(59.334591, 18.063240)" + :geom "POINT(59.334591 18.063240)") + + (pomo:make-dao 'employees :department-id 1 :name "Liam" :start-date "2019/09/02" + :contact #("084-767-734","071-334-8472") + :private "private" :lat-long "(57.708870, 11.974560)" + :geom "POINT((57.708870 11.974560)") + + (pomo:make-dao 'employees :department-id 2 :name "Matteo" :start-date "2019/11/01" + :contact #("084-767-734","071-334-8476") + :private "burn before reading" :lat-long "(58.283489, 12.285821)" + :geom "POINT(58.283489 12.285821)") + + (pomo:make-dao 'employees :department-id 2 :name "Astrid" :start-date "2020/10/01" + :contact #("084-767-734","071-334-8465") + :private "abandon all hope" :lat-long "(57.751442, 16.628838)" + :geom "POINT(57.751442 16.628838)") + #+end_src +One difference to note is that the data for the lat_long point data type has a comma, but the geom geometry data type does not have a comma. No, I do not know why the syntax difference. + +Now the problem. If you ran a basic query to see how Postgresql was storing that geometry type, it would look something like this: + +#+begin_src lisp + (pomo:query "select geom from employees where employee_id=1" :single) +"0101000020E61000009A44BDE0D3AA4D408ECC237F30103240" +#+end_src + +We need import and export functions that implement the opengis specification in order to implement the import and export functions for the geom slot. See [[https://www.ogc.org/standards/sfs]]. Fortunately J.P. Larocue created the cl-wkb package (accessed via quicklisp with quickloading the +[[https://github.com/filonenko-mikhail/cl-ewkb][cl-ewkb system]]) and we can create an import function with a combination of using ironclad's hex-string-to-byte-array and cl-wkb's decode function. So let's do that. +#+begin_src lisp + (defun geom->wkb-point (input) + "Takes a hexstring that represents a geometry point from postgresql and returns a cl-wkb:point class instance" + (cl-wkb:decode (ironclad:hex-string-to-byte-array input))) +#+end_src +Now we can check whether we succeeded by seeing whether the x point is the latitude we expected: +#+begin_src lisp + (cl-wkb:x (geom (pomo:get-dao 'employees 1))) +59.334591d0 +#+end_src + +We still need to get from the dao-class to json. You could do something like just run cl-json's =encode-json=function on a dao-object like so: +#+begin_src lisp + (cl-json:encode-json (pomo:get-dao 'employees 1)) + + {"employeeId":1, + "departmentId":1, + "name":"Maja", + "startDate":{"day":6759,"sec":0,"nsec":0}, + "contact":["084-767-734","071-334-8473"], + "private":"not allowed", + "latLong":[59.334591,18.06324], + "geom":{"geomtype":536870913,"srid":4326,"pointPrimitive":{"x":59.334591,"y":18.06324,"z":0.0,"m":0.0}}} +#+end_src +Looking at the result, we have two issues. First, the start date seems to have lost its senses. Second, it is collecting and passing on the private data to the front end, which we explicitly did not want to do. + +Just checking on the date situation: +#+begin_src lisp +(start-date (pomo:get-dao 'employees 1))) +@2018-09-01T20:00:00.000000-04:00 +#+end_src +That works, so it is something on the cl-json side that we will have to work around. Let's turn to the private data issue. + +One solution would be to create a dao-class that is only a subset of the employees table (minus the private data) and set =pomo:*ignore-unknonw-columns*= to t. (If we did not set =pomo:*ignore-unknonw-columns*=, we would generate an error complaining that the dao +was not in sync with the table.) Let's do that: +#+begin_src lisp + (defclass employees-minus-private () + ((employee-id :col-type serial :initarg :employee-id :accessor employee-id :col-primary-key t) + (department-id :col-type integer :initarg :department-id :accessor department-id :col-references ((departments department-id))) + (name :col-type text :initarg name :accessor name) + (start-date :col-type (or date pomo:db-null) :initarg start-date :accessor start-date) + (contact :col-type (or pomo:db-null (array text)) :initarg contact :accessor contact) + (lat-long :col-type (or pomo:db-null point) :initarg lat-long :accessor lat-long) + (geom :col-type (or pomo:db-null (geometry point 4326)) :initarg geom :accessor geom + :col-import geom->wkb-point)) + (:table-name employees) + (:metaclass pomo:dao-class)) + + (setf pomo:*IGNORE-UNKNOWN-COLUMNS* t) + #+end_src + And now cl-json generates a json string without the + #+begin_src lisp + (cl-json:encode-json (pomo:get-dao 'employees-minus-private 1)) + {"employeeId":1,"departmentId":1,"name":"Maja","startDate":3744835200,"contact":["084-767-734","071-334-8473"],"latLong":[59.334591,18.06324],"geom":{"geomtype":536870913,"srid":4326,"pointPrimitive":{"x":59.334591,"y":18.06324,"z":0.0,"m":0.0}}} + #+end_src +If you are using a different CL json library, you would have to write your own functions to convert from a dao-class object to something that, e.g. jonathan or jsown could use. + +Handling joins in a dao-class are more complicated - the Postmodern dao-class is intended to be simple, not recreate Hibernate or SQLAlchemy. You can see an example at [[https://marijnhaverbeke.nl/postmodern/dao-classes.html#multi-table-dao-class-object]]. diff --git a/doc/postmodern.html b/doc/postmodern.html index f49f51b..92e9cae 100644 --- a/doc/postmodern.html +++ b/doc/postmodern.html @@ -1,7 +1,7 @@ - + Postmodern Reference Manual @@ -246,7 +246,7 @@

    Postmodern Reference Manual

    Table of Contents

    -
    -

    Overview

    -
    +
    +

    Overview

    +

    This is the reference manual for the component named postmodern, which is part of a library of the same name. @@ -526,6 +527,7 @@

    Overview

  • Dynamic Queries
  • Interval Notes
  • Isolation Notes
    • +
  • Json From Postgresql/Postmodern
    • @@ -973,7 +975,7 @@

    macro query (query &rest args/format)

    -:json-strs +:json-str Return a single string where the row returned is a json object expressed as a string @@ -998,9 +1000,9 @@

    macro query (query &rest args/format)

    Some Examples:

    -
    -

    Default

    -
    +
    +

    Default

    +

    The default is :lists

    @@ -1011,9 +1013,9 @@

    Default

    -
    -

    Single

    -
    +
    +

    Single

    +

    Returns a single field. Will throw an error if the queries returns more than one field or more than one row

    @@ -1024,9 +1026,9 @@

    Single

    -
    -

    List

    -
    +
    +

    List

    +

    Returns a list containing the selected fields. Will throw an error if the query returns more than one row

    @@ -1037,9 +1039,9 @@

    List

    -
    -

    Lists

    -
    +
    +

    Lists

    +

    This is the default

    @@ -1050,9 +1052,9 @@

    Lists

    -
    -

    Alist

    -
    +
    +

    Alist

    +

    Returns an alist containing the field name as a keyword and the selected fields. Will throw an error if the query returns more than one row.

    @@ -1063,9 +1065,9 @@

    Alist

    -
    -

    Str-alist

    -
    +
    +

    Str-alist

    +

    Returns an alist containing the field name as a lower case string and the selected fields. Will throw an error if the query returns more than one row.

    @@ -1076,9 +1078,9 @@

    Str-alist

    -
    -

    Alists

    -
    +
    +

    Alists

    +

    Returns a list of alists containing the field name as a keyword and the selected fields.

    @@ -1090,9 +1092,9 @@

    Alists

    -
    -

    Str-alists

    -
    +
    +

    Str-alists

    +

    Returns a list of alists containing the field name as a lower case string and the selected fields.

    @@ -1104,9 +1106,9 @@

    Str-alists

    -
    -

    Plist

    -
    +
    +

    Plist

    +

    Returns a plist containing the field name as a keyword and the selected fields. Will throw an error if the query returns more than one row.

    @@ -1117,9 +1119,9 @@

    Plist

    -
    -

    Plists

    -
    +
    +

    Plists

    +

    Returns a list of plists containing the field name as a keyword and the selected fields.

    @@ -1130,9 +1132,9 @@

    Plists

    -
    -

    Vectors

    -
    +
    +

    Vectors

    +

    Returns a vector of vectors where each internal vector is a returned row from the query. The field names are not included. NOTE: It will return an empty vector instead of NIL if there is no result.

    @@ -1150,9 +1152,9 @@

    Vectors

    -
    -

    Array-hash

    -
    +
    +

    Array-hash

    +

    Returns a vector of hashtables where each hash table is a returned row from the query with field name as the key expressed as a lower case string.

    @@ -1170,9 +1172,9 @@

    Array-hash

    -
    -

    Dao

    -
    +
    +

    Dao

    +

    Returns a list of daos of the type specified

    @@ -1186,9 +1188,9 @@

    Dao

    -
    -

    Column

    -
    +
    +

    Column

    +

    Returns a list of field values of a single field. Will throw an error if more than one field is selected

    @@ -1202,9 +1204,9 @@

    Column

    -
    -

    Json-strs

    -
    +
    +

    Json-strs

    +

    Return a list of strings where the row returned is a json object expressed as a string

    @@ -1242,9 +1244,9 @@

    Json-strs

    -
    -

    Json-str

    -
    +
    +

    Json-str

    +

    Return a single string where the row returned is a json object expressed as a string

    @@ -1259,9 +1261,9 @@

    Json-str

    -
    -

    Json-array-str

    -
    +
    +

    Json-array-str

    +

    Return a string containing a json array, each element in the array is a selected row expressed as a json object. NOTE: If there is no result, this will return a string with an empty json array.

    @@ -1278,9 +1280,9 @@

    Json-array-str

    -
    -

    Second value returned

    -
    +
    +

    Second value returned

    +

    If the database returns information about the amount rows that were affected, such as with updating or deleting queries, this is returned as a second value. @@ -2330,9 +2332,9 @@

    function add-comment (type name comment &optio

    -
    -

    find-comments (type identifier)

    -
    +
    +

    find-comments (type identifier)

    +

    Returns the comments attached to a particular database object. The allowed types are :database :schema :table :columns (all the columns in a table) @@ -2566,6 +2568,24 @@

    function list-installed-extensions (

    + +
    +

    function load-uuid-extension ()

    +
    +

    +Loads the Postgresql uuid-ossp contrib module. Once loaded, you can call uuid +generation functions such as uuid_generate_v4 within a query. E.g. +

    +
    +
    (query "select uuid_generate_v4()")
+
    +
    +

    +It will be skipped if it is already loaded. See Postgresql documentation at https://www.postgresql.org/docs/current/uuid-ossp.htmlList for more details. +

    +
    +
    +

    function list-templates ()

    @@ -3487,9 +3507,9 @@

    function rename-table (old-name new-name)

    -
    -

    function rename-column (table-name old-name new-name)

    -
    +
    +

    function rename-column (table-name old-name new-name)

    +

    → boolean

    diff --git a/doc/postmodern.org b/doc/postmodern.org index fad8e62..72e1f78 100644 --- a/doc/postmodern.org +++ b/doc/postmodern.org @@ -27,6 +27,7 @@ Some specific topics in more detail - [[file:dynamic-queries.html][Dynamic Queries]] - [[file:interval-notes.html][Interval Notes]] - [[file:isolation-notes.html][Isolation Notes]] +- [[file:json-from-postgres.html][Json From Postgresql/Postmodern]] * Connecting :PROPERTIES: @@ -301,7 +302,7 @@ instead. Any of the following formats can be used, with the default being :rows: | :vectors | Return a vector of vectors, each vector containing the values for a row. (This is only the plural) | | :array-hash | Return an array of hashtables which map column names to hash table keys | | :json-strs | Return a list of strings where each row is a json object expressed as a string | -| :json-strs | Return a single string where the row returned is a json object expressed as a string | +| :json-str | Return a single string where the row returned is a json object expressed as a string | | :json-array-str | Return a string containing a json array, each element in the array is a selected row expressed as a json object | | (:dao type) | Return a list of DAOs of the given type. The names of the fields returned by the query must match slots in the DAO class the same way as with query-dao. | | (:dao type :single) | Return a single DAO of the given type. | @@ -1408,6 +1409,19 @@ currently connected database. The extensions may or may not be installed. List the postgresql extensions which are installed in the currently connected database. + +** function load-uuid-extension () + :PROPERTIES: + :CUSTOM_ID: function-load-uuid-extensin + :END: + +Loads the Postgresql uuid-ossp contrib module. Once loaded, you can call uuid +generation functions such as uuid_generate_v4 within a query. E.g. +#+begin_src lisp + (query "select uuid_generate_v4()") +#+end_src +It will be skipped if it is already loaded. See Postgresql documentation at https://www.postgresql.org/docs/current/uuid-ossp.htmlList for more details. + ** function list-templates () :PROPERTIES: :CUSTOM_ID: function-list-templates diff --git a/postmodern.asd b/postmodern.asd index 647e020..a19dfb1 100644 --- a/postmodern.asd +++ b/postmodern.asd @@ -27,6 +27,7 @@ "global-vars" "split-sequence" "cl-unicode" + "uiop" (:feature :postmodern-use-mop "closer-mop") (:feature :postmodern-thread-safe "bordeaux-threads")) :components diff --git a/postmodern/package.lisp b/postmodern/package.lisp index 0202977..ea8548d 100644 --- a/postmodern/package.lisp +++ b/postmodern/package.lisp @@ -79,6 +79,7 @@ #:get-search-path #:get-database-comment #:encode-json-to-string + #:load-uuid-extension ;; Prepared Statement Functions #:*allow-overwriting-prepared-statements* diff --git a/postmodern/table.lisp b/postmodern/table.lisp index 6dd626c..67af79d 100644 --- a/postmodern/table.lisp +++ b/postmodern/table.lisp @@ -156,15 +156,15 @@ Returns a symbol.")) (cond ((closer-mop:classp class) (mapcar 'slot-column (remove-if-not (lambda (x) (typep x 'effective-column-slot)) - (class-slots class)))) + (closer-mop:class-slots class)))) ((symbolp class) (mapcar 'slot-column (remove-if-not (lambda (x) (typep x 'effective-column-slot)) - (class-slots (find-class class))))) + (closer-mop:class-slots (find-class class))))) ((typep class 'dao-class) (mapcar 'slot-column (remove-if-not (lambda (x) (typep x 'effective-column-slot)) - (class-slots (class-of class))))) + (closer-mop:class-slots (class-of class))))) (t nil))) (defun dao-column-fields (class) @@ -478,26 +478,46 @@ Column name must be a symbol" (defun find-dao-column-slot (class column-name) "Given a class and a symbol returns the dao-column-slot class for the column -named by that symbol (not the sql_column_name)." - (setf class (set-to-class class)) - (find column-name (dao-column-slots class) :key #'slot-definition-name)) +named by that symbol (not the sql_column_name). Column name can be a symbol or +a string." + (cond ((symbolp column-name) + (find (string-downcase (symbol-name column-name)) + (dao-column-slots class) + :key #'slot-definition-name-as-string + :test 'equal)) + ((stringp column-name) + (find (string-downcase column-name) + (dao-column-slots class) + :key #'slot-definition-name-as-string + :test 'equal)) + (t nil))) + +(defun slot-definition-name-as-string (slot) + "Given a dao slot, this returns a downcased string of the name of a slot +without the package name for use in find functions." + (string-downcase (symbol-name (closer-mop:slot-definition-name slot)))) (defun field-name-to-slot-name (class field-name) - "Takes a Postgresql column name and tries to match it to a dao slot name. -This is trying to deal with the hyphens and underscores problem." - (let ((slot-names (mapcar 'string-downcase (dao-column-fields class)))) - (cond ((find field-name slot-names :test 'equal) - (intern (if (eq (readtable-case *readtable*) :upcase) - (string-upcase field-name) - field-name))) - ((find (cl-ppcre:regex-replace-all "_" field-name "-") - slot-names - :test 'equal) - (setf field-name (cl-ppcre:regex-replace-all "_" field-name "-")) - (intern (if (eq (readtable-case *readtable*) :upcase) - (string-upcase field-name) - field-name))) - (t nil)))) + "Takes a Postgresql column name and tries to match it to a dao slot name symbol. +This is trying to deal with the hyphens and underscores problem where +Postgresql table field names cannot use hyphens but that is normal CL +practice. The slot name symbol will be the full package::slot-name. field-name +must be a string." + (let ((slot (find field-name + (dao-column-slots class) + :key #'slot-definition-name-as-string + :test 'equal))) + (if slot + (closer-mop:slot-definition-name slot) + (progn + (setf field-name (cl-ppcre:regex-replace-all "_" field-name "-")) + (setf slot (find field-name + (dao-column-slots class) + :key #'slot-definition-name-as-string + :test 'equal)) + (if slot + (closer-mop:slot-definition-name slot) + nil))))) (defun build-dao-methods (class) "Synthesise a number of methods for a newly defined DAO class. @@ -532,9 +552,8 @@ or accessor or reader.)" :append (list (field-sql-name field) '$$))) (slot-values (object &rest slots) (loop :for slot :in (apply 'append slots) - :collect ;(slot-value object slot) + :collect (if (and (slot-boundp object slot) - (slot-value object slot) (find-export-function object slot)) (funcall (find-export-function object slot) (slot-value object slot)) @@ -600,7 +619,6 @@ or accessor or reader.)" collect (field-sql-name field) collect (if (and (slot-boundp object field) - (slot-value object field) (find-export-function object field)) (funcall (find-export-function object field) (slot-value object field)) @@ -687,15 +705,28 @@ about the objects, and immediately store it in the new instances." (funcall result-next-field-generator-fn field))) (function (let ((import-function-symbol (find-import-function instance (field-name field)))) - (if (and import-function-symbol + (cond ((and import-function-symbol (eq writer (fdefinition import-function-symbol))) (setf (slot-value instance (field-name-to-slot-name class (field-name field))) - (funcall writer - (funcall result-next-field-generator-fn field))) + (funcall import-function-symbol + (funcall result-next-field-generator-fn field)))) + ((and import-function-symbol + (not (functionp import-function-symbol))) + (setf (slot-value instance (field-name-to-slot-name + class (field-name field))) + (funcall (fdefinition import-function-symbol) + (funcall result-next-field-generator-fn field)))) + ((and import-function-symbol + (functionp import-function-symbol)) + (setf (slot-value instance (field-name-to-slot-name + class (field-name field))) + (funcall import-function-symbol + (funcall result-next-field-generator-fn field)))) + (t (funcall writer instance - (funcall result-next-field-generator-fn field))))))) + (funcall result-next-field-generator-fn field)))))))) (initialize-instance instance) instance)) diff --git a/postmodern/tests/test-dao.lisp b/postmodern/tests/test-dao.lisp index 08c9365..9dc1c99 100644 --- a/postmodern/tests/test-dao.lisp +++ b/postmodern/tests/test-dao.lisp @@ -2,8 +2,8 @@ (in-package :postmodern-tests) (def-suite :postmodern-daos - :description "Dao suite for postmodern" - :in :postmodern) + :description "Dao suite for postmodern" + :in :postmodern) (in-suite :postmodern-daos) @@ -104,14 +104,14 @@ (:table-name departments)) (defclass from-test-data () - ((id :col-type serial :initarg :id :accessor id) - (flight :col-type (or integer db-null) :initarg :flight :accessor flight) - (from :col-type (or (varchar 100) db-null) :initarg :from :accessor from) - (to-destination :col-type (or (varchar 100) db-null) - :initarg :to-destination :accessor to-destination)) - (:metaclass dao-class) - (:table-name from-test) - (:keys id from)) + ((id :col-type serial :initarg :id :accessor id) + (flight :col-type (or integer db-null) :initarg :flight :accessor flight) + (from :col-type (or (varchar 100) db-null) :initarg :from :accessor from) + (to-destination :col-type (or (varchar 100) db-null) + :initarg :to-destination :accessor to-destination)) + (:metaclass dao-class) + (:table-name from-test) + (:keys id from)) (defun dao-test-table-fixture () "Drops and recreates the dao-test table" @@ -168,30 +168,30 @@ (test dao-class (with-test-connection (with-dao-test-table-fixture - (is (equal (dao-table-definition 'test-data) - "CREATE TABLE dao_test (id SERIAL NOT NULL, a VARCHAR(100) DEFAULT NULL, b BOOLEAN NOT NULL DEFAULT false, c INTEGER NOT NULL DEFAULT 0, d NUMERIC NOT NULL DEFAULT 0.0, PRIMARY KEY (id))")) - (is (equal (dao-keys (find-class 'test-data)) - '(ID))) - (is (equal (dao-keys (make-instance 'test-data :id 1)) - '(1))) - (is (member :dao-test (list-tables))) - (is (null (select-dao 'test-data))) - (let ((dao (make-instance 'test-data :a "quux"))) - (signals error (test-id dao)) - (insert-dao dao) - (is (dao-exists-p dao)) - (let* ((id (test-id dao)) - (database-dao (get-dao 'test-data id))) - (is (not (null database-dao))) - (is (eql (test-id dao) (test-id database-dao))) - (is (string= (test-a database-dao) "quux")) - (setf (test-b dao) t) - (update-dao dao) - (let ((new-database-dao (get-dao 'test-data id))) - (is (eq (test-b new-database-dao) t)) - (is (eq (test-b database-dao) nil)) - (delete-dao dao))) - (is (not (select-dao 'test-data))))))) + (is (equal (dao-table-definition 'test-data) + "CREATE TABLE dao_test (id SERIAL NOT NULL, a VARCHAR(100) DEFAULT NULL, b BOOLEAN NOT NULL DEFAULT false, c INTEGER NOT NULL DEFAULT 0, d NUMERIC NOT NULL DEFAULT 0.0, PRIMARY KEY (id))")) + (is (equal (dao-keys (find-class 'test-data)) + '(ID))) + (is (equal (dao-keys (make-instance 'test-data :id 1)) + '(1))) + (is (member :dao-test (list-tables))) + (is (null (select-dao 'test-data))) + (let ((dao (make-instance 'test-data :a "quux"))) + (signals error (test-id dao)) + (insert-dao dao) + (is (dao-exists-p dao)) + (let* ((id (test-id dao)) + (database-dao (get-dao 'test-data id))) + (is (not (null database-dao))) + (is (eql (test-id dao) (test-id database-dao))) + (is (string= (test-a database-dao) "quux")) + (setf (test-b dao) t) + (update-dao dao) + (let ((new-database-dao (get-dao 'test-data id))) + (is (eq (test-b new-database-dao) t)) + (is (eq (test-b database-dao) nil)) + (delete-dao dao))) + (is (not (select-dao 'test-data))))))) (test dao-class-1 (with-test-connection @@ -300,7 +300,7 @@ :department-id 1)))) '(ID USERNAME DEPARTMENT-ID))) (is (equal (mapcar #'pomo::slot-definition-name - (pomo::dao-column-slots (find-class 'test-data-col-identity))) + (pomo::dao-column-slots (find-class 'test-data-col-identity))) '(ID USERNAME DEPARTMENT-ID)))) (test dao-column-fields @@ -319,7 +319,7 @@ (test dao-superclasses (is (equal (class-name (class-of (first (pomo::dao-superclasses (find-class 'test-data-col-identity))))) - 'dao-class))) + 'dao-class))) (test identity-collate-check-default-unique (defclass col-de () @@ -353,15 +353,15 @@ (test save-dao-base (with-test-connection (with-dao-test-table-fixture - (let ((dao (make-instance 'test-data :a "quux"))) - (is (save-dao dao)) ; returns a boolean to indicate a new row was inserted - (setf (test-a dao) "bar") - (is (equal (test-id dao) - 1)) - (is (equal (test-d dao) - 0)) - (is (not (save-dao dao))) ; returns boolean nil showing no new row was inserted - (is (equal (test-a (get-dao 'test-data (test-id dao))) "bar")))))) + (let ((dao (make-instance 'test-data :a "quux"))) + (is (save-dao dao)) ; returns a boolean to indicate a new row was inserted + (setf (test-a dao) "bar") + (is (equal (test-id dao) + 1)) + (is (equal (test-d dao) + 0)) + (is (not (save-dao dao))) ; returns boolean nil showing no new row was inserted + (is (equal (test-a (get-dao 'test-data (test-id dao))) "bar")))))) (test save-dao-with-transaction (with-test-connection @@ -370,39 +370,39 @@ (with-transaction () (save-dao dao)) (is (equal (query "select * from dao_test") - '((1 "quux" NIL 0 0)))) - (setf (test-a dao) "bar") - (signals database-error - (with-transaction () - (save-dao dao))) - (with-transaction () - (is (equal (query "select * from dao_test") - '((1 "quux" NIL 0 0)))) - (is (not (save-dao/transaction dao))) - (is (equal (query "select * from dao_test") - '((1 "bar" NIL 0 0))))))))) + '((1 "quux" NIL 0 0)))) + (setf (test-a dao) "bar") + (signals database-error + (with-transaction () + (save-dao dao))) + (with-transaction () + (is (equal (query "select * from dao_test") + '((1 "quux" NIL 0 0)))) + (is (not (save-dao/transaction dao))) + (is (equal (query "select * from dao_test") + '((1 "bar" NIL 0 0))))))))) (test save-dao-with-same-key (with-test-connection (with-dao-test-table-fixture - (let ((dao (make-instance 'test-data :a "quux"))) - (save-dao dao) - (is (equal (test-id dao) - 1)) - (is (equal (query "select * from dao_test") - '((1 "quux" NIL 0 0)))) - (setf (test-a dao) "bar") - (save-dao dao) - (is (equal (query "select * from dao_test") - '((1 "bar" NIL 0 0)))))))) + (let ((dao (make-instance 'test-data :a "quux"))) + (save-dao dao) + (is (equal (test-id dao) + 1)) + (is (equal (query "select * from dao_test") + '((1 "quux" NIL 0 0)))) + (setf (test-a dao) "bar") + (save-dao dao) + (is (equal (query "select * from dao_test") + '((1 "bar" NIL 0 0)))))))) (test save-dao-smaller-than-table (with-test-connection (with-dao-test-table-fixture (let ((short-dao (make-instance 'test-data-short :a "first short"))) - (save-dao short-dao) - (is (equalp (query (:select '* :from 'dao-test) :alists) - '(((:ID . 1) (:A . "first short") (:B) (:C . 0) (:D . 0))))) + (save-dao short-dao) + (is (equalp (query (:select '* :from 'dao-test) :alists) + '(((:ID . 1) (:A . "first short") (:B) (:C . 0) (:D . 0))))) (setf *ignore-unknown-columns* t) (is (equal (test-a (get-dao 'test-data-short 1)) "first short")) @@ -411,10 +411,10 @@ (test save-short-dao-with-bad-col-type (with-test-connection (with-dao-test-table-fixture - (let ((dao-short-wrong (make-instance 'test-data-short-wrong-col-type :a 12.75))) - (save-dao dao-short-wrong) - (is (equalp (query (:select '* :from 'dao-test) :alists) - '(((:ID . 1) (:A . "12.75") (:B) (:C . 0) (:D . 0))))))))) + (let ((dao-short-wrong (make-instance 'test-data-short-wrong-col-type :a 12.75))) + (save-dao dao-short-wrong) + (is (equalp (query (:select '* :from 'dao-test) :alists) + '(((:ID . 1) (:A . "12.75") (:B) (:C . 0) (:D . 0))))))))) (test save-dao-with-bad-col-type "Tests saving a dao when slot d, accessor test-d has a text col-type and the table is numeric." @@ -457,6 +457,17 @@ (is (equal (query "select * from departments") '((1 "German") (2 "Philosophy") (3 "Economics") (4 "Geopolitics")))))))) +(test returning-dao-from-select-query + (with-test-connection + (with-dao-test-table-fixture + (insert-dao (make-instance 'test-data :a "bar" :b t :c 23 :d 13.2)) + (insert-dao (make-instance 'test-data :a "foo" :b t :c 17 :d 23.2)) + (insert-dao (make-instance 'test-data :a "baz" :b t :c 145 :d 33.2)) + (is (equal (test-c (with-test-connection + (query "select * from dao_test where id = 2" + (:dao test-data :single)))) + 17))))) + (test returning-different-dao-types "Demonstrates that daos do not enforce slot types. The database will enforce the slot types so there is a single source of type truth." @@ -492,70 +503,70 @@ so there is a single source of type truth." (test save-upsert-dao-with-serial (with-test-connection (with-dao-test-table-fixture - (let ((dao (make-instance 'test-data :a "quux"))) - (save-dao dao) - (is (equal (query "select * from dao_test") - '((1 "quux" NIL 0 0)))) - (is (equal (test-a (get-dao 'test-data (test-id dao))) "quux")) - (setf (test-a dao) "bar") - (upsert-dao dao) - (is (equal (test-a (get-dao 'test-data (test-id dao))) "bar")) - (is (equal (query "select * from dao_test") - '((1 "bar" NIL 0 0)))) - (signals error (update-dao (make-instance 'test-data :id 1 :a "cover?"))) ; unbound :b - (signals error (upsert-dao (make-instance 'test-data :id 1 :a "cover?"))) ; duplicate key - (upsert-dao (make-instance 'test-data :a "cover?")) - (is (equal (query "select * from dao_test") - '((1 "bar" NIL 0 0) (2 "cover?" NIL 0 0)))))))) + (let ((dao (make-instance 'test-data :a "quux"))) + (save-dao dao) + (is (equal (query "select * from dao_test") + '((1 "quux" NIL 0 0)))) + (is (equal (test-a (get-dao 'test-data (test-id dao))) "quux")) + (setf (test-a dao) "bar") + (upsert-dao dao) + (is (equal (test-a (get-dao 'test-data (test-id dao))) "bar")) + (is (equal (query "select * from dao_test") + '((1 "bar" NIL 0 0)))) + (signals error (update-dao (make-instance 'test-data :id 1 :a "cover?"))) ; unbound :b + (signals error (upsert-dao (make-instance 'test-data :id 1 :a "cover?"))) ; duplicate key + (upsert-dao (make-instance 'test-data :a "cover?")) + (is (equal (query "select * from dao_test") + '((1 "bar" NIL 0 0) (2 "cover?" NIL 0 0)))))))) (test save-upsert-dao-not-serial (with-test-connection (with-dao-test-table-fixture-not-serial-key - (let ((dao (make-instance 'test-data-not-serial-key :id 1 :username "duck"))) - (signals error (save-dao dao)) ; unbound department-id - (setf (department-id dao) 12) - (save-dao dao) - (is (equal (query "select * from users1") - '((1 "duck" 12)))) - (is (equal (username (get-dao 'test-data-not-serial-key (username dao))) - "duck")) - (setf (department-id dao) 13) - (upsert-dao dao) - (is (equal (query "select * from users1") - '((1 "duck" 13)))) - (setf (username dao) "goose") - (setf (department-id dao) 17) - (upsert-dao dao) - (is (equal (query "select * from users1") - '((1 "duck" 13) (1 "goose" 17)))) - (is (equal (department-id (get-dao 'test-data-not-serial-key (username dao))) - 17)) - (signals error (update-dao (make-instance 'test-data-not-serial-key - :id 1 :username "turkey" :department-id 43))) - ;; update row does not exist - (is (equal (query "select * from users1") - '((1 "duck" 13) (1 "goose" 17)))) - (upsert-dao (make-instance 'test-data-not-serial-key - :id 1 :username "chicken" :department-id 3)) - (is (equal (query "select * from users1") - '((1 "duck" 13) (1 "goose" 17) (1 "chicken" 3)))) - (upsert-dao (make-instance 'test-data-not-serial-key - :id 1 :username "duck" :department-id 3)) - (is (equal (query "select * from users1") - '((1 "goose" 17) (1 "chicken" 3) (1 "duck" 3)))) - (update-dao (make-instance 'test-data-not-serial-key - :id 1 :username "chicken" :department-id 3)) - (is (equal (query "select * from users1") - '((1 "goose" 17) (1 "duck" 3) (1 "chicken" 3)))) - (upsert-dao (make-instance 'test-data-not-serial-key - :id 1 :username "penguin" :department-id 43)) - (is (equal (query "select * from users1") - '((1 "goose" 17) (1 "duck" 3) (1 "chicken" 3) (1 "penguin" 43)))) - (signals error (update-dao (make-instance 'test-data-not-serial-key - :id 1 :username "turkey" :department-id 43))) - ;; still no turkey to update - (is (equal (query "select * from users1") - '((1 "goose" 17) (1 "duck" 3) (1 "chicken" 3) (1 "penguin" 43)))))))) + (let ((dao (make-instance 'test-data-not-serial-key :id 1 :username "duck"))) + (signals error (save-dao dao)) ; unbound department-id + (setf (department-id dao) 12) + (save-dao dao) + (is (equal (query "select * from users1") + '((1 "duck" 12)))) + (is (equal (username (get-dao 'test-data-not-serial-key (username dao))) + "duck")) + (setf (department-id dao) 13) + (upsert-dao dao) + (is (equal (query "select * from users1") + '((1 "duck" 13)))) + (setf (username dao) "goose") + (setf (department-id dao) 17) + (upsert-dao dao) + (is (equal (query "select * from users1") + '((1 "duck" 13) (1 "goose" 17)))) + (is (equal (department-id (get-dao 'test-data-not-serial-key (username dao))) + 17)) + (signals error (update-dao (make-instance 'test-data-not-serial-key + :id 1 :username "turkey" :department-id 43))) + ;; update row does not exist + (is (equal (query "select * from users1") + '((1 "duck" 13) (1 "goose" 17)))) + (upsert-dao (make-instance 'test-data-not-serial-key + :id 1 :username "chicken" :department-id 3)) + (is (equal (query "select * from users1") + '((1 "duck" 13) (1 "goose" 17) (1 "chicken" 3)))) + (upsert-dao (make-instance 'test-data-not-serial-key + :id 1 :username "duck" :department-id 3)) + (is (equal (query "select * from users1") + '((1 "goose" 17) (1 "chicken" 3) (1 "duck" 3)))) + (update-dao (make-instance 'test-data-not-serial-key + :id 1 :username "chicken" :department-id 3)) + (is (equal (query "select * from users1") + '((1 "goose" 17) (1 "duck" 3) (1 "chicken" 3)))) + (upsert-dao (make-instance 'test-data-not-serial-key + :id 1 :username "penguin" :department-id 43)) + (is (equal (query "select * from users1") + '((1 "goose" 17) (1 "duck" 3) (1 "chicken" 3) (1 "penguin" 43)))) + (signals error (update-dao (make-instance 'test-data-not-serial-key + :id 1 :username "turkey" :department-id 43))) + ;; still no turkey to update + (is (equal (query "select * from users1") + '((1 "goose" 17) (1 "duck" 3) (1 "chicken" 3) (1 "penguin" 43)))))))) (test dao-create-table-with-references (is (equal (dao-table-definition 'test-data-col-identity-with-references) @@ -577,9 +588,9 @@ so there is a single source of type truth." (test query-drop-table-1 (with-test-connection (with-dao-test-table-fixture - (is (member :dao-test (pomo:list-tables))) - (pomo:query (:drop-table :dao-test)) - (is (not (member :dao-test (pomo:list-tables))))))) + (is (member :dao-test (pomo:list-tables))) + (pomo:query (:drop-table :dao-test)) + (is (not (member :dao-test (pomo:list-tables))))))) (defclass test-col-name () ((a :col-type string :col-name aa :initarg :a :accessor test-a) @@ -645,25 +656,25 @@ in =dao-table-definition= in creating tables." (with-dao-test-table-fixture (unless (pomo:table-exists-p 'dao-test) (execute (dao-table-definition 'test-data))) - (let ((item (make-instance 'test-data :a "test-name" :b t :c 0)) - (threads '())) - (save-dao item) - (loop for x from 1 to 5 - do (push (bt:make-thread - (lambda () - (with-test-connection - (loop repeat 5 - do (bt:with-lock-held (*dao-update-lock*) - (incf (test-c item) 1) - (upsert-dao item)))) - (with-test-connection - (loop repeat 5 - do (bt:with-lock-held (*dao-update-lock*) - (decf (test-c item) 1) - (upsert-dao item)))))) - threads)) - (mapc #'bt:join-thread threads) - (is (eq 0 (test-c item))))))) + (let ((item (make-instance 'test-data :a "test-name" :b t :c 0)) + (threads '())) + (save-dao item) + (loop for x from 1 to 5 + do (push (bt:make-thread + (lambda () + (with-test-connection + (loop repeat 5 + do (bt:with-lock-held (*dao-update-lock*) + (incf (test-c item) 1) + (upsert-dao item)))) + (with-test-connection + (loop repeat 5 + do (bt:with-lock-held (*dao-update-lock*) + (decf (test-c item) 1) + (upsert-dao item)))))) + threads)) + (mapc #'bt:join-thread threads) + (is (eq 0 (test-c item))))))) (test reserved-column-names-defclass (with-test-connection @@ -723,7 +734,7 @@ in =dao-table-definition= in creating tables." (is (equal (test-b dao) nil)) (is (equal (test-c dao) - 0)) + 0)) (signals error (test-id short-dao)) (pomo:fetch-defaults short-dao) (signals error (test-id short-dao)))))) @@ -761,6 +772,30 @@ in =dao-table-definition= in creating tables." (is (equal (query "select * from dao_test") '((1 "dao1" NIL 2 0) (2 "dao2" NIL 2 0)))))))) +;; DAO ARRAY TESTS + +(defclass dao-array () + ((id :col-type integer :col-identity t :accessor id) + (name :col-type text :col-unique t :col-check (:<> 'name "") + :initarg :name :accessor name) + (r-array :col-type (or (array integer) db-null) :initarg :r-array :accessor r-array)) + (:metaclass dao-class) + (:table-name dao-array)) + +;; NEEDS MORE TESTS +(test dao-array-basic + (with-test-connection + (when (table-exists-p 'dao-array) (drop-table 'dao-array :cascade t)) + (query (dao-table-definition 'dao-array)) + (insert-dao (make-instance 'dao-array :name "dao1-array" :r-array #())) + (insert-dao (make-instance 'dao-array :name "dao2-array" :r-array #(1 2 3))) + (is (equalp (r-array (get-dao 'dao-array 1)) nil)) + (is (equalp (r-array (get-dao 'dao-array 2)) #(1 2 3))) + (is (equalp (query "select r_array from dao_array where id=1" :single) + nil)) + (is (equalp (query "select r_array from dao_array where id=2" :single) + #(1 2 3))))) + ;; Import/Export Function tests (test find-dao-column-slot @@ -777,7 +812,7 @@ in =dao-table-definition= in creating tables." (pomo::find-dao-column-slot (find-class 'test-data-d-string) 'd)) - t))) + t))) ;; Need to test insert, upsert, update with export functions (text and other formats @@ -785,25 +820,29 @@ in =dao-table-definition= in creating tables." ((id :col-type integer :col-identity t :accessor id) (name :col-type text :col-unique t :col-check (:<> 'name "") :initarg :name :accessor name) - (r-list :type list :col-type (or text db-null) :initarg :r-list :accessor r-list - :col-export list-to-string :col-import string-to-list) - (a-list :type alist :col-type (or text db-null) :initarg :a-list :accessor a-list - :col-export list-to-string :col-import string-to-list) - (p-list :type plist :col-type (or text db-null) :initarg :p-list :accessor p-list - :col-export list-to-string :col-import string-to-list)) + (r-list :col-type (or text db-null) :initarg :r-list :accessor r-list + :col-export list->string :col-import string->list) + (a-list :col-type (or text db-null) :initarg :a-list :accessor a-list + :col-export list->string :col-import string->list) + (p-list :col-type (or text db-null) :initarg :p-list :accessor p-list + :col-export list->string :col-import string->list) + (l-array :col-type (or (array integer) db-null) + :initarg :l-array :accessor l-array + :col-export list->arr :col-import array->list)) (:metaclass dao-class) (:table-name listy)) +;; The following class calls import and export functions that do not exist (defclass listy-bad-import-export () ((id :col-type integer :col-identity t :accessor id) (name :col-type text :col-unique t :col-check (:<> 'name "") :initarg :name :accessor name) - (r-list :type list :col-type (or text db-null) :initarg :r-list :accessor r-list - :col-export list1-to-string :col-import dao1-string-to-list) - (a-list :type alist :col-type (or text db-null) :initarg :a-list :accessor a-list - :col-export list-to-string :col-import dao-string-to-list) - (p-list :type plist :col-type (or text db-null) :initarg :p-list :accessor p-list - :col-export list-to-string :col-import dao-string-to-list)) + (r-list :col-type (or text db-null) :initarg :r-list :accessor r-list + :col-export list->string1 :col-import string->list1) + (a-list :col-type (or text db-null) :initarg :a-list :accessor a-list + :col-export list->string1 :col-import string-t>list1) + (p-list :col-type (or text db-null) :initarg :p-list :accessor p-list + :col-export list->string1 :col-import string->list1)) (:metaclass dao-class) (:table-name listy)) @@ -819,7 +858,7 @@ in =dao-table-definition= in creating tables." (unwind-protect (progn ,@body) (execute (:drop-table :if-exists 'listy :cascade))))) -(defun string-to-list (str) +(defun string->list (str) "Take a string representation of a list and return a lisp list. Note that you need to handle :NULLs." (cond ((eq str :NULL) @@ -828,10 +867,24 @@ Note that you need to handle :NULLs." (with-input-from-string (s str) (read s))) (t nil))) -(defun list-to-string (str) - (if (listp str) - (format nil "~a" str) - "unknown")) +(defun list->string (lst) + "here we have decided to insert :null if the input list is nil." + (if (listp lst) + (format nil "~a" lst) + :null)) + +(defun list->arr (lst) + (if (null lst) + :null + (coerce lst 'vector))) + +(defun array->list (arry) + "Here we have decided that we want the list be be nil rather than :NULL if the array is empty." + (cond ((eq arry :NULL) + nil) + ((vectorp arry) + (coerce arry 'list)) + (t nil))) ;; export data from a dao to a table using an export function ;; with and without null values @@ -840,9 +893,14 @@ Note that you need to handle :NULLs." (with-dao-export-import-table-fixture (insert-dao (make-instance 'listy :name "first" :r-list '(a b c) :a-list '((a 1) (b 2) (c 3)) - :p-list '(a 1 b 2 c 3))) + :p-list '(a 1 b 2 c 3) + :l-array '(1 2 3))) (insert-dao (make-instance 'listy :name "second" :r-list '(a b c) - :p-list '(a 1 b 2 c 3))) + :p-list '(a 1 b 2 c 3) + :l-array '())) + (insert-dao (make-instance 'listy :name "third" :r-list '(a b c) + :p-list '(a 1 b 2 c 3) + :l-array nil)) (is (equal (query "select r_list from listy where id = 1" :single) "(A B C)")) (is (equal (query "select a_list from listy where id = 1" :single) @@ -850,7 +908,13 @@ Note that you need to handle :NULLs." (is (equal (query "select p_list from listy where id = 1" :single) "(A 1 B 2 C 3)")) (is (equal (query "select name, a_list from listy where id = 2") - '(("second" :NULL))))))) + '(("second" :NULL)))) + (is (equalp (query "select name, l_array from listy where id = 1") + '(("first" #(1 2 3))))) + (is (equal (query "select name, l_array from listy where id = 2") + '(("second" :NULL)))) + (is (equal (query "select name, l_array from listy where id = 3") + '(("third" :NULL))))))) (test dao-insert-bad-export (with-test-connection @@ -867,9 +931,14 @@ Note that you need to handle :NULLs." (with-dao-export-import-table-fixture (save-dao (make-instance 'listy :name "first" :r-list '(a b c) :a-list '((a 1) (b 2) (c 3)) - :p-list '(a 1 b 2 c 3))) + :p-list '(a 1 b 2 c 3) + :l-array '(1 2 3))) (save-dao (make-instance 'listy :name "second" :r-list '(a b c) - :p-list '(a 1 b 2 c 3))) + :p-list '(a 1 b 2 c 3) + :l-array '())) + (save-dao (make-instance 'listy :name "third" :r-list '(a b c) + :p-list '(a 1 b 2 c 3) + :l-array nil)) (is (equal (query "select r_list from listy where id = 1" :single) "(A B C)")) (is (equal (query "select a_list from listy where id = 1" :single) @@ -877,7 +946,13 @@ Note that you need to handle :NULLs." (is (equal (query "select p_list from listy where id = 1" :single) "(A 1 B 2 C 3)")) (is (equal (query "select name, a_list from listy where id = 2") - '(("second" :NULL))))))) + '(("second" :NULL)))) + (is (equalp (query "select name, l_array from listy where id = 1") + '(("first" #(1 2 3))))) + (is (equal (query "select name, l_array from listy where id = 2") + '(("second" :NULL)))) + (is (equal (query "select name, l_array from listy where id = 3") + '(("third" :NULL))))))) ;; import data from a table into a dao, using an import function (test dao-get-with-import @@ -885,9 +960,14 @@ Note that you need to handle :NULLs." (with-dao-export-import-table-fixture (insert-dao (make-instance 'listy :name "first" :r-list '(a b c) :a-list '((a 1) (b 2) (c 3)) - :p-list '(a 1 b 2 c 3))) + :p-list '(a 1 b 2 c 3) + :l-array '(1 2 3))) (insert-dao (make-instance 'listy :name "second" :r-list '(a b c) - :p-list '(a 1 b 2 c 3))) + :p-list '(a 1 b 2 c 3) + :l-array '())) + (insert-dao (make-instance 'listy :name "third" :r-list '(a b c) + :p-list '(a 1 b 2 c 3) + :l-array nil)) (is (equal (name (get-dao 'listy 1)) "first")) (is (equal (r-list (get-dao 'listy 1)) @@ -899,7 +979,13 @@ Note that you need to handle :NULLs." (is (equal (r-list (get-dao 'listy 2)) '(A B C))) (is (equal (a-list (get-dao 'listy 2)) - :NULL))))) + :NULL)) + (is (equal (l-array (get-dao 'listy 1)) + '(1 2 3))) + (is (equal (l-array (get-dao 'listy 2)) + nil)) + (is (equal (l-array (get-dao 'listy 3)) + nil))))) (test dao-get-with-bad-import (with-test-connection @@ -915,28 +1001,52 @@ Note that you need to handle :NULLs." (with-dao-export-import-table-fixture (insert-dao (make-instance 'listy :name "first" :r-list '(a b c) :a-list '((a 1) (b 2) (c 3)) - :p-list '(a 1 b 2 c 3))) + :p-list '(a 1 b 2 c 3) + :l-array '(1 2 3))) (insert-dao (make-instance 'listy :name "second" :r-list '(a b c) - :p-list '(a 1 b 2 c 3))) + :p-list '(a 1 b 2 c 3) + :l-array '())) + (insert-dao (make-instance 'listy :name "third" :r-list '(a b c) + :p-list '(a 1 b 2 c 3) + :l-array nil)) (is (equal (r-list (first (select-dao 'listy))) '(A B C))) (is (equal (p-list (second (select-dao 'listy))) - '(A 1 B 2 C 3)))))) + '(A 1 B 2 C 3))) + (is (equal (a-list (second (select-dao 'listy))) + :NULL)) + (is (equal (l-array (first (select-dao 'listy))) + '(1 2 3))) + (is (equal (l-array (second (select-dao 'listy))) + nil)) + (is (equal (l-array (third (select-dao 'listy))) + nil))))) (test query-dao-with-import (with-test-connection (with-dao-export-import-table-fixture (insert-dao (make-instance 'listy :name "first" :r-list '(a b c) :a-list '((a 1) (b 2) (c 3)) - :p-list '(a 1 b 2 c 3))) + :p-list '(a 1 b 2 c 3) + :l-array '(1 2 3))) (insert-dao (make-instance 'listy :name "second" :r-list '(a b c) - :p-list '(a 1 b 2 c 3))) + :p-list '(a 1 b 2 c 3) + :l-array '())) + (insert-dao (make-instance 'listy :name "third" :r-list '(a b c) + :p-list '(a 1 b 2 c 3) + :l-array nil)) (is (equal (r-list (first (query-dao 'listy "select * from listy where id=1"))) '(A B C))) (is (equal (p-list (first (query-dao 'listy "select * from listy where id=2"))) '(A 1 B 2 C 3))) (is (equal (a-list (first (query-dao 'listy "select * from listy where id=2"))) - :NULL))))) + :NULL)) + (is (equal (l-array (first (query-dao 'listy "select * from listy where id=1"))) + '(1 2 3))) + (is (equal (l-array (first (query-dao 'listy "select * from listy where id=2"))) + nil)) + (is (equal (l-array (first (query-dao 'listy "select * from listy where id=3"))) + nil))))) ;; update a table from a modified dao (test dao-update-export @@ -944,24 +1054,33 @@ Note that you need to handle :NULLs." (with-dao-export-import-table-fixture (insert-dao (make-instance 'listy :name "first" :r-list '(a b c) :a-list '((a 1) (b 2) (c 3)) - :p-list '(a 1 b 2 c 3))) + :p-list '(a 1 b 2 c 3) + :l-array '(1 2 3))) (insert-dao (make-instance 'listy :name "second" :r-list '(a b c) - :p-list '(a 1 b 2 c 3))) + :p-list '(a 1 b 2 c 3) + :l-array '())) (insert-dao (make-instance 'listy :name "third" :r-list nil - :p-list '(a 1 b 2 c 3))) + :p-list '(a 1 b 2 c 3) + :l-array nil)) (let ((dao1 (get-dao 'listy 1)) (dao2 (get-dao 'listy 2))) (setf (r-list dao1) '(e f g)) + (setf (l-array dao1) '(6 7 8)) (update-dao dao1) (is (equal (query "select r_list from listy where id = 1" :single) "(E F G)")) + (is (equalp (query "select l_array from listy where id = 1" :single) + #(6 7 8))) (setf (p-list dao2) '("e" 1 f 4 g 7)) (setf (a-list dao2) nil) + (setf (l-array dao2) '(78 95)) (update-dao dao2) (is (equal (query "select p_list from listy where id = 2" :single) "(e 1 F 4 G 7)")) (is (equal (query "select a_list from listy where id = 2" :single) - "false")))))) + "NIL")) + (is (equalp (query "select l_array from listy where id = 2" :single) + #(78 95))))))) ;; upsert with an export function (test dao-upsert-export @@ -969,26 +1088,46 @@ Note that you need to handle :NULLs." (with-dao-export-import-table-fixture (insert-dao (make-instance 'listy :name "first" :r-list '(a b c) :a-list '((a 1) (b 2) (c 3)) - :p-list '(a 1 b 2 c 3))) + :p-list '(a 1 b 2 c 3) + :l-array '(1 2 3))) (insert-dao (make-instance 'listy :name "second" :r-list '(a b c) - :p-list '(a 1 b 2 c 3))) + :p-list '(a 1 b 2 c 3) + :l-array '())) (upsert-dao (make-instance 'listy :name "third" :r-list '(a b c) :a-list '(("a" 11) (b 12) (c "13c")) - :p-list '(a 1 b 2 c 3))) + :p-list '(a 1 b 2 c 3) + :l-array nil)) + (upsert-dao (make-instance 'listy :name "fourth" :r-list '(a b c) + :a-list '(("a" 11) (b 12) (c "13c")) + :p-list '(a 1 b 2 c 3) + :l-array '(12 14 56))) (is (equal (query "select a_list from listy where id = 3" :single) - "((a 11) (B 12) (C 13c))"))))) - + "((a 11) (B 12) (C 13c))")) + (is (equal (query "select l_array from listy where id = 3" :single) + :NULL)) + (is (equalp (query "select l_array from listy where id = 4" :single) + #(12 14 56))) + (signals error + (upsert-dao (make-instance 'listy :name "fourth" :r-list '(a b c) + :a-list '(("a" 11) (b 12) (c "13c")) + :p-list '(a 1 b 2 c 3) + :l-array '("aaa" "bb"))))))) +;; Here the accessor is not quite the same name as the slot-name +;; Just double checking (defclass listy-modified-accessor () ((id :col-type integer :col-identity t :accessor id) (name :col-type text :col-unique t :col-check (:<> 'name "") :initarg :name :accessor name) - (r-list :type list :col-type (or text db-null) :initarg :r-list :accessor rlist - :col-export list-to-string :col-import string-to-list) - (a-list :type alist :col-type (or text db-null) :initarg :a-list :accessor alist - :col-export list-to-string :col-import string-to-list) - (p-list :type plist :col-type (or text db-null) :initarg :p-list :accessor plist - :col-export list-to-string :col-import string-to-list)) + (r-list :col-type (or text db-null) :initarg :r-list :accessor rlist + :col-export list->string :col-import string->list) + (a-list :col-type (or text db-null) :initarg :a-list :accessor alist + :col-export list->string :col-import string->list) + (p-list :col-type (or text db-null) :initarg :p-list :accessor plist + :col-export list->string :col-import string->list) + (l-array :col-type (or (array integer) db-null) + :initarg :l-array :accessor larray + :col-export list->arr :col-import array->list)) (:metaclass dao-class) (:table-name listy)) @@ -1110,16 +1249,19 @@ Note that you need to handle :NULLs." (let ((dao1 (get-dao 'listy-modified-accessor 1)) (dao2 (get-dao 'listy-modified-accessor 2))) (setf (rlist dao1) '(e f g)) + (setf (larray dao1) '(1 2 3)) (update-dao dao1) (is (equal (query "select r_list from listy where id = 1" :single) "(E F G)")) + (is (equalp (query "select l_array from listy where id = 1" :single) + #(1 2 3))) (setf (plist dao2) '("e" 1 f 4 g 7)) (setf (alist dao2) nil) (update-dao dao2) (is (equal (query "select p_list from listy where id = 2" :single) "(e 1 F 4 G 7)")) (is (equal (query "select a_list from listy where id = 2" :single) - "false")))))) + "NIL")))))) ;; upsert with an export function (test dao-upsert-export-modified @@ -1134,20 +1276,26 @@ Note that you need to handle :NULLs." :p-list '(a 1 b 2 c 3))) (upsert-dao (make-instance 'listy-modified-accessor :name "third" :r-list '(a b c) :a-list '(("a" 11) (b 12) (c "13c")) - :p-list '(a 1 b 2 c 3))) + :p-list '(a 1 b 2 c 3) + :l-array '(1 2 3))) (is (equal (query "select a_list from listy where id = 3" :single) - "((a 11) (B 12) (C 13c))"))))) + "((a 11) (B 12) (C 13c))")) + (is (equalp (query "select l_array from listy where id = 3" :single) + #(1 2 3)))))) (defclass listy-underscore () ((id :col-type integer :col-identity t :accessor id) (name :col-type text :col-unique t :col-check (:<> 'name "") :initarg :name :accessor name) - (r_list :type list :col-type (or text db-null) :initarg :r_list :accessor rlist - :col-export list-to-string :col-import string-to-list) - (a_list :type alist :col-type (or text db-null) :initarg :a_list :accessor alist - :col-export list-to-string :col-import string-to-list) - (p_list :type plist :col-type (or text db-null) :initarg :p_list :accessor plist - :col-export list-to-string :col-import string-to-list)) + (r_list :col-type (or text db-null) :initarg :r_list :accessor rlist + :col-export list->string :col-import string->list) + (a_list :col-type (or text db-null) :initarg :a_list :accessor alist + :col-export list->string :col-import string->list) + (p_list :col-type (or text db-null) :initarg :p_list :accessor plist + :col-export list->string :col-import string->list) + (l_array :col-type (or (array integer) db-null) + :initarg :l_array :accessor larray + :col-export list->arr :col-import array->list)) (:metaclass dao-class) (:table-name listy)) @@ -1157,7 +1305,8 @@ Note that you need to handle :NULLs." (insert-dao (make-instance 'listy-underscore :name "first" :r_list '(a b c) :a_list '((a 1) (b 2) (c 3)) - :p_list '(a 1 b 2 c 3))) + :p_list '(a 1 b 2 c 3) + :l_array '(1 2 3))) (insert-dao (make-instance 'listy-underscore :name "second" :r_list '(a b c) :p_list '(a 1 b 2 c 3))) @@ -1168,6 +1317,10 @@ Note that you need to handle :NULLs." (is (equal (query "select p_list from listy where id = 1" :single) "(A 1 B 2 C 3)")) (is (equal (query "select name, a_list from listy where id = 2") + '(("second" :NULL)))) + (is (equalp (query "select name, l_array from listy where id = 1") + '(("first" #(1 2 3))))) + (is (equal (query "select name, l_array from listy where id = 2") '(("second" :NULL))))))) ;; save-dao version of above @@ -1177,10 +1330,16 @@ Note that you need to handle :NULLs." (save-dao (make-instance 'listy-underscore :name "first" :r_list '(a b c) :a_list '((a 1) (b 2) (c 3)) - :p_list '(a 1 b 2 c 3))) + :p_list '(a 1 b 2 c 3) + :l_array '(1 2 3))) (save-dao (make-instance 'listy-underscore :name "second" :r_list '(a b c) :p_list '(a 1 b 2 c 3))) + (save-dao (make-instance + 'listy-underscore :name "third" :r_list '(a b c) + :a_list '((a 1) (b 2) (c 3)) + :p_list '(a 1 b 2 c 3) + :l_array '())) (is (equal (query "select r_list from listy where id = 1" :single) "(A B C)")) (is (equal (query "select a_list from listy where id = 1" :single) @@ -1188,7 +1347,13 @@ Note that you need to handle :NULLs." (is (equal (query "select p_list from listy where id = 1" :single) "(A 1 B 2 C 3)")) (is (equal (query "select name, a_list from listy where id = 2") - '(("second" :NULL))))))) + '(("second" :NULL)))) + (is (equalp (query "select name, l_array from listy where id = 1") + '(("first" #(1 2 3))))) + (is (equal (query "select name, l_array from listy where id = 2") + '(("second" :NULL)))) + (is (equal (query "select name, l_array from listy where id = 3") + '(("third" :NULL))))))) ;; import data from a table into a dao, using an import function (test dao-get-with-import-underscore @@ -1196,11 +1361,11 @@ Note that you need to handle :NULLs." (with-dao-export-import-table-fixture (insert-dao (make-instance 'listy-underscore :name "first" :r_list '(a b c) - :a_list '((a 1) (b 2) (c 3)) - :p_list '(a 1 b 2 c 3))) + :a_list '((a 1) (b 2) (c 3)) + :p_list '(a 1 b 2 c 3))) (insert-dao (make-instance 'listy-underscore :name "second" :r_list '(a b c) - :p_list '(a 1 b 2 c 3))) + :p_list '(a 1 b 2 c 3))) (is (equal (name (get-dao 'listy-underscore 1)) "first")) (is (equal (rlist (get-dao 'listy-underscore 1)) @@ -1212,18 +1377,23 @@ Note that you need to handle :NULLs." (is (equal (rlist (get-dao 'listy-underscore 2)) '(A B C))) (is (equal (alist (get-dao 'listy-underscore 2)) - :NULL))))) + :NULL)) + (is (equal (larray (get-dao 'listy-underscore 2)) + nil)) + (is (equal (larray (get-dao 'listy-underscore 1)) + nil))))) (test select-dao-with-import-underscore (with-test-connection (with-dao-export-import-table-fixture (insert-dao (make-instance 'listy-underscore :name "first" :r_list '(a b c) - :a_list '((a 1) (b 2) (c 3)) - :p_list '(a 1 b 2 c 3))) + :a_list '((a 1) (b 2) (c 3)) + :p_list '(a 1 b 2 c 3) + :l_array '(1 2 3))) (insert-dao (make-instance 'listy-underscore :name "second" :r_list '(a b c) - :p_list '(a 1 b 2 c 3))) + :p_list '(a 1 b 2 c 3))) (is (equal (rlist (first (select-dao 'listy-underscore))) '(A B C))) (is (equal (plist (second (select-dao 'listy-underscore))) @@ -1234,11 +1404,11 @@ Note that you need to handle :NULLs." (with-dao-export-import-table-fixture (insert-dao (make-instance 'listy-underscore :name "first" :r_list '(a b c) - :a_list '((a 1) (b 2) (c 3)) - :p_list '(a 1 b 2 c 3))) + :a_list '((a 1) (b 2) (c 3)) + :p_list '(a 1 b 2 c 3))) (insert-dao (make-instance 'listy-underscore :name "second" :r_list '(a b c) - :p_list '(a 1 b 2 c 3))) + :p_list '(a 1 b 2 c 3))) (is (equal (rlist (first (query-dao 'listy-underscore "select * from listy where id=1"))) @@ -1249,8 +1419,8 @@ Note that you need to handle :NULLs." '(A 1 B 2 C 3))) (is (equal (alist - (first - (query-dao 'listy-underscore "select * from listy where id=2"))) + (first + (query-dao 'listy-underscore "select * from listy where id=2"))) :NULL))))) ;; update a table from a underscore dao @@ -1259,14 +1429,14 @@ Note that you need to handle :NULLs." (with-dao-export-import-table-fixture (insert-dao (make-instance 'listy-underscore :name "first" :r_list '(a b c) - :a_list '((a 1) (b 2) (c 3)) - :p_list '(a 1 b 2 c 3))) + :a_list '((a 1) (b 2) (c 3)) + :p_list '(a 1 b 2 c 3))) (insert-dao (make-instance 'listy-underscore :name "second" :r_list '(a b c) - :p_list '(a 1 b 2 c 3))) + :p_list '(a 1 b 2 c 3))) (insert-dao (make-instance 'listy-underscore :name "third" :r_list nil - :p_list '(a 1 b 2 c 3))) + :p_list '(a 1 b 2 c 3))) (let ((dao1 (get-dao 'listy-underscore 1)) (dao2 (get-dao 'listy-underscore 2))) (setf (rlist dao1) '(e f g)) @@ -1279,7 +1449,7 @@ Note that you need to handle :NULLs." (is (equal (query "select p_list from listy where id = 2" :single) "(e 1 F 4 G 7)")) (is (equal (query "select a_list from listy where id = 2" :single) - "false")))))) + "NIL")))))) ;; upsert with an export function (test dao-upsert-export-underscore @@ -1287,13 +1457,105 @@ Note that you need to handle :NULLs." (with-dao-export-import-table-fixture (insert-dao (make-instance 'listy-underscore :name "first" :r_list '(a b c) - :a_list '((a 1) (b 2) (c 3)) - :p_list '(a 1 b 2 c 3))) + :a_list '((a 1) (b 2) (c 3)) + :p_list '(a 1 b 2 c 3))) (insert-dao (make-instance 'listy-underscore :name "second" :r_list '(a b c) - :p_list '(a 1 b 2 c 3))) + :p_list '(a 1 b 2 c 3))) (upsert-dao (make-instance 'listy-underscore :name "third" :r_list '(a b c) - :a_list '(("a" 11) (b 12) (c "13c")) - :p_list '(a 1 b 2 c 3))) + :a_list '(("a" 11) (b 12) (c "13c")) + :p_list '(a 1 b 2 c 3))) (is (equal (query "select a_list from listy where id = 3" :single) "((a 11) (B 12) (C 13c))"))))) + +;;; Basic tests for daos in schema other than public +(defclass test-data-schema-a () + ((id :col-type serial :initarg :id :accessor test-id) + (a :col-type (or text db-null) :initarg :a :accessor test-a) + (b :col-type text :initarg :b :accessor test-b)) + (:metaclass postmodern:dao-class) + (:table-name a.dab-test) + (:keys id)) + +(defun dao-different-schema-fixture-1 () + "Drops and recreates the a.dab-test table" + (when (not (schema-exists-p 'a)) + (create-schema 'a)) + (when (table-exists-p 'a.dab-test) + (query (:drop-table :if-exists 'a.dab-test :cascade))) + (execute (dao-table-definition 'test-data-schema-a))) + +(defmacro with-dao-different-schema-fixture-1 (&body body) + `(progn + (dao-different-schema-fixture-1) + (unwind-protect (progn ,@body) + (execute (:drop-table 'a.dab-test :cascade))))) + +(defclass a.dab-test () + ((id :col-type serial :initarg :id :accessor test-id) + (a :col-type (or text db-null) :initarg :a :accessor test-a) + (b :col-type text :initarg :b :accessor test-b)) + (:metaclass postmodern:dao-class) + (:keys id)) + +(defun dao-different-schema-fixture-2 () + "Drops and recreates the a.dab-test table" + (when (not (schema-exists-p 'a)) + (create-schema 'a)) + (when (table-exists-p 'a.dab-test) + (query (:drop-table :if-exists 'a.dab-test :cascade))) + (execute (dao-table-definition 'a.dab-test))) + +(defmacro with-dao-different-schema-fixture-2 (&body body) + `(progn + (dao-different-schema-fixture-2) + (unwind-protect (progn ,@body) + (execute (:drop-table 'a.dab-test :cascade))))) + +(test create-table-different-schema + (with-test-connection + (with-dao-different-schema-fixture-1 + (is (equal (table-exists-p 'a.dab-test) + t)) + (insert-dao (make-instance 'test-data-schema-a :a "us" :b "them")) + (let ((dao (get-dao 'test-data-schema-a 1))) + (is (equal (test-a dao) + "us")) + (setf (test-b dao) "everyone") + (update-dao dao) + (is (equal (query "select b from a.dab_test where id=1" :single) + "everyone")) + (delete-dao dao) + (is (equal (query "select * from a.dab_test") + nil)))) + (with-dao-different-schema-fixture-2 + (insert-dao (make-instance 'a.dab-test :a "me" :b "you")) + (let ((dao (get-dao 'a.dab-test 1))) + (is (equal (test-a dao) + "me")) + (setf (test-b dao) "everyone") + (update-dao dao) + (is (equal (query "select b from a.dab_test where id=1" :single) + "everyone")) + (delete-dao dao) + (is (equal (query "select * from a.dab_test") + nil)))))) + +;; Testing import-export functions from cl-user package +(test from-cl-user + (fiveam:is (equal (type-of + (pomo::find-dao-column-slot (find-class 'postmodern-tests::listy) "r-list")) + 'postmodern::direct-column-slot)) + (fiveam:is (equal (type-of + (pomo::find-dao-column-slot (find-class 'postmodern-tests::listy) 'r-list)) + 'postmodern::direct-column-slot)) + (fiveam:is (equal (pomo::find-dao-column-slot (find-class 'postmodern-tests::listy) 'r-bad) + nil)) + (fiveam:is (equal (pomo::find-dao-column-slot (find-class 'postmodern-tests::listy) 'r_list) + nil)) + (fiveam:is (equal + (pomo::field-name-to-slot-name (find-class 'postmodern-tests::listy) "r_list") + 'postmodern-tests::r-list)) + (fiveam:is (equal + (pomo::field-name-to-slot-name (find-class 'postmodern-tests::listy) "r-list") + 'postmodern-tests::r-list))) diff --git a/postmodern/util.lisp b/postmodern/util.lisp index 462d89e..77730f6 100644 --- a/postmodern/util.lisp +++ b/postmodern/util.lisp @@ -1520,6 +1520,24 @@ connected database." (query (:order-by (:select 'extname :from 'pg-extension) 'extname)))) +(defun load-uuid-extension () + "Loads the Postgresql uuid-ossp contrib module. Once loaded, you can call uuid +generation functions such as uuid_generate_v4 within a query. E.g. + + (query \"select uuid_generate_v4()\") + +See Postgresql documentation at https://www.postgresql.org/docs/current/uuid-ossp.html" + (query "CREATE EXTENSION IF NOT EXISTS \"uuid-ossp\"")) + +(defun generate-uuid () + "This gets a uuid (version 4) generated by Postgresql. If the uuid-ossp module is not loaded, it +will load it first. This is probably not something you want to use because it is +potentially two calls to Postgresql to get a uuid when you could do it in a single +call within a query when you are getting other information." + (unless (member "uuid-ossp" (list-installed-extensions) :test #'equal) + (load-uuid-extension)) + (query "select uuid_generate_v4()" :single)) + (defun replace-non-alphanumeric-chars (str &optional (replacement #\_)) "Takes a string and a replacement char and replaces any character which is not alphanumeric or an asterisk with a specified character - by default an diff --git a/s-sql/s-sql.lisp b/s-sql/s-sql.lisp index ef3e8d1..9615b0e 100644 --- a/s-sql/s-sql.lisp +++ b/s-sql/s-sql.lisp @@ -186,8 +186,9 @@ for declaring a type to be an integer that may be null." (:documentation "Transform a lisp type into a string containing something SQL understands. Default is to just use the type symbol's name.") (:method ((lisp-type symbol) &rest args) - (declare (ignore args)) - (substitute #\Space #\- (symbol-name lisp-type) :test #'char=)) + (cond ((and args (equal (symbol-name lisp-type) "GEOMETRY")) ; geometry type from postgis + (format nil "geometry (~{~a~^, ~})" args)) + (t (substitute #\Space #\- (symbol-name lisp-type) :test #'char=)))) (:method ((lisp-type (eql 'string)) &rest args) (cond (args (format nil "CHAR(~A)" (car args))) (t "TEXT"))) diff --git a/s-sql/tests/test-tables.lisp b/s-sql/tests/test-tables.lisp index e53d155..df10dd4 100644 --- a/s-sql/tests/test-tables.lisp +++ b/s-sql/tests/test-tables.lisp @@ -934,3 +934,12 @@ "ALTER TABLE distributors ALTER COLUMN did ADD GENERATED ALWAYS AS IDENTITY (start with 10 increment by 10)")) (is (equal (sql (:alter-table 'distributors :alter-column 'street :add-identity-by-default t :set-statistics 1300)) "ALTER TABLE distributors ALTER COLUMN street ADD GENERATED BY DEFAULT AS IDENTITY SET STATISTICS 1300 "))) + +(test postgis-table + "Testing a few postgis specific columns" + (is (equal (sql (:create-table geo + ((geom :type (or s-sql:db-null geometry))))) + "CREATE TABLE geo (geom GEOMETRY)")) + (is (equal (sql (:create-table geo + ((geom :type (or s-sql:db-null (geometry point 4326)))))) + "CREATE TABLE geo (geom geometry (POINT, 4326))")))