13MONEY LIBRARY

MONEY LIBRARY

Now that we have covered most of the essentials for Lisp development in Emacs, we'll develop a couple of projects to get a little more practice in. You'll be able to see how the pieces fit together, how to use features like the CLOS, how to get dependency libraries from the Common Lisp ecosystem, etc. Later we'll deploy one as a CLI app.

For this project, we are going to build a simple library for dealing with money called almighty-money.

In our library, money will be an integer with some extras. Money has a currency–USD, JPY, etc.–that both limits how mathematical operations can be conducted on it and how it is displayed. You can add 5 to 5, but you can't add 5 USD into 5 JPY directly. USD is displayed with dollars on the left of a decimal, cents on the right: $10.52. 1000 USD is displayed with a comma after the 1: $1,000. This is true of every three digits–counting from right to left on the dollars side. USD uses the $ sign, and it's placed at the beginning of the number.

The math functions that will be implemented for this library are simple: money+, money-, money*, money/, money=, money>, money<, and money-split. money-split is used for splitting a money amount n ways, while also distributing any remainder in the most minor-unit of the currency from left-to-right among the splits.

We won't be doing any currency conversion here; we just want a way to do simple math on numbers that are a little special.

The library also includes support for US dollars and Japanese yen, demonstrating how to extend the library with support for more currencies via print-object, format-money, make-money, and helper functions like usd and jpy.

This library includes some important features for maintaining mathematical precision and allows money amount values to be saved and read back from databases. money amount values include "guard digits" that are persisted until "settling" occurs. When an invoice needs to be created, when a transfer takes place, when a discount needs to be applied, etc. the actual "real" or "deguarded" amount is created.

We will use Common Lisp's hash-tables and OOP facilities to make our library extensible: I don't know how to display whatever the currency is in El Salvador or Poland, but we'll make it easy for someone from there to add support for those currencies without modifying our code.

13.1MONEY LIBRARY

Project Setup

This is going to be a simple project, requiring only one lisp file and a system file.

Make a file named almighty-money.asd in a directory called almighty-money. Save that file and make another file in that same directory named main.lisp. Save that one, too. Those are the only files we'll need. Very small library.

In almighty-money.asd, add this code:

(defsystem "almighty-money"
  :author "Micah Killian"
  :version "0.0.1"
  :description "A Library for Safely Handling Money"
  :components ((:file "main")))

The rest of the code for this project will go inside the main.lisp file.

