commit b44bcc7fe26b6561aeca837a56a63f08a68c59d7 Author: Correl Roush Date: Thu Jun 11 18:16:32 2015 -0400 Initial commit diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..433da84 --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +.cask +*.elc diff --git a/Cask b/Cask new file mode 100644 index 0000000..e7cfda4 --- /dev/null +++ b/Cask @@ -0,0 +1,10 @@ +;; -*- mode: emacs-lisp -*- +(source melpa) + +(package "org-habit-streaks" "0.0.1" "Track streaks in Org-Mode habits") + +(depends-on "dash") + +(development + (depends-on "f") + (depends-on "ert-runner")) diff --git a/org-habit-streaks.el b/org-habit-streaks.el new file mode 100644 index 0000000..e017ddb --- /dev/null +++ b/org-habit-streaks.el @@ -0,0 +1,72 @@ +;;; org-habit-streaks --- Counts streaks in org-habit entries + +;; Copyright (c) 2015 Correl Roush + +;; Author: Correl Roush +;; URL: http://github.com/correl/org-habit-streaks/ +;; Version: 0.1 +;; Created: 2015-06-11 + +;; This file is NOT part of GNU Emacs. + +;;; License: + +;; This program 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 3, or (at your option) +;; any later version. +;; +;; This program 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: + +;;; Code: + +(require 'org-habit) + +(defcustom org-habit-streaks-preceding-days + 365 + "Number of days before today to include in streak counting." + :group 'org-habit-streaks + :type 'integer) + +(defun org-habit-streaks--streaks (interval values) + "Given an INTERVAL and a list of sequential integer VALUES, group streaks together." + (-reduce-from + (lambda (acc value) + (let* ((current-streak (car acc)) + (last-value (car current-streak)) + (new-streak? (or (not last-value) + (> (- value last-value) interval))) + (rest (cdr acc))) + (if new-streak? + (cons (list value) acc) + (cons (cons value current-streak) + rest)))) + nil + values)) + +;;;###autoload +(defun org-habit-streaks (&optional pom) + "Groups past dates the task at point was completed into streaks." + (let* ((org-habit-preceding-days org-habit-streaks-preceding-days) + (habit (org-habit-parse-todo pom)) + (interval (org-habit-scheduled-repeat habit)) + (done-dates (org-habit-done-dates habit)) + (streaks (org-habit-streaks--streaks interval done-dates)) + (last-done (-last-item done-dates)) + (current-streak (if (and streaks (<= (- (org-today) last-done) interval)) + (length (car streaks)) + 0))) + (list current-streak streaks))) + +(provide 'org-habit-streaks) +;;; org-habit-streaks.el ends here diff --git a/test/org-habit-streaks-test.el b/test/org-habit-streaks-test.el new file mode 100644 index 0000000..316dba0 --- /dev/null +++ b/test/org-habit-streaks-test.el @@ -0,0 +1,14 @@ +(defun count-streaks (interval values) + (-map #'length (org-habit-streaks--streaks interval values))) + +(ert-deftest count-streaks-empty () + (should (equal (count-streaks 1 nil) nil))) + +(ert-deftest count-streaks-single-entry () + (should (equal (count-streaks 1 '(1)) '(1)))) + +(ert-deftest count-streaks-long-streak () + (should (equal (count-streaks 1 '(1 2 3)) '(3)))) + +(ert-deftest count-streaks-multiple () + (should (equal (count-streaks 1 '(1 2 4 5 6)) '(3 2)))) diff --git a/test/test-helper.el b/test/test-helper.el new file mode 100644 index 0000000..6cbb422 --- /dev/null +++ b/test/test-helper.el @@ -0,0 +1,20 @@ +(require 'f) + +(defvar org-habit-streaks-test-path + (f-dirname (f-this-file))) + +(defvar org-habit-streaks-code-path + (f-parent org-habit-streaks-test-path)) + +(defvar org-habit-streaks-sandbox-path + (f-expand "sandbox" org-habit-streaks-test-path)) + +(require 'org-habit-streaks (f-expand "org-habit-streaks.el" org-habit-streaks-code-path)) + +(defmacro with-sandbox (&rest body) + "Evaluate BODY in an empty temporary directory." + `(let ((default-directory root-sandbox-path)) + (when (f-dir? root-sandbox-path) + (f-delete root-sandbox-path :force)) + (f-mkdir root-sandbox-path) + ,@body))