DCIprogram: #Bank
" Exported from Squeak 7179-basic.226 last modified on 3 November 2014 by: Trygve"
projection: Context
Class: MoneyTransferContext
Context subclass: #MoneyTransferContext
instanceVariableNames: 'transaction'
category: 'Bank-Context'
" This is a very simple example where a user operates an automatic teller machine to transfer money from one bank account to another.
Bankers know that accounts actually exist as a summation of transaction records in the General Ledger transction collection. The accounts in this example are to be understood as caches on the Ledger.
Version a ignores the Ledger for the sake of simplicity.
Version b (this version) is more correct in that includes the Ledger with its transaction records.
"
instanceMethods: operations
transferTransaction: transact
transaction := transact.
^ self triggerInteractionFrom: #SOURCEACCOUNT with: #transferTo.
instanceMethods: role binding
AMOUNT
^transaction amount
DESTINATIONACCOUNT
^transaction toAccount
LEDGER
^transaction bank ledger
SOURCEACCOUNT
^transaction fromAccount
Interaction: MoneyTransferContext
roleMethods: SOURCEACCOUNT
instanceMethods: role methods
transferTo
LEDGER beginWork.
(SOURCEACCOUNT withdraw and: [DESTINATIONACCOUNT transferFrom])
ifTrue: [^SOURCEACCOUNT commitTransaction]
ifFalse: [^LEDGER rollback].
withdraw
SOURCEACCOUNT balance >= AMOUNT
ifTrue: [self decrease: AMOUNT. ^true]
ifFalse: [self inform: 'Insufficient funds'. ^false]
commitTransaction
LEDGER addTransaction:
(Transaction new amount: AMOUNT from: self accountNo to: DESTINATIONACCOUNT accountNo ledger: LEDGER).
^LEDGER commit.
roleMethods: DESTINATIONACCOUNT
instanceMethods: role methods
transferFrom
self increase: AMOUNT.
^true
projection: Data
Class: Account
Object subclass: #Account
instanceVariableNames: 'accountNo number balance'
category: 'Bank-Data'
" An Account object is a cache on the Ledger transactions. "
instanceMethods: private
initialize
balance := 0.
accountNo := 9999.
instanceMethods: access
accountNo
^accountNo
accountNo: num
accountNo := num.
balance
^balance
decrease: amount
balance := balance - amount.
increase: amount
balance := balance + amount.
Class: Bank
Object subclass: #Bank
instanceVariableNames: 'ledger accounts'
category: 'Bank-Data'
" commitTransaction
" database COMMIT " "
instanceMethods: private
initialize
super initialize.
accounts := Dictionary new.
(ledger := Ledger new) bank: self.
instanceMethods: access
addCheckingAccountNo: aNumber
^accounts at: aNumber put: (CheckingAccount new accountNo: aNumber).
addSavingsAccountNo: aNumber
^accounts at: aNumber put: (SavingsAccount new accountNo: aNumber).
findAccount: accountNo
^accounts at: accountNo ifAbsent: [nil]
findAccountNo: accountNo
^accounts at: accountNo ifAbsent: [nil]
ledger
^ledger
instanceMethods: database access
beginWork
self halt: 'obsolete'.
" code for database BEGIN WORK "
Transcript cr; show: 'Database BEGIN WORK'.
commit
self halt: 'obsolete'.
" code for database COMMIT "
Transcript cr; show: 'Database COMMIT'.
^'COMMIT'
rollback
self halt: 'obsolete'.
" code for database ROLLBACK "
Transcript cr; show: 'Database ROLLBACK'.
^'ROLLBACK'
transactionSet
self halt: 'Not used?'.
^ledger transactionSet
Class: CheckingAccount
Account subclass: #CheckingAccount
instanceVariableNames: ''
category: 'Bank-Data'
Class: Ledger
Object subclass: #Ledger
instanceVariableNames: 'transactionSet bank'
category: 'Bank-Data'
instanceMethods: access
addTransaction: transaction
transactionSet add: transaction.
bank
^bank
bank: bnk
bank := bnk.
beginWork
" code for database BEGIN WORK "
Transcript cr; show: 'database begin work'.
commit
" code for database COMMIT "
Transcript cr; show: 'database committed'.
^true
rollback
" code for database ROLLBACK "
Transcript cr; show: 'database rolled back'.
^false
transactionSet
^transactionSet
instanceMethods: private
initialize
super initialize.
transactionSet := Set new.
Transcript clear; show: 'database initialized'.
Class: SavingsAccount
Account subclass: #SavingsAccount
instanceVariableNames: ''
category: 'Bank-Data'
Class: Transaction
Object subclass: #Transaction
instanceVariableNames: 'ledger date amount fromAccNo toAccNo'
category: 'Bank-Data'
instanceMethods: initialize
amount: amt from: fromNo to: toNo ledger: ledg
amount := amt.
fromAccNo := fromNo.
toAccNo := toNo.
ledger := ledg.
date := Time dateAndTimeNow printString.
instanceMethods: accessing
amount
^ amount
fromAccount
^ ledger bank findAccount: fromAccNo
toAccount
^ ledger bank findAccount: toAccNo
projection: Testing
Class: Testing
Object subclass: #Testing
instanceVariableNames: 'bank account1 account2'
category: 'Bank-Testing'
" See comment in Context >> MoneyTransferContext "
instanceMethods: operations
test
" Testing test "
bank := Bank new.
account1 := bank addCheckingAccountNo: 1111.
account2 := bank addSavingsAccountNo: 2222.
self test1.
self test2.
test1
" Testing test1 "
| transaction1 |
account1 increase: 2000.
self assert:
[account1 balance = 2000 &
account2 balance = 0].
"((MoneyTransferContext new bank: bank) transfer: 500 from: account1 to: account2)"
transaction1 := BB5aTransaction new bank: bank amount: 500 from: 1111 to: 2222.
(MoneyTransferContext new transferTransaction: transaction1)
ifTrue:
[self assert:
[(bank ledger transactionSet anySatisfy:
[:trans | trans amount = 500
and: [trans fromAccount = account1
and: [trans toAccount = account2]]] )
& account1 balance = 1500
& account2 balance = 500].
self inform: 'Test1 OK' , String cr , 'Close this box and get error: Insuffucient funds.'.]
ifFalse:
[self inform: 'Test1 failure'].
test2
| transaction2 |
self assert:
[account1 balance = 1500 &
account2 balance = 500].
transaction2 := BB5aTransaction new bank: bank amount: 5000 from: 1111 to: 2222.
(MoneyTransferContext new transferTransaction: transaction2)
ifTrue:
[self assert:
[ bank ledger transactionSet noneSatisfy:
[:trans |
trans amount = 5000
and: [trans sourceAccount = account1
and: [trans destinationAccount = account2]]] ]
descriptionBlock: [self inform: 'Test2 OK, it has failed as expected!']]
ifFalse:
[self inform: 'error. Test2 OK, it has failed as expected!'].
classMethods: tests
test
" Testing test "
self new test.