(defpackage #:almighty-money
  (:use #:cl))
(in-package #:almighty-money)
13.2MONEY LIBRARY

A Money Type

Let's say that we have two numbers, 5000 and 3000. We want to add those numbers, but there's a catch: we need to know that they are the same type of number. If we are putting $5,000 and ¥3,000 into our wallet, we want to keep them separate. 7/11 in Japan doesn't want our dollars, and 7/11 in the US doesn't want our yen, so we can't mix them all willy nilly. We need to keep them separate and treat them as two entirely different types of money.

In Common Lisp, to create a new type, we use defclass. So let's create a money type:

(defclass money ()
  ((amount :initarg :amount
           :initform 0
           :accessor amount
           :type integer)
   (currency-code :initarg :currency-code
                  :initform (error "CURRENCY-CODE required.")
                  :accessor currency-code
                  :type string)
   (minor-digits :initarg :minor-digits
                 :initform 0
                 :accessor minor-digits
                 :type integer))
  (:documentation "An abstract base class for currencies. Any
 class that inherits from the `money' class must provide a default
 `currency-code'

`amount' is an integer. Ex. 1000000. This value reflects the smallest monetary
unit for each currency. A `money' object with `amount' 5000 and `currency-code'
\"USD\" means $50.00, or 5,000 cents.

`amount' will internally include some extra `+guard-digits+' to maintain
accuracy between math operations. `make-money' constructs `money' objects that
are guarded. `make-money-raw' constructs `money' objects that are unguarded.
`make-money-raw' is intended for use between math objects on `money' objects,
and for constructing `money' objects from the guarded values saved in databases.

`currency-code' is a string using the ISO 4217 format. Ex. \"USD\"

`minor-digits' is an integer delimiting how many digits are to the right of the
 decimal in a currency.

Typically you want to make `money' objects either with `make-money',
`make-money-raw', or a helper function for a currency."))

Although the :type won't be reliably enforced because enforcement is implementation dependent, it's still useful as documentation.

The amount slot is an integer, and it represents the smallest monetary unit for its currency. That means that 5000 USD is $50.00 and 5000 JPY is ¥5,000. Since we intend to save these values to a database, we won't be able to make use of Common Lisp's excellent rational number support.

currency-code, as it says in the documentation, is a string that uses the ISO 4217 format, as in "USD", "JPY", "EUR", etc.

minor-digits refers to the number of digits to the right of the decimal, as in USD $3.50–with 50 being the minor digits. Since amount holds an integer representing the amount using the smallest unit in the currency, $3.50 is represented at 350 in the amount slot. minor-digits is used for display purposes.

13.3MONEY LIBRARY

Making Money

Now, let's try making some money:

(make-instance 'money :amount 4000 :currency-code "USD" :minor-digits 2)
Returns
#<MONEY {700B58CC93}>

We see one of the downsides of using OOP: the representation of the money object in the REPL is unhelpful. We will fix DX problems like that later. For now, let's define a make-money function to make the code a bit less verbose:

(defun make-money (amount &optional (currency-code *default-currency*))
  "Makes a `money' object of a certain registered currency, applying
`guarded-amount' to the `amount'. Use this when making fresh `money' objects."
  (unless (integerp amount)
    (error 'type-error :datum amount :expected-type 'integer))
  (unless (stringp currency-code)
    (error 'type-error :datum currency-code :expected-type 'string))
  (let* ((registered-currency (get-registered-currency currency-code)))
    (make-instance registered-currency :amount (guarded-amount amount))))

We enforce the type of the amount and currency-code slots here in the constructor.

The default currency is a global variable because we would like users to be able to configure it to work easily with their currency. Additionally, we need a way for users to be able to register new currencies, and then look up registered currencies.

(defparameter *default-currency* "USD")

(defparameter *registered-currencies* (make-hash-table :test #'equalp))

(defun register-currency (currency-code currency-class)
  "Register a currency that inherits from `money'."
  (setf (gethash currency-code *registered-currencies*) currency-class))

(defun get-registered-currency (currency-code)
  (multiple-value-bind (value foundp)
      (gethash currency-code *registered-currencies*)
    (unless foundp
      (error "There is no registered currency with code ~a.~%" currency-code))
    value))

This is a simple way to make this library extensible. People making new currencies can just register their currency and our library will find it.

The guarded-amount function applies the "guard digits" I mentioned in the introduction.

(defconstant +guard-digits+ 4)

(defun guarded-amount (amount)
  "A `money' object `amount' with `+guard-digits+' added to increase precision."
  (* amount (expt 10 +guard-digits+)))

We'll see in a bit how the guard digits look in action when we build the math operations.

Let's add USD as a type:

(defclass us-dollar (money)
  ((currency-code :initform "USD")
   (minor-digits :initform 2)))

(register-currency "USD" 'us-dollar)

(defun usd (amount)
  (make-money amount "USD"))

(usd 5000)
Returns
#<US-DOLLAR {700BA1CC73}>

Again, the printed form of the object isn't very helpful, so let's fix that.

13.4MONEY LIBRARY

Improving Ergonomics

When we print a money object, it looks like #<US-DOLLAR {7006D80343}>, when what we really want is for it to look like #<US-DOLLAR 5000>.

We do that with the print-object generic function. We can change how an object is printed by creating a method specialized on our us-dollar type.

(defun settled-usd-string (usd)
  (let* ((cents (settled-amount usd))
         (scale (expt 10 (minor-digits usd)))
         (magnitude (abs cents))
         (major (truncate magnitude scale))
         (minor (mod magnitude scale)))
    (format nil "~:[~;-~]$~d.~v,'0d" (minusp cents) major (minor-digits usd) minor)))

(defmethod print-object ((this us-dollar) stream)
  (print-unreadable-object (this stream :identity t)
    (format stream "USD ~a ~a" (settled-usd-string this) (amount this))))

(defmethod format-money (stream (this us-dollar))
  (format stream "~a" (settled-usd-string this)))

(usd 500)
Returns
#<USD $5.00 5000000 {70080B61A3}>

settled-usd-string breaks the settled-amount into "major" and "minor" parts. The format string is hardcore, so strap in for the explanation.

First, there's ~:[~;-~]. To understand it, first let's look at a simpler form, one without the colon before the left bracket.

(format nil "~[Dude~;Man~;Girl~]" 1)
Returns
Man

The Tilde Left/Right Brackets can contain an arbitrary number of possible return values separated by Tilde semicolon. format will take the argument passed to Tilde Brackets, an integer, and format the nth value in the brackets.

With the colon, however, things are different. In that case, there can only be two possibilities or "sections". The first one is chosen if it's passed nil, otherwise the second is chosen.

(format nil "~:[Dude~;Man~]" nil)
Returns
Dude

So now it should be easy to understand what this outputs.

Buffer

almighty/money-library.lisp

Package

almighty-money

(format nil "~:[Positive~;Negative~]" (minusp 42))
Returns
Positive
Notes

plusp is its positive twin.

(format nil "~:[Positive~;Negative~]" (minusp -42))
Returns
Negative

So we use the value of (minusp cents), which is the settled-amount before any other operations are done on it, to determine whether to put a - before the $, which in this case is actually formatted as-is.

(let* ((num -9876)
       (magnitude (abs num)))
  (format nil "~:[~;-~]$~d" (minusp num) magnitude))
Returns
-$9876

The ~d directive is used to format a decimal. When it has the colon modifier, it will add commas after every three digits.

(let* ((num -9876)
       (magnitude (abs num)))
  (format nil "~:[~;-~]$~:d" (minusp num) magnitude))
Returns
-$9,876

In the case of settled-usd-string, the Tilde D consumes the major value.

The big finale is that insane ~v,'0d. It's actually just the Tilde D again, with some options added. Format directives can be modified by optional parameters–separated by commas–and by modifiers COLON or AT-SIGN. For Tilde D, we have four possible parameters:

  1. mincol
  2. padchar
  3. comma
  4. interval

The v actually consumes the (minor-digits usd) value–specifying the mincol or minimum column width of the Tilde D value. In this case, it is the equivalent of ~2,'0d, since that is the number of minor-digits for us-dollars. If you write ~2,'0d, then you can skip the (minor-digits usd).

Let's take a tour of the parameters and observe their effects:

(let ((small-num 7)
      (big-num 987654321)
      (padding 4))
  (format t "~%~40a | ~d | ~d"                      "no modifications"                      small-num big-num)
  (format t "~%~40a | ~4d | ~4d"                    "mincol of 4"                           small-num big-num)
  (format t "~%~40a | ~4,'xd | ~4,'xd"              "mincol padding using character x"      small-num big-num)
  (format t "~%~40a | ~v,'xd | ~v,'xd"              "mincol padding specified by argument"  padding small-num padding big-num)
  (format t "~%~40a | ~v,'x:d | ~v,'x:d"            "colon added"                           padding small-num padding big-num)
  (format t "~%~40a | ~v,'x,'x:d | ~v,'x,'x:d"      "commas replaced with x"                padding small-num padding big-num)
  (format t "~%~40a | ~v,'x,'x,1:d | ~v,'x,'x,1:d"  "comma interval set to 1"               padding small-num padding big-num)
  (format t "~%~40a | ~v,'x@d | ~v,'x,'x,1@d"       "colon replaced with at-sign"           padding small-num padding big-num)
  (format t "~%~40a | ~v,'x@:d | ~v,'x,'x,1@:d"     "at-sign and colon combined"            padding small-num padding big-num))
Returns
no modifications                         | 7 | 987654321
mincol of 4                              |    7 | 987654321
mincol padding using character x         | xxx7 | 987654321
mincol padding specified by argument     | xxx7 | 987654321
colon added                              | xxx7 | 987,654,321
commas replaced with x                   | xxx7 | 987x654x321
comma interval set to 1                  | xxx7 | 9x8x7x6x5x4x3x2x1
colon replaced with at-sign              | xx+7 | +987654321
at-sign and colon combined               | xx+7 | +9x8x7x6x5x4x3x2x1 => NIL
(let ((num -9876))
  (format nil "~2,'0d" num))
Returns
-9876

But what is the ,'0? Comma separates the mincol and padchar–the character to pad with if the value consumed by ~d isn't at least as long as mincol.

The padchar is, in this case, going to be the character 0, which is quoted.

(let ((num -9876))
  ; Bump MINCOL to 10
  (format nil "~10,'0d" num))
Returns
00000-9876

Looks funky, but you get the idea.

So back to settled-usd-string:

(defun settled-usd-string (usd)
  (let* ((cents (settled-amount usd))
         (scale (expt 10 (minor-digits usd)))
         (magnitude (abs cents))
         (major (truncate magnitude scale))
         (minor (mod magnitude scale)))
    (format nil "~:[~;-~]$~d.~v,'0d" (minusp cents) major (minor-digits usd) minor)))

If (usd 5995) is 5995 cents or $59.95, then:

Buffer

almighty/money-library.lisp

Package

almighty-money

(expt 10 2)
Returns
100
Buffer

almighty/money-library.lisp

Package

almighty-money

(truncate 5995 (expt 10 2))
Returns
59
Buffer

almighty/money-library.lisp

Package

almighty-money

(mod 5995 100)
Returns
95

We now have our dollars and cents. If we input raw as arguments to format:

(format nil "~:[~;-~]$~d.~v,'0d" nil 59 2 95)
Returns
$59.95

And if it's (usd 5000):

(mod 5000 100)
Returns
0

We have only one zero, hence the need for the padding of n minor-digits with the character 0.

13.5MONEY LIBRARY

Adding money

The core purpose of this library is this: ensure that only money of the same currency is combined or compared mathematically, and that money amounts stay precise between many math operations. The implementation of the money+ function is going to be simple:

(defun moneyp (x)
  (typep x 'money))

(defun currencies-match-p (expected received)
  (eql (class-of expected) (class-of received)))

(defun money+ (&rest moneys)
  "A function for adding the `amount' values of currency-matching `money' objects."
  (let ((expected-currency (first moneys)))
    (unless (moneyp expected-currency)
      (error 'type-error
             :expected-type 'money
             :datum expected-currency))
    (let ((total (amount expected-currency)))
      (dolist (current-currency (rest moneys))
        (unless (moneyp current-currency)
          (error 'type-error
                 :expected-type 'money
                 :datum current-currency))
        (unless (currencies-match-p expected-currency current-currency)
          (error 'mismatched-currencies
                 :expected expected-currency
                 :received current-currency))
        (setf total (+ total (amount current-currency))))
      (make-money-raw total (currency-code expected-currency)))))

money+ takes an arbitrary number of arguments. We check each argument with dolist: in the case where current-currency is of type money and the currencies of expected-currency and current-currency match, we add its amount to total.

This function only takes money objects. We try to detect non-money objects early by checking if the first argument is moneyp, but we also need to check that all of the remaining arguments are also moneyp and that the current currency matches the first one. If the currencies of the expected and current currency don't match, then money+ signals a mismatched-currencies condition.

(define-condition mismatched-currencies (error)
  ((expected :initarg :expected :initform nil :reader expected)
   (received :initarg :received :initform nil :reader received))
  (:report (lambda (c stream)
             (format stream "Mismatched currencies. Expected ~a, received ~a." (currency-code (expected c)) (currency-code (received c)))))
  (:documentation "A condition signaled when two objects of type `money' are of different subtypes."))

It's not strictly necessary to make a condition. We could just use a simple error:

(error "Mismatched currencies. Expected ~a, received ~a." expected-currency current-currency)

Having a custom condition saves us the trouble of copying the same error in several later functions; convenient but no big deal.

The real utility is allowing us (sometime later in a different library) or others (in their own application code) to act specifically on this condition. We aren't going to implement currency conversion functionality in this library, but we or others might want to be able to make a currency conversion when currencies are mismatched. Or maybe that would be a silly idea. I don't know, but I'm leaving that up to the next guy to decide. With a tiny bit of effort, I can provide myself and others that flexibility.

At the end of the money+ function, we use make-money-raw.

(defun make-money-raw (amount &optional (currency-code *default-currency*))
  "Makes a `money' object of a certain registered currency using the raw amount
passed. Use this when running math operations between `money' objects or amounts
  (as persisted in a database, for example) that still contain `+guard-digits+'."
  (unless (integerp amount)
    (error 'type-error :datum amount :expected-type 'integer))
  (unless (stringp currency-code)
    (error 'type-error :datum currency-code :expected-type 'string))
  (let ((registered-currency (get-registered-currency currency-code)))
    (make-instance registered-currency :amount amount))) ; Raw `amount'.

We use it because we are taking guarded amounts (money objects that presumably have been made with make-money or a helper function like usd), doing math operations on those guarded amounts, and then generating new money objects from those pre-guarded amounts. If we used make-money here instead, we would add another 4 digits to the amount.

13.6MONEY LIBRARY

The rest of the math functions

money- is only going to look a little different:

(defun money- (&rest moneys)
  "A function for subtracting the `amount' values of currency-matching `money' objects. If
passed one `money' object, will negate the `amount'."
  (let ((expected-currency (first moneys)))
    (unless (moneyp expected-currency)
      (error 'type-error :expected-type 'money :datum expected-currency))
    (let ((total (amount expected-currency)))
      (cond ((= (length moneys) 1)
             (make-money-raw (- (amount expected-currency)) (currency-code expected-currency)))
            (t
             (dolist (current-currency (rest moneys))
               (unless (moneyp current-currency)
                 (error 'type-error
                        :datum current-currency
                        :expected-type 'money))
               (unless (currencies-match-p expected-currency current-currency)
                 (error 'mismatched-currencies :expected expected-currency
                                               :received current-currency))
               (setf total (- total (amount current-currency))))
             (make-money-raw total (currency-code expected-currency)))))))

The only difference here is that we check if there is more than one argument passed to money-. If you pass only one argument, then it will negate the total.

money* and money/ are nearly identical to each other:

(defun money* (money &rest multipliers)
  "A function for multiplying the `amount' of `money' by the `multipliers'."
  (unless (moneyp money)
    (error 'type-error 
           :expected-type 'money 
           :datum money))
  (make-money-raw (round (apply #'* (amount money) multipliers)) 
                  (currency-code money)))

(defun money/ (money divisor)
  "A function for dividing the `amount' of `money' by the `divisor' integer."
  (unless (moneyp money)
    (error 'type-error 
           :expected-type 'money 
           :datum money))
  (make-money-raw (round (amount money) divisor) 
                  (currency-code money)))

Here, we actually allow any type to be passed as an argument as multipliers or divisor. It feels a bit odd to multiply currencies into each other, but it does make sense to say "double the amount of money" or "apply a 25% discount".

The important thing to note here is the use of round. If we didn't use round, then (money/ (usd 100) 3) would result in an amount of 33333.34 (guarded). But we have the guard, so we can toss the remainder. round also has the additional advantage of being a "banker's round": When amounts are in the middle, like 2.5 or 3.5, they will round to the nearest even number. That means 2.5 rounds to 2, but 3.5 rounds to 4. This sort of rounding is used with accounting because, over many transactions, it leads to more or less even distribution of money. And in any case, the guard digits will likely prevent the rounding from having a meaningful impact on the settled amount.

Finally, we'll add three more simple math comparison functions:

(defun comparable-check (money1 money2)
  (cond
    ((not (moneyp money1))
     (error 'type-error :expected-type 'money :datum money1))
    ((not (moneyp money2))
     (error 'type-error :expected-type 'money :datum money2))
    ((not (currencies-match-p money1 money2))
     (error 'mismatched-currencies :expected money1
                                   :received money2))))
(defun money= (money1 money2)
  "A function to check if the `amount' values of two `money' objects are `='."
  (comparable-check money1 money2)
  (= (amount money1) (amount money2)))

(defun money> (money1 money2)
  "A function that checks if the `amount' of one `money' object is greater than that of
the other."
  (comparable-check money1 money2)
  (> (amount money1) (amount money2)))

(defun money< (money1 money2)
  "A function that checks if the `amount' of one `money' object is less than that of
the other."
  (comparable-check money1 money2)
  (< (amount money1) (amount money2)))

I'm purposefully limiting these functions to only two arguments because I can't imagine myself trying to check more than two using any of these functions. If you can think of a scenario where checking the equality of 3 or more money objects would be useful, let me know.

13.7MONEY LIBRARY

Splitting

There are times when you might need to split a certain amount of money into smaller, "whole" amounts. For instance, if you need to refund the remaining value of a subscription, you might need to know how much each day/month of the subscription costs to make the refund. You may need to split the profit from a transaction between several parties: yourself, a service provider, an affiliate, etc.

These operations are more complicated, so we will make use of loop.

(defun money-split (money allocations)
   "A function for dividing the `amount' of `money' by the percentages of
`allocations'. `allocations' must be a list of integers that sum to 100.

Ex. (money-split (usd 1000) (list 70 20 10)) => (#<USD $7.00 7000000
{7008AC05C3}> #<USD $2.00 2000000 {7008AC0663}> #<USD $1.00 1000000
{7008AC0703}>)"
  (unless (moneyp money)
    (error 'type-error :datum money :expected-type 'money))
  (let ((divisor (reduce #'+ allocations)))
    (unless (= 100 divisor)
      (error "The sum of all ALLOCATIONS must be 100."))
    (loop :with total := (amount money)
          :with currency-code := (currency-code money)
          :for percentage :in allocations
          :for split := (round (* total percentage) divisor)
          :collect (make-money-raw split currency-code))))

(defun money-split-evenly (money ways)
  "A function for dividing the `amount' of `money' n positive `ways'. Returns a list of
splits, with the remainder (if any) divided as an integer evenly between splits,
  from left-to-right.

Ex. (money-split-evenly (usd 1000) 3) => (#<USD $3.34 3340000 {70083B04C3}>
#<USD $3.33 3330000 {70083B0563}> #<USD $3.33 3330000 {70083B0603}>)"
  (unless (moneyp money)
    (error 'type-error :datum money :expected-type 'money))
  (unless (and (integerp ways)
               (plusp ways))
    (error "WAYS must be a positive integer."))
  (loop :with total := (settled-amount money)
        :with currency-code := (currency-code money)
        :with split := (floor (/ total ways))
        :repeat ways
        :collect split :into splits
        :do (setf total (- total split))
        :finally (return (loop :for s :in splits
                               :if (>= total 1)
                                 :collect (make-money
                                           (1+ s)
                                           (currency-code money))
                                   :into allocated
                                   :and
                                     :do (setf total (1- total))
                               :else
                                 :collect (make-money
                                           s
                                           (currency-code money))
                                   :into allocated
                               :end
                               :finally (return allocated)))))

money-split's loop first begins by using :with expressions to bind variables that won't be recalculated on every iteration. We could include them in an enclosing let form if you wanted, but it's cleaner here. Then very simply we apply the percentages to the total and collect the splits as money objects. By enforcing the rule that allocations must sum to 100 we make the loop form simple.

For allocations, we accept integers rather than floats so that we can deal with large numbers.

money-split-even is different in one important way: because we generate even splits, it's possible that we actually won't have splits that sum to the original amount. Let's say we used a simpler version:

(defun money-split-evenly-broken (money ways)
  "A function for dividing the `amount' of `money' n positive `ways'. Returns a list of
splits, with the remainder (if any) divided as an integer evenly between splits,
  from left-to-right.

Ex. (money-split-evenly (usd 1000) 3) => (#<USD $3.34 3340000 {70083B04C3}>
#<USD $3.33 3330000 {70083B0563}> #<USD $3.33 3330000 {70083B0603}>)"
  (unless (moneyp money)
    (error 'type-error :datum money :expected-type 'money))
  (unless (and (integerp ways)
               (plusp ways))
    (error "WAYS must be a positive integer."))
  (loop :with total := (settled-amount money)
        :with currency-code := (currency-code money)
        :with split := (floor (/ total ways))
        :repeat ways
        :collect (make-money split (currency-code money)) :into splits
        :do (setf total (- total split))
        :finally (return (values splits total))))

(money-split-evenly-broken (usd 1000) 3)
Returns
(#<USD $3.33 3330000 {70076A6A33}> #<USD $3.33 3330000 {70076A6AD3}>
 #<USD $3.33 3330000 {70076A6B73}>)
1

As you can see, there is a remainder of 1. If we split $10 evenly between three people, we end up with three people having $3.33, but one cent is left over. We need a way to divide any remaining money between the splits, so we need a nested loop as in money-split-evenly.

In both functions, we begin the loop by first "settling" the amount.

(defun settled-amount (money)
  (round (amount money) (expt 10 +guard-digits+)))

Remove the guard and then round. We settle the amount because now we need to figure out the final distribution of real, physical money, rather than imaginary "millicents" or "centiyens". Next, we decide what a base "split" of the money looks like: either a set percentage as in money-split, or a calculated percentage as in money-split-evenly. For money-split, the rest is just making a new money object with the split values. For money-split-evenly, we subtract the split from the total, and then evenly divide any remainder between the splits.

13.8MONEY LIBRARY

Formatting for Human Consumption

One last important job for our library will be displaying the money amount as normal people expect money amounts to be displayed. That means that #<USD 5000> needs to be formatted as $50.00 and #<JPY 5000> needs to be formatted as ¥5,000. We want one function to be able to format any currency properly. We could have one function with a big cond do that:

(defun format-money (stream money-obj)
  (cond ((usdp money-obj) (format-usd money-obj))
        ((jpyp money-obj) (format-jpy money-obj))
        ((gbpp money-obj) (format-gbp money-obj))
        ...))

But that has the one downside that it requires updating this one function any time we want to add support for a currency to the library. It's not a huge burden, it's true, and some people may even prefer it. However, Common Lisp has an OOP solution to make our code more extensible: generic functions.

(defgeneric format-money (stream currency)
  (:documentation "A generic function that takes a currency object and formats
 it in for human consumption."))

For USD, it's simple because we already wrote the settled-usd-string function.

(defmethod format-money (stream (this us-dollar))
  (format stream "~a" (settled-usd-string this)))

And if we add currencies, all we do is add a method for format-money that uses that currency.

13.9MONEY LIBRARY

Adding Currencies

The library is "complete", in the sense that it does everything we want it to do. One catch: it only works with USD.

How do we add support for more currencies?

It's fairly simple. We'll do it with Japanese Yen:

(defclass japanese-yen (money)
  ((currency-code :initform "JPY")
   (minor-digits :initform 0)))

(register-currency "JPY" 'japanese-yen)

(defun settled-jpy-string (jpy)
  (let ((settled-amount (settled-amount jpy)))
    (format nil "~:[~;-~]¥~:d" (minusp settled-amount) settled-amount)))

(defmethod format-money (stream (this japanese-yen))
  (format stream "~a" (settled-jpy-string this)))

(defmethod print-object ((this japanese-yen) stream)
  (print-unreadable-object (this stream)
    (format stream "JPY ~a ~a" (settled-jpy-string this) (amount this))))

(defun jpy (amount)
  (unless (integerp amount)
    (error 'type-error :datum amount :expected-type 'integer))
  (make-money amount "JPY"))

We inherit and extend the money class with the japanese-yen class, assigning default values to currency-code and minor-digits.

We register the new currency so that make-money will work properly if called like this: (make-money 5000 "JPY"). It's likely that people will only use jpy, but who knows?

We write a settled-jpy-string helper for pretty-printing. Formatting Japanese yen is even easier than USD: The lowest and only monetary unit is the yen, so no need for a decimal or the yen equivalent of "cents".

We specialize the format-money and print-object generic functions with methods for the new japanese-yen type.

Then we make a helper-function to make Japanese Yen.

Neither we nor future developers will need to modify any existing code; we use OOP modularity and extensibility that would make every senior Java developer proud.

And thus, our library is complete and ready to be upgraded with support for other currencies in the future.

13.10MONEY LIBRARY

Final Package Definition

Now that we're finished, make sure you have all of the necessary symbols exported so that they're easily accessible to outside of the package.

(defpackage #:almighty-money
  (:use #:cl)
  (:export
   #:*default-currency*
   #:*registered-currencies*
   #:register-currency
   #:get-registered-currency
   #:money
   #:amount
   #:currency-code
   #:make-money
   #:moneyp
   #:currencies-match-p
   #:mismatched-currencies
   #:money+
   #:money-
   #:money*
   #:money/
   #:money-split
   #:money=
   #:money>
   #:money<
   #:format-money
   #:usd
   #:jpy
   #:make-money-raw
   #:settled-amount
   #:minor-digits
   #:money-split-evenly))