;;; Project:           Scheme-PG
;;; Author:            David J. Neu, djneu@acm.org
;;; Maintainer:        David J. Neu, djneu@acm.org
;;; Project Home Page: http://scheme-pg.sourceforge.net
;;; Copyright:         Copyright (c) 2004 Universal Technical Resource Services, Inc.
;;; License:           MIT License, see license.txt
;;; CVS Id:            $Id: examples.ss,v 1.4 2005/02/18 19:14:44 djneu Exp $

(module examples
  mzscheme

  (require (lib "errortrace.ss" "errortrace"))
  (require (lib "scheme-pg.ss" "scheme-pg"))

  (printf "Before running this program please comment out the call to (exit) and~n")
  (printf "notice that the program attempts to drop a table pers, and it creates~n")
  (printf "a table pers in a user specified db.  This safeguard is included to~n")
  (printf "avoid unwanted changes to your DBMS.~n")

  ;;(exit)

  (define prompt
    (lambda (aprompt)
      (printf "~a: " aprompt)
      (read)))

  (define ldbname (prompt "dbname"))
  (define lusername (prompt "username"))
  (define lpassword (prompt "password"))

  (define lconnection (connection-open (format "dbname=~a user=~a password=~a" ldbname lusername lpassword)))

;;; Example 1: Set up a simple database table and insert some records
;;; using all four insert syntax
                                        ; Drop table if it exists, but don't bomb if it doesn't.
  (with-handlers
      ((exn?
        (lambda (e) (printf "table pers does not exist - continuing ...~n"))))
    (execute-sql lconnection "DROP table pers"))

  (execute-sql lconnection
               "CREATE TABLE pers (id serial PRIMARY KEY,
                                   \"first-name\" character varying(25),
                                   \"last-name\" varchar(25),
                                   age float4,
                                   birthday timestamp without time zone);")
  
  (execute-sql lconnection (insert pers (1 "Mary" "Smith" 20 "1983-10-12 02:50:41")))

  (execute-sql lconnection
               (insert pers ((id 2) (first-name "John") (last-name "Doe") (age 40) (birthday "1960-01-01 12:30:04"))))

  (execute-sql lconnection
               (insert pers ((id . 3) (first-name . "Mary") (last-name . "Doe") (age . 36) (birthday . "1965-02-01 17:55:44"))))

  (execute-sql lconnection (insert pers (id first-name last-name age birthday) (4 "Baby" "Doe" 1.5 "2003-03-01 01:02:03")))

;;; Example 2: Use a result to display the rows retrieved by a query
  (define lresult (result-open lconnection (select all (pers))))
  (let loop ((llength (result-length lresult))
             (i 0))
    (when (> llength 0)
      (printf "~a~n" (result-ref lresult i))
      (loop (sub1 llength) (add1 i))))
  (result-close lresult)

  (newline)(newline)

;;; Example 3: Use a cursor to display the rows retrieved by a query
  (define lcursor (cursor-open lconnection (select all (pers) (order-by ((last-name asc) (first-name desc)))) 'server))
  (let loop ((lrow (cursor-next lcursor)))
    (when (not (eoc-object? lrow))
      (begin
        (printf "~a ~a ~a ~a ~a~n"
                (cdr (assq 'id lrow))
                (cdr (assq 'first-name lrow))
                (cdr (assq 'last-name lrow))
                (cdr (assq 'age lrow))
                (cdr (assq 'birthday lrow)))
        (loop (cursor-next lcursor)))))
  (cursor-close lcursor)

  (newline)(newline)

;;; Example 4: Use a cursor to create a list of the rows retrieved by
;;; a query
  (define query-four
    (select all (pers)
            (where (like first-name "M%"))
            (order-by ((age asc)))))

  (define loop-forward
    (lambda (aconnection)
      (let ((lcursor (cursor-open aconnection query-four 'client)))
        (let loop ((lrow (cursor-first lcursor)))
          (if (eoc-object? lrow)
              (begin
                (cursor-close lcursor)
                '())
              (cons lrow (loop (cursor-next lcursor))))))))

  (display (loop-forward lconnection))
  (newline)(newline)

;;; Example 5: Same as the previous example except it loops through
;;; the rows in reverse order
  (define loop-backward
    (lambda (aconnection)
      (let ((lcursor (cursor-open aconnection query-four 'client)))
        (let loop ((lrow (cursor-last lcursor)))
          (if (eoc-object? lrow)
              (begin
                (cursor-close lcursor)
                '())
              (cons lrow (loop (cursor-previous lcursor))))))))

  (display (loop-backward lconnection))
  (newline)(newline)

;;; Example 6: Use the list-like syntax of a stream to display the
;;; rows retrieved by a query
  (define lstream (stream lconnection (select all (pers) (order-by ((id asc)))) 'server))
  (let loop ((lstream lstream))
    (when (not (stream-null? lstream))
      (begin
        (printf "~a~n" (stream-car lstream))
        (loop (stream-cdr lstream)))))

  (newline)(newline)

;;; Example 7: Use execute-sql to INSERT, UPDATE, DELETE, show the
;;; number of records affected and demonstrate the advantages of
;;; quasiquoting.
  (let ((lnumber-rows (execute-sql lconnection (insert pers (5, "Joe" "Smith" 25 "1982-12-15 14:20:01")))))
    (printf "~a rows inserted~n" lnumber-rows))

  (let ((lnumber-rows (execute-sql lconnection (update pers ((first-name "Jospeh")) (where (= (pers id) 5))))))
    (printf "~a rows updated~n" lnumber-rows))

  (define get-first-name
    (lambda ()
      "Mary"))

  (let ((lnumber-rows (execute-sql lconnection (delete pers (where (and (= first-name ,(get-first-name)) (like last-name "Smi%")))))))
    (printf "~a rows deleted~n" lnumber-rows))

  (newline)(newline)

;;; Example 8: Demonstrate distinct and limit.
  (define lstream-distinct (stream lconnection (select-distinct (last-name) (pers)) 'server))
  (let loop ((lstream-distinct lstream-distinct))
    (when (not (stream-null? lstream-distinct))
      (begin
        (printf "~a~n" (stream-car lstream-distinct))
        (loop (stream-cdr lstream-distinct)))))

  (newline)(newline)

  (define lstream-limit (stream lconnection (select all (pers) (order-by ((id asc))) (limit 2 1)) 'server))
  (let loop ((lstream-limit lstream-limit))
    (when (not (stream-null? lstream-limit))
      (begin
        (printf "~a~n" (stream-car lstream-limit))
        (loop (stream-cdr lstream-limit)))))

  (connection-close lconnection))