Outdated egg!

This is an egg for CHICKEN 4, the unsupported old release. You're almost certainly looking for the CHICKEN 5 version of this egg, if it exists.

If it does not exist, there may be equivalent functionality provided by another egg; have a look at the egg index. Otherwise, please consider porting this egg to the current version of CHICKEN.

ssql-record
  1. Outdated egg!
  2. ssql-record
    1. Description
    2. Dependencies
    3. Author
    4. Documentation
      1. define-ssql-record
      2. <ssql-record>-select
      3. <ssql-record>-rec-select
      4. <ssql-record>-select-all
      5. <ssql-record>-update
      6. <ssql-record>-rec-update
      7. <ssql-record>-insert
      8. <ssql-record>-rec-insert
      9. <ssql-record>-delete
      10. <ssql-record>-rec-delete
    5. Examples
    6. License
    7. Version history
      1. version 0.2
      2. version 0.1

Description

This is a simple egg to avoid SSQL boilerplate code when prototyping. It does not provide optimized SSQL code, only generic SSQL for sketching up some DB programs. The code is located at https://github.com/arthurmaciel/ssql-record.

Dependencies

The egg depends on typed-records and srfi-1.

Author

Arthur Maciel

Documentation

define-ssql-record

[syntax] (define-ssql-record <record-name> (<id1> [<id2> ...] ) <other-field1> [<other-field2> ...] )

Creates a record with useful procedures to generate SSQL code. The first item after the <record-name> MUST be a list containing one or more <id>s.

<ssql-record>-select

[procedure] (<ssql-record>-select cols [ssql])

cols must be a list as '(columns <col1> [<col2> ...] ). ssql is optional and if provided must be a list of lists like '((where (< 1 id))) or '((where (= 123 id)) (order name)).

<ssql-record>-rec-select

[procedure] (<ssql-record>-rec-select record [ssql])

record must be a <ssql-record>. ssql is optional and if provided must be a list of lists. Automatically builds a where clause with record's <id>s.

<ssql-record>-select-all

[procedure] (<ssql-record>-select-all [ssql])

Returns a SSQL select statement that selects all columns defined at the creation of <ssql-record> in the same specified order. ssql is optional and if provided must be a list of lists like '((where (< 1 id)) or '((where (= 123 id)) (order name)).

<ssql-record>-update

[procedure] (<ssql-record>-update ssql)

ssql is mandatory and must be a list of lists like '((set (name "Bob") (surname "Spitzer")) [(where (< 1 id))]).

<ssql-record>-rec-update

[procedure] (<ssql-record>-rec-update record)

No ssql can be appended to this command. Automatically builds a where clause with record's <id>s.

<ssql-record>-insert

[procedure] (<ssql-record>-insert ssql)

ssql is mandatory and must be a list of lists like '([(columns name surname)] (values #("Bob" "Spitzer"))).

<ssql-record>-rec-insert

[procedure] (<ssql-record>-rec-insert record)

Generates a SSQL insert statement with all record's fields, except for <id>s if anyone of them is 'NULL (in both single or composite id scenarios).

<ssql-record>-delete

[procedure] (<ssql-record>-delete [ssql])

ssql is optional and if provided must be a list of lists like '((where (in id #(10 11 93)))).

<ssql-record>-rec-delete

[procedure] (<ssql-record>-rec-delete record)

Generates a SSQL delete statement with a where clause correctly assigned to record's <id>s.

Examples

Record creation:

(use ssql ssql-record)

;; A record with composite ids.
(define-ssql-record doc (num date) type author access_type)

