track-calorie-values/track-values.el

;;; track-values.el --- Track calorie values for various foods

;; Copyright (C) 2020 Samuel W. Flint <swflint@flintfam.org>

;; author: Samuel W. Flint <swflint@flintfam.org>
;; Version: 0.1
;; Keywords: diet, tracking
;; URL: https://git.sr.ht/~swflint/track-calorie-values

;; This file is NOT part of Emacs.
;;
;;  This file is licensed under the GNU GPLv3 or later.

;;; Commentary:
;;

;;; Code:

(require 'cl-lib)


;;; Customizeable values

(defgroup track-values nil
  "Track calorie values for various foods"
  :tag "Track Calorie Values"
  :group 'org
  :link '(url-link "https://git.sr.ht/~swflint/track-calorie-values")
  :prefix "track-values-")

(defcustom track-values-save-file
  (locate-user-emacs-file "track-values-data.el")
  "File to store calorie values of food items."
  :type '(file :must-match t))


;;; Hashing

;; Taken from emacs documentation
(defun case-fold-string= (a b)
  (eq t (compare-strings a nil nil b nil nil t)))
(defun case-fold-string-hash (a)
  (sxhash-equal (upcase a)))

(define-hash-table-test 'case-fold
  'case-fold-string= 'case-fold-string-hash)


;;; Internal Data
(defvar track-values-tables (list)
  "List of known track-values tables.")

(defvar track-values-loaded-p nil
  "Have values been loaded?")

(defvar track-values-modified-p t
  "Have values been modified?")

(defvar track-values-current-key nil
  "Current item being recorded.")


;;; Table creation

(defun track-values-make-table (name &optional pairs)
  (pushnew name track-values-tables)
  (let ((table-name (intern (format "track-values-%s-table" name)))
        (prompt-name (intern (format "track-values-%s-keys" name))))
    (set table-name (make-hash-table :weakness nil :test 'case-fold))
    (set prompt-name (mapcar #'first pairs))
    (mapcar #'(lambda (x) (puthash (first x) (second x) (symbol-value table-name))) pairs)
    (setf track-values-modified-p t)))


;;; Get and set values

(defun track-values-get-value (table key)
  (gethash key (symbol-value (intern (format "track-values-%s-table" table)))))

(defun track-values-set-value (table key value)
  (puthash key value (symbol-value (intern (format "track-values-%s-table" table))))
  (cl-pushnew key (symbol-value (intern (format "track-values-%s-keys" table))) :test #'string=)
  (setf track-values-modified-p t))


;;; I/O functions

(defun track-values-load-data ()
  "Load calorie data."
  (when (file-exists-p track-values-save-file)
    (load track-values-save-file t t t)
    (setf track-values-loaded-p t
          track-values-modified-p nil)))

(defun track-values-save-data ()
  "Write calorie data."
  (when track-values-modified-p
    (with-temp-buffer
      (insert ";; generated by track-values.el        -*- mode: lisp-data -*-\n"
              ";; do not modify by hand\n\n")
      (let ((standard-output (current-buffer)))
        (mapcar #'(lambda (name)
                    (print `(track-values-make-table ',name ',(mapcar (lambda (x)
                                                                        (list x (track-values-get-value name x)))
                                                                      (hash-table-keys (symbol-value (intern (format "track-values-%s-table" name))))))))
                track-values-tables))
      (write-region (point-min) (point-max) track-values-save-file)
      (setf track-values-modified-p nil))))


;;; Primary interaction functions

(defun track-values-complete (&optional name)
  (let ((all-keys (remove-duplicates (loop for name in track-values-tables appending (symbol-value (intern (format "track-values-%s-keys" name)))))))
    (if name
        (completing-read "Item: " (symbol-value (intern (format "track-values-%s-keys" name)))
                         #'identity nil nil nil nil t)
      (completing-read "Item: " all-keys
                       #'identity nil nil nil nil t))))

(defun track-values-start (&optional name)
  "Get a food item to retrieve or prompt for calories."
  (unless track-values-loaded-p
    (track-values-load-data))
  (let ((key (track-values-complete name)))
    (if key
        (setf track-values-current-key (downcase key))
      (user-error "A key must be provided"))))

(defun track-values-insert (name)
  "Get or prompt for the number of calories in the current food item."
  (let ((item (track-values-get-value name track-values-current-key)))
    (if item
        (format "%s" item)
      (let ((item (read-string (format "%s in \"%s\": " name track-values-current-key))))
        (track-values-set-value name track-values-current-key item)
        (format "%s" item)))))

(defun track-values-end ()
  (setf track-values-current-key nil))

(provide 'track-values)

;;; track-values.el ends here