; "bank.oo"  -- simple bank system example

;;-----------------
;; person interface
;;-----------------

(define-predicate PERSON?)

(define-operation (NAME obj))
(define-operation (AGE obj))
(define-operation (SET-AGE! obj new-age))
(define-operation (SSN obj password)) ;; Social Security # is protected
(define-operation (NEW-PASSWORD obj old-passwd new-passwd))
(define-operation (BAD-PASSWORD obj bogus-passwd)
  ;; assume internal (design) error
  (error (format #f "Bad Password: ~s given to ~a~%" 
                    bogus-passwd
		    (print obj #f)))
)


;;----------------------
;; person implementation
;;----------------------

(define (MAKE-PERSON a-name an-age a-SSN the-password)
  (object
    ((PERSON? self) #t)
    ((NAME self) a-name)
    ((AGE self) an-age)
    ((SET-AGE! self val) (set! an-age val) an-age)
    ((SSN self password)
     (if (equal? password the-password)
         a-SSN
	 (bad-password self password))
    )
    ((NEW-PASSWORD obj old-passwd new-passwd)
     (cond
       ((equal? old-passwd the-password) (set! the-password new-passwd) self)
       (else (bad-password self old-passwd))
    ))
    ((BAD-PASSWORD self bogus-passwd)
     (format #t "Bad password: ~s~%" bogus-passwd))  ;; let user recover
    ((PRINT self port)
	 (format port "#<Person: ~a age: ~a>" (name self) (age self)))
) )

;;--------------------------------------------
;; account-history and bank-account interfaces
;;--------------------------------------------

(define-predicate BANK-ACCOUNT?)

(define-operation (CURRENT-BALANCE account pin)
(define-operation (ADD obj amount))
(define-operation (WITHDRAW obj amount pin))
(define-operation (GET-PIN account master-password))
(define-operation (GET-ACCOUNT-HISTORY account master-password))

;;-------------------------------
;; account-history implementation
;;-------------------------------
;; put access to bank database and report generation here

(define (MAKE-ACCOUNT-HISTORY initial-balance a-PIN master-password)
  ;; history is a simple list of balances -- no transaction times
  (letrec ( (history (list initial-balance)) 
            (balance (lambda () (car history))) ; balance is a function
            (remember 
              (lambda (datum) (set! history (cons datum history))))
          )
    (object
      ((BANK-ACCOUNT? self) #t)
      ((ADD self amount) ;; bank will accept money without a password
       (remember (+ amount (balance)))
       ;; print new balance
       (format #t "New balance: $~a~%" (balance)) 
      )
      ((WITHDRAW self amount pin)
       (cond
          ((not (equal? pin a-pin)) (bad-password self pin))
	  ((< (- (balance) amount) 0)
	   (format #t 
	          "No overdraft~% Can't withdraw more than you have: $~a~%"
		  (balance))
          )
	  (else
	    (remember (- (balance) amount)))
      ))
      ;; only bank has access to account history
      ((GET-ACCOUNT-HISTORY account password) 
       (if (eq? password master-password)
           history
	   (bad-password self password)
      ))
) ) )

;;----------------------------
;; bank-account implementation
;;----------------------------

(define (MAKE-ACCOUNT a-name an-age a-SSN a-PIN initial-balance master-password)
  (object-with-ancestors 
     ( (customer (make-person a-name an-age a-SSN a-PIN))
       (account  (make-account-history initial-balance a-PIN master-password))
     )
     (object
       ((GET-PIN self password)
        (if (eq? password master-password)
	    a-PIN
	    (bad-password self password)
       )
       ((GET-ACCOUNT-HISTORY self password)
        (operate-as account get-account-history self password)
       )
       ;; our bank is very conservative...
       ((BAD-PASSWORD self bogus-passwd)
        (format #t "~%CALL THE POLICE!!~%")  
       )
       ;; protect the customer as well
       ((SSN self password) 
        (operate-as customer SSN self password)
       )
       ((PRINT self port)
        (format port "#<Bank-Customer ~a>" name))
) )  )