;;; selftest.el --- Personal unit tests
 
;; Copyright (C) 2007, 2008, 2009  Edward O'Connor
 
;; Author: Edward O'Connor <hober0@gmail.com>
;; Keywords: convenience
 
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
 
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
 
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
 
;;; Commentary:
 
;; This is a simple library for managing your personal unit tests. If
;; you're unfamiliar with the concept, please read this blog post:
;;
;;      http://withoutane.com/rants/2007/08/personal-unit-tests
 
;; Here's an example use:
;;
;; (require 'selftest)
;; (define-selftest exercise
;;   "Did I get >=30min of exercise yesterday"
;;   :group 'health
;;   :when 'always)
 
;; The command `selftest-run' may be used to run all of your tests.
 
;;; History:
;; 2007-09-11: Initial version.
;; 2007-09-13: Added `selftest-analyze'.
;; 2007-09-14: Added automatic Twitter posting.
;;             Uses (a patched version of) twit.el, which see.
;; 2008-01-08: Added ability to filter when each test should be taken.
;; 2009-06-19: Use `read-char-spec' for `selftest-ask' UI.
 
;;; Code:
 
;; Latest version at http://edward.oconnor.cx/elisp/read-char-spec.el
(require 'read-char-spec)
 
(defvar selftest-tests '())
 
(defvar selftest-twitter-results t
  "*When non-null, post selftest results to your Twitter account.
Requires twit.el, which is available on the EmacsWiki.")
 
(defun selftest-ask (prompt)
  "Like `y-or-n-p', but asks (with PROMPT) for pass, fail, or skip."
  (read-char-spec prompt '((?p :pass "You passed this test")
                           (?f :fail "You failed this test")
                           (?y :pass "You passed this test")
                           (?n :fail "You failed this test")
                           (?s :skip "You're skipping this test"))))
 
(defmacro define-selftest (slug question &rest params)
  "Defines a new personal unit test named SLUG.
QUESTION is the question to ask the user.
PARAMS are currently ignored."
  (let ((test-func-sym (intern (format "selftest-%s" slug)))
        (group (or (plist-get params :group) 'misc))
        (predicate (or (plist-get params :when) 'always)))
    `(progn
       (defun ,test-func-sym (answer)
         ,(format "Personal unit test %s" (list 'quote slug))
         (interactive (list (selftest-ask ,question)))
         answer)
       (put ',test-func-sym :selftest-slug ',slug)
       (put ',test-func-sym :selftest-group ,group)
       (put ',test-func-sym :selftest-predicate ,predicate)
       (add-to-list 'selftest-tests ',test-func-sym)
       ;; FIXME: do something with group
       ',test-func-sym)))
 
(put 'define-selftest 'lisp-indent-function 1)
(put 'define-selftest 'doc-string-elt 2)
 
(defun selftest-analyze (results)
  "Produce a report on the pass/fail ratio in RESULTS."
  (let ((date (car results))
        (results (cdr results))
        (pass-count 0)
        (fail-count 0)
        (pass/fail-count 0)
        (skip-count 0))
    (dolist (test results)
      (when (eq (cdr test) :pass) (incf pass-count))
      (when (eq (cdr test) :fail) (incf fail-count))
      (when (eq (cdr test) :skip) (incf skip-count)))
    (setq pass/fail-count (+ pass-count fail-count))
    (format "Personal unit test results for %s: %d/%d (%d%%) passed, %d skipped."
            date pass-count pass/fail-count
            (round (* 100 (/ (float pass-count) (float pass/fail-count))))
            skip-count)))
 
(defun selftest-always-p ()
  t)
(put 'always :selftest-predicate 'selftest-always-p)
 
(defun selftest-monday-p ()
  (let ((day-of-week (nth 6 (decode-time (current-time)))))
    (= day-of-week 1)))
(put 'monday :selftest-predicate 'selftest-monday-p)
 
(defun selftest-weekday-p ()
  (let ((day-of-week (nth 6 (decode-time (current-time)))))
    (and (> day-of-week 0) (< day-of-week 7))))
(put 'weekday :selftest-predicate 'selftest-weekday-p)
 
(defun selftest-weekend-p ()
  (not (selftest-weekday-p)))
(put 'weekend :selftest-predicate 'selftest-weekend-p)
 
(defun selftest-predicate (sym)
  "Return the selftest predicate for SYM.
Defaults to `selftest-always-p'."
  (let ((predicate (get sym :selftest-predicate)))
    (cond (predicate (selftest-predicate predicate))
          ((functionp sym) sym)
          (t 'always))))
 
(defun selftest-take-test-p (test)
  "Non-null iff TEST should be taken today."
  (funcall (selftest-predicate test)))
 
(defun selftest-run (&rest ignore)
  "Run all defined selftests, and insert the results at point."
  (interactive)
  (let ((results '())
        result)
    (dolist (test selftest-tests)
      (if (selftest-take-test-p test)
          (setq result (call-interactively test))
        (setq result :skip))
      (add-to-list 'results (cons (get test :selftest-slug) result)))
    (setq results (cons (format-time-string "%Y-%m-%d") results))
    (prin1 results (current-buffer))
    (let ((analysis (selftest-analyze results)))
      (when (called-interactively-p)
        (message "%s" analysis))
      (when (and (require 'twit nil t) selftest-twitter-results)
        (twit-post analysis)))
    results))
 
(provide 'selftest)
;;; selftest.el ends here