Added comments and documentation strings

calendar.lisp

@@ -33,7 +33,10 @@
 
 (defparameter +known-centres+
   ;;    Centre              Hol function     discriminant
-  (list :Eurex       (list #'german-holidays :Eurex)
+  (list :Australia   (list #'aus-holidays    :settlement)
+	:Sydney      (list #'aus-holidays    :settlement)
+	:AUD         (list #'aus-holidays    :settlement)
+	:Eurex       (list #'german-holidays :Eurex)
 	:Frankfurt   (list #'german-holidays :Eurex)
 	:Euwax       (list #'german-holidays :Euwax)
 	:Stuttgart   (list #'german-holidays :Euwax)
@@ -57,25 +60,59 @@
 	:UST         (list #'us-holidays     :bonds)
 	:US-Bond     (list #'us-holidays     :bonds)))
 
-;; base class - no functionality (null calendar)
+;; base class - no holidays other than weekends
 (defclass calendar ()
   ((name :initarg :name :accessor name)
    (weekend :initarg :weekend :accessor weekend)))
 
-(defclass calendar-single (calendar)
+(defmethod print-object ((cal calendar) stream)
-  ((centre :initarg :centre :accessor centre)
+  (print-unreadable-object (cal stream :type t)
-   (holidays :initarg :holidays :accessor holidays)
+    (format stream "Name: ~a; Weekend: ~a; No holidays defined" (name cal) (weekend cal))))
-   (holidays-min-year :accessor holidays-min-year)
-   (holidays-max-year :accessor holidays-max-year)))
 
+;; The main class - holds holidays corresponding to a single location / trading centre
+;; Holidays are lazily loaded as and when required
+(defclass calendar-single (calendar)
+  ((centre :initarg :centre :accessor centre) ; trading centre
+   (holidays :initarg :holidays :accessor holidays) ; hash table with dates as keys
+   (holidays-min-year :accessor holidays-min-year)  ; earliest year for which hols are loaded
+   (holidays-max-year :accessor holidays-max-year))) ; last year for which hols are loaded
+
+(defmethod print-object ((cal calendar-single) stream)
+  (print-unreadable-object (cal stream :type t)
+    (format stream "Name: ~a (Centre: ~a); Weekend: ~a; Holidays for ~d-~d"
+	    (name cal) (centre cal) (weekend cal)
+	    (holidays-min-year cal) (holidays-max-year cal))))
+
+;; Container for multiple calendars
+;; A date is deemed to be a holiday if it is a holiday in any of the contained calendars
 (defclass calendar-union (calendar)
   ((calendars :initarg :calendars :accessor calendars))) ; list of calendars
 
+(defmethod print-object ((cal calendar-union) stream)
+  (print-unreadable-object (cal stream :type t)
+    (format stream "Name: ~a; ~a"
+	    (name cal) (calendars cal))))
+
 (defun make-calendar (centres &key (name nil) (weekend (copy-list +default-weekend+))
 				   (holidays nil) (base-year 0))
+  "Create a new holiday calendar. Holidays are populated from a holiday computation
+function (if available) and holidays explicitly specified (if any).
+
+The 'centres' parameter may be
+	a keyword - an object of type calendar-single will be returned
+	a list of keywords - an object of type calendar-union is returned, each contained calendar
+			     will be of type calendar-single
+        any other object - an object of type calendar will be returned.
+The keyword parameters are:
+name - a name used when printing the calendar (not used by any code)
+weekend - the days comprising the weekend (Sat/Sun by default)
+holidays - a list of dates that are holidays. This is useful when special holidays are declared
+	   or when there is no function available to generate holidays.
+base-year - Year around which holidays should be generated initially (current year if not specified).
+            Holidays are generated from base year - 2 to base year + 3."
   (typecase centres
     (keyword (multiple-value-bind (hols from-year to-year) (get-holiday-hash centres base-year)
-		(let ((cal (make-instance 'calendar-single :name name :centre :centres
+		(let ((cal (make-instance 'calendar-single :name name :centre centres
 							   :weekend weekend :holidays hols)))
 		  (setf (holidays-min-year cal) from-year
 			(holidays-max-year cal) to-year)
@@ -105,12 +142,16 @@
 	collect (car x)))
 
 (defun get-holidays-for-centre (centre year)
+  "Return a list of holidays for the given centre and year. NIL is returned if
+there is no available function to generate holidays"
   (let ((spec (getf +known-centres+ centre)))
     (if spec
 	(funcall (first spec) year :which (second spec))
 	nil)))
 
 (defun get-holiday-hash (centre base-year)
+  "Return a hash table with holidays as keys. Holidays are generated from base=year - 2
+to base-year + 3."
   (when (or (not (integerp base-year)) (<= base-year 1950))
     (setf base-year (date->ymd (todays-date))))
   (let* ((from-year (- base-year 2))
@@ -124,18 +165,24 @@
     (values hash from-year to-year)))
 
 (defmethod has-holidays-for-year ((cal calendar) (year integer))
+  "Have holidays been generated for the current year? Always true since this
+class does not store holidays"
   t)
 
 (defmethod has-holidays-for-year ((cal calendar-single) (year integer))
+  "Have holidays been generated for the current year?"
   (<= (holidays-min-year cal) year (holidays-max-year cal)))
 
 (defmethod has-holidays-for-year ((cal calendar-union) (year integer))
+  "Have holidays been generated for the current year? Check every sub-calendar"
   (every #'identity (mapcar (lambda(x) (has-holidays-for-year x year)) (calendars cal))))
 
 (defmethod update-calendar ((cal calendar) (year integer))
   cal)
 
 (defmethod update-calendar ((cal calendar-single) (year integer))
+  "Extend generated holidays to include given year. All intervening years
+are also generated so that the range of years is continuous"
   (let ((from-year (min (- year 2) (1+ (holidays-max-year cal))))
 	(to-year (max (+ year 3) (1- (holidays-min-year cal)))))
     (loop for yy from from-year upto to-year
@@ -149,44 +196,55 @@
   cal)
 
 (defmethod update-calendar ((cal calendar-union) (year integer))
+  "Extend generated holidays to include given year in all sub-calendars"
   (dolist (c (calendars cal))
     (update-calendar c year))
   cal)
 
 (defmethod weekend-p (date (weekend-days list))
+  "Return true if day of week of the given date is on a weekend"
   (member (day-of-week date) weekend-days))
 
 (defmethod weekend-p (date (cal calendar))
+  "Return true if day of week of the given date is on a weekend"
   (weekend-p date (weekend cal)))
 
 (defmethod weekday-p (date (weekend-days list))
+  "Return true if day of week of the given date is not on a weekend"
   (not (weekend-p date weekend-days)))
 
 (defmethod weekday-p (date (cal calendar))
+  "Return true if day of week of the given date is not on a weekend"
   (weekday-p date (weekend cal)))
 
 (defmethod holiday-p (date (cal calendar))
+  "True if date is a holiday in this calendar"
   (declare (ignore date cal))
   nil)
 
 (defmethod holiday-p (date (cal calendar-single))
+  "True if date is a holiday in this calendar"
   (let ((year (date->ymd date)))
     (unless (has-holidays-for-year cal year)
       (update-calendar cal year)))
   (not (null (gethash (jday-number date) (holidays cal)))))
 
 (defmethod holiday-p (date (cal calendar-union))
+  "True if date is a holiday in any contained calendar"
   (some #'identity (lambda (cal) (holiday-p date cal)) (calendars cal)))
 
 (defmethod business-day-p (date (cal calendar))
+  "True if date is not a holiday or weekend in the given calendar"
   (and (weekday-p date cal)
        (not (holiday-p date cal))))
 
 (defmethod add-holiday ((cal calendar-single) date)
+  "Mark given date as a holiday in the calendar"
   (let ((year (date->ymd date)))
     (unless (<= (holidays-min-year cal) year (holidays-max-year cal))
       (update-calendar cal year)))
   (setf (gethash (jday-number date) (holidays cal)) 2))
 
 (defmethod remove-holiday ((cal calendar-single) date)
+  "Remove given date from list of holidays in the calendar"
   (remhash (jday-number date) (holidays cal)))

date-arith.lisp

@@ -24,6 +24,12 @@
 ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
 ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
+;;;; Date-Arith.lisp - Functions to compare dates, add days or months to dates
+;;;; and calculate the number of days or years between two dates.
+;;;; The day convention may be specified when calculating date differences or
+;;;; advancing dates by months - different results may be returned depending
+;;;; on the convention used.
+
 (in-package :cl-dates)
 
 ;; Date comparisons - strip off time component

dates.lisp

@@ -24,6 +24,10 @@
 ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
 ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
+;;;; Dates.lisp - basic date routines to convert from Gregorian dates to Julian dates
+;;;; and vice versa. Also contains functions to calculate astronomical dates such as
+;;;; Easter, the equinozes, etc.
+
 (in-package :cl-dates)
 
 (defun jday-number (date)

packages.lisp

@@ -24,6 +24,8 @@
 ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
 ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
+;;;; Packages.lisp - defines the cl-dates package and all exported symbols
+
 (in-package :cl-user)
 
 (defpackage :cl-dates

parse-date.lisp

@@ -24,17 +24,17 @@
 ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
 ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
-;;
+;;;; Parse-Date.lisp - Contains a string to date-time converter that accurately
-;; Contains a string to date-time converter that accurately parses most common
+;;;; parses most common ways of writing dates.
-;; ways of writing dates. See test-parse-dates.lisp for examples.
+;;;;
-;;
+;;;; See test-parse-dates.lisp for examples.
-;; Only the string->date function is exported from this file - all other functions
+;;;;
-;; are simply supporting functions for string->date and are not meant to be used
+;;;; Only the string->date function is exported from this file - all other functions
-;; elsewhere.
+;;;; are simply supporting functions for string->date and are not meant to be used
-;;
+;;;; elsewhere.
-;; The code is largely based on the Python dateutils library but there are some
+;;;;
-;; differences and optimizations
+;;;; The code is largely based on the Python dateutils library but there are some
-;;
+;;;; differences and optimizations
 
 (in-package :cl-dates)
 
@@ -64,7 +64,7 @@
 		     ;; separate "23.jun.2017" => "23" "." "jun" "." "2017"
 		     ;; any trailing period will be dropped
 		     (setf token (nreverse token))
-		     (loop for tk on (split-list #'(lambda(x) (char= x #\.)) token)
+		     (loop for tk on (split-list (lambda(x) (char= x #\.)) token)
 			   do (progn
 				(push (coerce (car tk) 'string) token-list)
 				(unless (null (cdr tk))
@@ -186,18 +186,18 @@
 	    (t (multiple-value-bind (yy mm) (assign-yy-mm list precedence)
 		 (values yy mm nil))))
       (let (tmp)
-	(cond ((every #'(lambda(x) (<= x 12)) list)
+	(cond ((every (lambda(x) (<= x 12)) list)
 	       ;; 01/02/03
 	       (cond ((eq precedence :mdy) (values (third list) (first list) (second list)))
 		     ((eq precedence :dmy) (values (third list) (second list) (first list)))
 		     (t (values (first list) (second list) (third list)))))
-	      ((setf tmp (find-if #'(lambda(x) (> x 31)) list))
+	      ((setf tmp (find-if (lambda(x) (> x 31)) list))
 	       ;; 12/5/55
 	       (setf list (remove tmp list :count 1))
 	       (multiple-value-bind (mm dd) (assign-mm-dd list precedence)
 		 (values tmp mm dd)))
-	      ((= 1 (count-if #'(lambda(x) (<= x 12)) list))
+	      ((= 1 (count-if (lambda(x) (<= x 12)) list))
-	       (setf tmp (find-if #'(lambda(x) (<= x 12)) list)
+	       (setf tmp (find-if (lambda(x) (<= x 12)) list)
 		     list (remove tmp list :count 1))
 	       (multiple-value-bind (yy dd) (assign-yy-dd list precedence)
 		 (values yy tmp dd)))

print-date.lisp

@@ -24,6 +24,9 @@
 ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
 ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
+;;;; Print-Date.lisp - functions to convert a date-time into various string
+;;;; formats
+
 (in-package :cl-dates)
 
 (defun date->string (date &key (format :human) zone)

timezones.lisp

@@ -24,6 +24,8 @@
 ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
 ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
+;;;; TimeZones.lisp - Contains a table mapping timezones to their offsets from GMT
+
 (in-package :cl-dates)
 
 ;; hash table containing mappings from time zone abbreviation to GMT offset

util.lisp

@@ -24,6 +24,10 @@
 ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
 ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
+;;;; Util.lisp - small utility functions used across the cl-dates package.
+;;;; E.g., functions to convert symbols for day of week, date convention,
+;;;; etc to strings for printing
+
 (in-package :cl-dates)
 
 (defun parse-number (string)