(define d1 (alist->doc '((num . 1) (date . "5/11/2016") (type . 2) (author . "Bob"))))
(define d2 (make-doc num: 1 date: "5/11/2016" type: 2 author: "Bob"))
(define d3 (list->doc '(1 "5/11/2016" 2 "Bob" NULL))) ; list-><ssql-record> needs all fields

Record accessors:

;; All unspecified fields are set to 'NULL.
(doc->alist d1)
=> `((num . 1) (date . "5/11/2016") (type . 2) (author . "Bob") (access_type . NULL))

(doc-num d1)
=> 1

(doc-fields)
=> '(num date type author access_type)

(doc-select '(columns num date) '((where (= id 3))))
=> '(select (columns num date) (from doc) (where (= id 3)))

(doc-rec-select d1)
=> '(select (columns num date type author access_type) (from doc) (where (= num 1) (= date "5/11/2016")))

(doc-select-all)
=> '(select (columns num date type author access_type) (from doc))

(doc-update '((set (type 3) (author "Bob")) (where (= id 4))))
=> '(update (table doc) (set (type 3) (author "Bob")) (where (= id 4)))

(doc-rec-update d1)
=> `(update (table doc) (set (type 2) (author "Bob") (access_type NULL)) (where (= num 1) (= date "5/11/2016")))

(doc-insert '((values #(3 "11/5/2016" 8 9 "Boo" NULL)))
=> '(insert (into doc) (values #(3 "11/5/2016" 8 9 "Boo" NULL)))

(doc-rec-insert d1)
=> `(insert (into doc) (columns num date type author access_type) (values #(1 "5/11/2016" 2 "Bob" NULL)))

(doc-delete '((where (= id 3))))
=> '(delete (from doc) (where (= id 3)))

(doc-rec-delete d1)
=> '(delete (from doc) (where (= num 1) (= date "5/11/2016")))

Editing records:

(use ssql ssql-record)

(define-ssql-record person (id) name dob gender)

(define p (alist->person '((name . "Bob") (dob . "5/11/1992") (gender . "male"))))

;; Does not insert id if it is not set.
(person-rec-insert p)
=> (insert (into person) (columns name dob gender) (values #("Bob" "5/11/1992" "male"))

(person-id-set! p 1)
(person-rec-insert p)
=> (insert (into person) (columns id name dob gender) (values #(1 "Bob" "5/11/1992" "male")))

(ssql->sql #f (person-rec-insert p))
=> "INSERT INTO person (id, name, dob, gender) VALUES (1, 'Bob', '5/11/1992', 'male')"

An egg for syntax convenience when prototyping (not designed to be an ORM):

(use ssql ssql-record)

(define-ssql-record author (id) firstname lastname)
(define-ssql-record ticket (id) title author_id description)

;; Suppose the procedure $db transforms SSQL into SQL and 
;; send statements to the database.
(define t
  (alist->ticket '((title . "Smashed stack") 
                   (author_id . ($db (author-select '(columns id) 
                                                    '((where (and (= firstname "Bob")
                                                                  (= lastname "Spitzer"))))) 
                   (description . "No idea how to fix it"))))

($db (ticket-rec-insert t))

;; Ticket t needs to be edited
(ticket-description-set! t "Found the culprit: Alex One")
($db (ticket-rec-update t))

select-all and list-><ssql-record>:

(use ssql ssql-record)

(define-ssql-record authors (id) firstname lastname)

;; Suppose the procedure $db transforms SSQL into SQL and 
;; send statements to the database, retrieving a list of
;; lists as result.
(define authors-list
   (map list->authors 
        ($db (authors-select-all))

(define sxml
   (map (lambda (a) 
           `(div (span ,(authors-id a))
                 (span ,(authors-firstname a))
                 (span ,(authors-lastname a))))
        authors-list))

;; send 'sxml' to be rendered...

Automatic translating table and record names:

(use ssql ssql-record)

;; Default translate procedure converts "-" to "_".
(define-ssql-record test-table (id) test-name test-address)

(test-table-rec-update 
    (alist->test-table '((id . 1) (test-name . "Bob") (test-address . "Bob St.")))))))

=> 
'(update (table test_table)
         (set (test_name "Bob") (test_address "Bob St."))
         (where (= id  1)))

;; Changing translation procedure
(define-for-syntax translate ;; need to be placed *before* define-ssql-record
    (lambda (str)
       (string->symbol (string-translate* (->string str) '(("-" . "___"))))))

(define-ssql-record test-table (id) test-name test-address)

(test-table-rec-update 
    (alist->test-table '((id . 1) (test-name . "Bob") (test-address . "Bob St.")))))))

=> 
'(update (table test___table)
         (set (test___name "Bob") (test___address "Bob St."))
         (where (= id  1)))

License

 
 Copyright (C) 2017 Arthur Maciel
 
 All rights reserved.
 
 Redistribution and use in source and binary forms, with or without
 modification, are permitted provided that the following conditions are met:
     * Redistributions of source code must retain the above copyright
       notice, this list of conditions and the following disclaimer.
     * Redistributions in binary form must reproduce the above copyright
       notice, this list of conditions and the following disclaimer in the
       documentation and/or other materials provided with the distribution.
     * Neither the name of the <organization> nor the
       names of its contributors may be used to endorse or promote products
       derived from this software without specific prior written permission.
 
 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
 ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
 WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
 DISCLAIMED. IN NO EVENT SHALL <COPYRIGHT HOLDER> BE LIABLE FOR ANY
 DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
 (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
 ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
 SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

Version history
version 0.2
version 0.1