Project: Money Library

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 almighty-money.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 "almighty-money")))

The rest of the code for this project will go inside the almighty-money.lisp file.

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)
   (currency-code :initarg :currency-code :initform nil :accessor currency-code)
   (currency-sign :initarg :currency-sign :initform nil :accessor currency-sign))
  (:documentation "A class that holds all the information about some money. Any
 class that inherits from the MONEY class must provide a default CURRENCY-CODE
 and CURRENCY-SIGN.

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.

CURRENCY-CODE is a string using the ISO 4217 format. Ex. \"USD\"

CURRENCY-SIGN is a string. It is some symbol to represent the type of money
being displayed. Ex. \"$\""))

We could add :type specifications to each of the slots, but how the compiler enforces the types is implementation dependent. That means we can't be sure if, how, or under what conditions our implementation will enforce those types. :type might be useful under certain circumstances (and perhaps the mere value of defining :type as documentation is useful to you), but for now we'll keep things simple.

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.

Now, let's try making some money:

(make-instance 'money :amount 4000 :currency-code "USD" :currency-sign "$")

Result#<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 (&optional (amount 0) (currency *default-currency*))
  (assert (and (integerp amount)) (amount)
          "AMOUNT must be an integer, got ~a." amount)
  (etypecase currency
    (money (make-instance (class-of currency) :amount amount))
    (string (make-instance (get-registered-currency currency) :amount amount))
    (symbol (make-instance currency :amount amount))))

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)
  (setf (gethash currency-code *registered-currencies*) currency-class))

(defun get-registered-currency (currency-code)
  (gethash currency-code *registered-currencies*))

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.

For the currency argument, in the etypecase form, make-money can take either another money object, a string like "USD", or a symbol like 'us-dollar. Internally, we'll be sending money objects or using symbols, but users of the library might prefer to just use currency codes instead without importing the defclass of their desired currency everywhere they want to use make-money.

Let's add USD as a type:

(defclass us-dollar (money)
  ((currency-code :initform "USD")
   (currency-sign :initform "$")))

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

(defun usd (amount)
  (assert (and (integerp amount)) (amount)
          "AMOUNT must be an integer, got ~a." amount)
  (make-money amount 'us-dollar))

(usd 50)

Result#<US-DOLLAR {700BA1CC73}>

The core purpose of this library is this: ensure that only money of the same currency is combined or compared mathematically. That means that 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)
  (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))
        (etypecase current-currency
          (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 total 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 etypecase takes care of the rest.

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." (expected c) (received c)))))

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.

money- is only going to look a little different:

(defun money- (&rest moneys)
  "A function for subtracting the AMOUNTs of MONEY objects of the same currency.
 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 (- (amount expected-currency)) expected-currency))
            (t
             (dolist (current-currency (rest moneys))
               (etypecase current-currency
                 (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 total 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 the identical to each others:

(defun money* (&rest moneys)
  "A function for multiplying the amounts of MONEY objects of the same currency.
 If passed an integer after the first MONEY object, will multiply the AMOUNT of
the MONEY by the integer."
  (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))
        (etypecase current-currency
          (money
           (unless (currencies-match-p expected-currency current-currency)
             (error 'mismatched-currencies :expected expected-currency
                                           :received current-currency))
           (setf total (* (amount current-currency) total)))
          (integer (setf total (floor (* total current-currency))))))
      (make-money total expected-currency))))

(defun money/ (&rest moneys)
  "A function for dividing the amounts of MONEY objects of the same currency. If
passed an integer after the first MONEY object, will divide the AMOUNT of the
MONEY by the integer."
  (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))
        (etypecase current-currency
          (money
           (unless (currencies-match-p expected-currency current-currency)
             (error 'mismatched-currencies :expected expected-currency
                                           :received current-currency))
           (setf total (/ total (amount current-currency))))
          (integer (setf total (floor (/ total current-currency))))))
      (make-money total expected-currency))))

Here, we actually allow an integer type to be passed as an argument. 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".

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

(defun money= (money1 money2)
  "A function to check if the AMOUNTs of two MONEY objects are =."
  (unless (moneyp money1)
    (error 'type-error :expected-type 'money :datum money1))
  (unless (moneyp money2)
    (error 'type-error :expected-type 'money :datum money2))
  (unless (currencies-match-p money1 money2)
    (error 'mismatched-currencies :expected money1
                                  :received money2))
  (and (= (amount money1) (amount money2))
       (eql (class-of money1) (class-of money2))))

