extra/bank/bank.factor

   1 USING: accessors calendar kernel money new-slots sequences ;
   2 IN: bank
   3
   4 MIXIN: policy
   5 TUPLE: simple-policy interest-rate ;
   6 INSTANCE: simple-policy policy
   7 C: <simple-policy> simple-policy
   8
   9 GENERIC: interest-rate ( date account policy -- rate )
  10 M: simple-policy interest-rate 2nip interest-rate>> ;
  11
  12 : daily-interest-rate ( date account policy -- rate )
  13     pick days-in-year >r interest-rate r> / ;
  14
  15 TUPLE: account name balance transactions ;
  16
  17 : <account> ( name -- account )
  18     0 V{ } clone account construct-boa ;
  19
  20 TUPLE: transaction date amount description ;
  21
  22 C: <transaction> transaction
  23
  24 : >>transaction ( account transaction -- account )
  25     over transactions>> push ;
  26
  27 : open-account ( date opening-balance name -- account )
  28     <account> >r "Account Opened" <transaction> >>transaction ;
  29
  30 : open-account-now ( opening-balance name -- account )
  31     now -rot open-account ;
  32
  33