(in-package #:isbn)

;;; Testing.

(defclass isbn-test-case (test-case)
  ((correct-formats-10 :initform nil :accessor correct-formats-10)
   (correct-formats-13 :initform nil :accessor correct-formats-13)
   (valid-strings-10 :initform nil :accessor valid-strings-10)
   (valid-strings-13 :initform nil :accessor valid-strings-13)
   (unparseable-strings :initform nil :accessor unparseable-strings)
   (invalid-digits :initform nil :accessor invalid-digits)
   (conversions :initform nil :accessor conversions)))

(defmethod correct-formats ((test isbn-test-case))
  (append (correct-formats-10 test) (correct-formats-13 test)))

(defmethod valid-digits-10 ((test isbn-test-case))
  (mapcar (lambda (string)
	    (remove-if (lambda (ch)
			 (or (eql ch #\Space) (eql ch #\-)))
		       string))
	  (append (correct-formats-10 test) (valid-strings-10 test))))

(defmethod valid-digits-13 ((test isbn-test-case))
  (mapcar (lambda (string)
	    (remove-if (lambda (ch)
			 (or (eql ch #\Space) (eql ch #\-)))
		       string))
	  (append (correct-formats-13 test) (valid-strings-13 test))))

(defmethod valid-digits ((test isbn-test-case))
  (append (valid-digits-10 test) (valid-digits-13 test)))

(defmethod set-up ((test isbn-test-case))
  (setf (correct-formats-10 test)
	'("1-931722-10-2" "1-56251-853-4" "1-56251-851-8" "0-201-10088-6"
	  "0-201-10715-5" "0-201-10715-5" "0-201-55089-x" "0-262-03308-9"
	  "0-262-03308-9" "0-520-04138-0" "0-446-37245-5" "0-13-583914-9"
	  "0-13-518226-3" "0-13-760414-9" "0-88029-905-3" "0-13-626656-8"
	  "1-56114-148-8" "1-56114-147-X" "1-56114-149-6" "0-394-52351-2"
	  "0-13-196791-6" "0-590-43197-8" "0-89526-796-9" "0-87779-911-3"
	  "0-393-95442-0" "0-393-95544-3" "1-873671-00-8")
	(correct-formats-13 test) 
	'("978-952-89-8888-5" "978-951-45-9693-3" "978-951-45-9694-0" 
	  "978-951-45-9695-7" "978-951-45-9696-4" "978-951-45-9999-6"
	  "978-1-873671-00-9")
	(valid-strings-10 test)
	'("0-201-37921-X" "0 201 37921 X" "020137921X")
	(valid-strings-13 test) 
	'("978-1-873671-00-9" "978-0-571-08989-5" "978 0 571 08989 5" 
	  "978-0-11-000222-4" "9789528988885")
	(unparseable-strings test)
	'("978-1-873-671-00-9" "-0201-37921-X" "0 201 37921 X " "020137921X "
	  "978-0 571-08989-5" "978 057108989 5" "-0-11-000222-4" 
	  " 9789528988885")
	(invalid-digits test) '("020137928X" "9789528988886" "9789514599995")
	(conversions test) '(("9781873671009" "1873671008"))
	))

(defun test-everything ()
  (textui-test-run (get-suite isbn-test-case))
  (textui-test-run (get-suite format-isbn-test-case)))

;;; Classes.

(defclass isbn ()
  ((digits :initform nil :initarg :digits :accessor isbn-digits)))

(defmethod print-object ((object isbn) (stream stream))
  (print-unreadable-object (object stream :type t)
    (prin1 (isbn-digits object) stream)))

(defclass isbn-10 (isbn)
  ())

(defclass isbn-13 (isbn)
  ())

(def-test-method test-print-object ((test isbn-test-case))
  (dolist (digits (valid-digits-10 test))
    (let ((string (princ-to-string (make-instance 'isbn-10 :digits digits))))
      (assert-true (search (format nil "\"~A\"" digits) string)))))

;;; Conversion between ISBN-10 and ISBN-13.

(defmethod initialize-instance :after ((new-isbn isbn) &key digits isbn)
  (when (and digits isbn)
    (error "Cannot specify both :DIGITS and :ISBN initargs."))
  (when isbn
    (copy-to-isbn new-isbn isbn)))

(def-test-method test-initialize-after ((test isbn-test-case))
  (let ((isbn (make-instance 'isbn-10 :digits (first (valid-digits-10 test)))))
    (assert-condition 'error 
		      (make-instance 'isbn-10 :isbn isbn
				     :digits (second (valid-digits-10 test))))
    (assert-condition 'error 
		      (make-instance 'isbn-13 :isbn isbn
				     :digits (first (valid-digits-13 test))))))

(defmethod copy-to-isbn ((destination isbn-10) (source isbn-10))
  (setf (isbn-digits destination) (copy-seq (isbn-digits source))))

(defmethod copy-to-isbn ((destination isbn-13) (source isbn-13))
  (setf (isbn-digits destination) (copy-seq (isbn-digits source))))

(defmethod copy-to-isbn ((destination isbn-10) (source isbn-13))
  (let ((digits-13 (isbn-digits source)))
    (unless (string-equal "978" digits-13 :end2 3)
      (error "Only ISBN-13s with prefix 978 can be converted into ISBN-10s."))
    (setf (isbn-digits destination) (subseq digits-13 3))
    (update-isbn-check-digit destination)))

(defmethod copy-to-isbn ((destination isbn-13) (source isbn-10))
  (setf (isbn-digits destination) (concatenate 'string "978"
					       (isbn-digits source)))
  (update-isbn-check-digit destination))

(def-test-method test-isbn-10-to-13 ((test isbn-test-case))
  (iter (for (digits-13 digits-10) in (conversions test))
	(let* ((isbn-10 (make-instance 'isbn-10 :digits digits-10))
	       (isbn-13 (make-instance 'isbn-13 :isbn isbn-10)))
	  (assert-true (equal digits-13 (isbn-digits isbn-13))))))

(def-test-method test-isbn-13-to-10 ((test isbn-test-case))
  (iter (for (digits-13 digits-10) in (conversions test))
	(let* ((isbn-13 (make-instance 'isbn-13 :digits digits-13))
	       (isbn-10 (make-instance 'isbn-10 :isbn isbn-13)))
	  (assert-true (equal digits-10 (isbn-digits isbn-10))))))

(def-test-method test-isbn-10-to-13-runs ((test isbn-test-case))
  (iter (for digits-10 in (valid-digits-10 test))
	(let ((isbn-10 (make-instance 'isbn-10 :digits digits-10)))
	  (assert-true (make-instance 'isbn-13 :isbn isbn-10)))))

(def-test-method test-isbn-13-to-10-runs ((test isbn-test-case))
  (iter (for digits-13 in (valid-digits-13 test))
	(let ((isbn-13 (make-instance 'isbn-13 :digits digits-13)))
	  (assert-true (make-instance 'isbn-10 :isbn isbn-13)))))

;;; Checks for wellformedness and correct check digit.

(defmethod well-formed ((isbn isbn-10))
  (let ((digits (isbn-digits isbn)))
    (and (typep digits 'string)
	 (= (length digits) 10)
	 (iter (for i below 9)
	       (always (digit-char-p (char digits i))))
	 (or (digit-char-p (char digits 9))
	     (char-equal (char digits 9) #\X)))))

(defmethod well-formed ((isbn isbn-13))
  (let ((digits (isbn-digits isbn)))
    (and (typep digits 'string)
	 (= (length digits) 13)
	 (every #'digit-char-p digits))))

(defgeneric compute-check-digit (isbn)
  (:documentation "Return the correct check digit as a character."))

(defmethod compute-check-digit ((isbn isbn-10))
  (with-slots (digits) isbn
    (let ((sum (iter (for weight from 1 below 10)
		     (for ch in-string digits)
		     (sum (* weight (digit-char-p ch))))))
      (char "0123456789X" (mod sum 11)))))

(defmethod compute-check-digit ((isbn isbn-13))
  (with-slots (digits) isbn
    (let* ((sum (loop for i below 12
		      sum (* (if (evenp i) 1 3)
			     (digit-char-p (char digits i))))))
      (digit-char (mod (- 10 (mod sum 10)) 10)))))

(defgeneric valid-check-digit (isbn)
  (:documentation "Returns T if the check digit is correct, NIL otherwise."))

(defmethod valid-check-digit ((isbn isbn-10))
  (char-equal (char (isbn-digits isbn) 9) (compute-check-digit isbn)))

(defmethod valid-check-digit ((isbn isbn-13))
  (eql (char (isbn-digits isbn) 12) (compute-check-digit isbn)))

(defgeneric update-isbn-check-digit (isbn)
  (:documentation
  "If the check digit is wrong, update it and return T.  Otherwise return NIL."
  ))

(defmethod update-isbn-check-digit ((isbn isbn-10))
  (let ((correct (compute-check-digit isbn)))
    (with-slots (digits) isbn
      (unless (char-equal correct (char digits 9))
	(setf (char digits 9) correct)
	t))))

(defmethod update-isbn-check-digit ((isbn isbn-13))
  (let ((correct (compute-check-digit isbn)))
    (with-slots (digits) isbn
      (unless (eql correct (char digits 12))
	(setf (char digits 12) correct)
	t))))

(define-condition isbn-parse-error (error)
  ((string :initarg :string))
  (:report (lambda (condition stream)
	     (with-slots (string) condition
	       (format stream "Cannot parse ISBN: ~S" string)))))

(define-condition isbn-check-digit-error (isbn-parse-error)
  ()
  (:report (lambda (condition stream)
	     (with-slots (string) condition
	       (format stream "ISBN has invalid check digit: ~S" string)))))

(defgeneric check-isbn (isbn &key ignore-check-digit)
  (:documentation "Returns true if ISBN is valid; otherwise, signals an error.
The error can be ISBN-PARSE-ERROR or ISBN-CHECK-DIGIT-ERROR."))

(defmethod check-isbn ((isbn isbn) &key ignore-check-digit)
  (unless (well-formed isbn)
    (error 'isbn-parse-error :string (isbn-digits isbn)))
  (unless (or ignore-check-digit
	      (valid-check-digit isbn))
    (error 'isbn-check-digit-error :string (isbn-digits isbn)))
  t)

(def-test-method test-check-isbn ((test isbn-test-case))
  (dolist (string (correct-formats test))
    (let ((isbn (parse-isbn string)))
      (assert-true (check-isbn isbn)
		   (format nil "Invalid digits: ~S" (isbn-digits isbn))))))

(def-test-method test-check-isbn-failure ((test isbn-test-case))
  (dolist (digits (invalid-digits test))
    (let ((isbn (make-instance (ecase (length digits)
				 (10 'isbn-10)
				 (13 'isbn-13))
			       :digits digits)))
      (assert-condition 'isbn-check-digit-error (check-isbn isbn)))))

;;; Parse ISBN from string.

(defun parse-isbn (string &key (invalid-check-digit :error))
  "Takes as input a string containing the correct external
representation of a correct ISBN.  Returns an internal representation
of the ISBN.  Never fails as long as the ISBN is syntactically correct,
i.e., it has the correct number of digits and either hyphens or
spaces, and the check digit is correct."
  (let ((isbn (case (length string)
		(10 (parse-isbn-10 string))
		(13 (if (every #'digit-char-p string)
			(parse-isbn-13 string)
			(parse-isbn-10 string)))
		(17 (parse-isbn-13 string))
		(t (error (make-instance 'isbn-parse-error :string string))))))
    (unless (well-formed isbn)
      (error (make-instance 'isbn-parse-error :string string)))
    (unless (valid-check-digit isbn)
      (ecase invalid-check-digit
	(:error (error 'isbn-check-digit-error :string string))
	(:correct (update-isbn-check-digit isbn))))
    isbn))

(defun parse-isbn-10 (string)
  (ecase (length string)
    (10 (make-instance 'isbn-10 :digits string))
    (13 (let ((separator (find-if-not #'digit-char-p string)))
	  (unless (and (= (count separator string) 3)
		       (< 0 (position separator string) 9))
	      (error (make-instance 'isbn-parse-error :string string)))
	  (make-instance 'isbn-10 :digits (remove separator string))))))

(defun parse-isbn-13 (string)
  (let (digits)
    (ecase (length string)
      (13 (setf digits string))
      (17 (let ((separator (find-if-not #'digit-char-p string)))
	    (unless (and (= (count separator string) 4)
			 (< 0 (position separator string) 12))
	      (error (make-instance 'isbn-parse-error :string string)))
	    (setf digits (remove separator string)))))
    (make-instance 'isbn-13 :digits digits)))

;;; Note: The contents returned are checked at the same time the
;;; formatter is tested.
(def-test-method test-parse-isbn-10 ((test isbn-test-case))
  (iter (for string in (append (correct-formats-10 test)
				 (valid-strings-10 test)))
	(assert-true (typep (parse-isbn string) 'isbn-10))))

(def-test-method test-parse-isbn-13 ((test isbn-test-case))
  (iter (for string in (append (correct-formats-13 test)
			       (valid-strings-13 test)))
	(assert-true (typep (parse-isbn string) 'isbn-13))))

(def-test-method test-parse-isbn-unparseable ((test isbn-test-case))
  (dolist (string (unparseable-strings test))
    (assert-condition 'isbn-parse-error (parse-isbn string)
		      (format nil "Did not get expected condition for ~S."
			      string))))