(defun money> (money1 money2)
  "A function that checks if the AMOUNT of one MONEY object is greater than that
 of the other."
  (unless (moneyp money1)
    (error 'type-error :expected-type 'money :datum money1))
  (unless (moneyp money2)
    (error 'type-error :expected-type 'money :datum money2))
  (unless (currencies-match-p money1 money2)
    (error 'mismatched-currencies :expected money1
                                  :received 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."
  (unless (moneyp money1)
    (error 'type-error :expected-type 'money :datum money1))
  (unless (moneyp money2)
    (error 'type-error :expected-type 'money :datum money2))
  (unless (currencies-match-p money1 money2)
    (error 'mismatched-currencies :expected money1
                                  :received 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.

And that's it: the critical functionality of our library is complete. However, we really should improve the ergonomics a bit. When we print a money object, it looks like #<USD {7006D80343}>, when what we really want is for it to look like #<USD 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 money or us-dollar types.

(defmethod print-object ((this money) stream)
  (print-unreadable-object (this stream)
    (format stream "MONEY ~a ~a" (slot-value this 'amount) (slot-value this
 'currency-code))))

(defmethod print-object ((this us-dollar) stream)
  (print-unreadable-object (this stream)
    (format stream "~a ~a" (slot-value this 'currency-code) (slot-value this
 'amount))))

The print-unreadable-object function needs some explanation. When you return an object in the REPL, you can highlight it with the cursor and type Enter or left-click it with your mouse to inspect the object. This default behavior is preserved for print-object methods that you specialize on classes you define if you wrap the call to format in print-unreadable-object.

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 (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."))

Then we need to make a generic method to format USD:

(defmethod format-money (stream (this us-dollar))
  (let ((total-cents (amount this)))
    (cond ((< total-cents 0)
           (let* ((total-cents (- total-cents))
                  (dollars (floor total-cents 100))
                  (cents (mod total-cents 100)))
             (format stream "-~a~:D.~2,'0D" (currency-sign this) dollars cents)))
          (t
           (let ((dollars (floor total-cents 100))
                 (cents (mod total-cents 100)))
             (format stream "~a~:D.~2,'0D" (currency-sign this) dollars cents))))))

For small, negative values of total-cents, floor will be inaccurate ((floor -5 100) will return -1 rather than 0), so we make all negative integers positive before formatting them, adding the minus-sign back at the beginning of the format string.

~2,'0D looks crazy, I know. 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

Let's take a look at them in action:

(let ((small-num 7)
      (big-num 987654321))
  (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 | ~4,'x:d | ~4,'x:d"            "colon added"                       small-num big-num)
  (format t "~%~40a | ~4,'x,'x:d | ~4,'x,'x:d"      "commas replaced with x"            small-num big-num)
  (format t "~%~40a | ~4,'x,'x,1:d | ~4,'x,'x,1:d"  "comma interval set to 1"           small-num big-num)
  (format t "~%~40a | ~4,'x@d | ~4,'x,'x,1@d"       "colon replaced with at-sign"       small-num big-num)
  (format t "~%~40a | ~4,'x@:d | ~4,'x,'x,1@:d"     "at-sign and colon combined"        small-num big-num))

Resultno modifications                         | 7 | 987654321
mincol of 4                              |    7 | 987654321
mincol padding using character x         | 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

It should be a bit easier now to understand the format string for format-money: ~a, just display the currency-sign. ~:D, add commas to dollars side where appropriate. ., we add the dot. ~2,'0D, set the mincol to 2 and pad empty space with 0s. This ensures that (usd 5) returns $0.05 and not $0.5.

Also, for the big-brains screaming, "Micah! What about ~$ you dummy?", Tilde $ won't add commas to the number, and there's no way to combine both the effects of Tilde $ and Tilde D.

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")
   (currency-sign :initform "¥")))

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

(defmethod format-money (stream (this japanese-yen))
  (format stream "~a~:d" (currency-sign this) (amount this)))

(defmethod print-object ((this japanese-yen) stream)
  (print-unreadable-object (this stream)
    (format stream "~a ~a" (slot-value this 'currency-code) (slot-value this
 'amount))))

(defun jpy (amount)
  (assert (integerp amount) (amount)
          "AMOUNT must be an integer, got ~a." amount)
  (make-money amount 'japanese-yen))

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

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 specialize the format-money and print-object generic functions with methods for the new japanese-yen type. 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".

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.