src/main.lisp @ 13d4b6ab6f9c default tip

(in-package :planner)

;;;; Config -------------------------------------------------------------------
(defvar *smtp-api-token* nil)
(defvar *smtp-user-name* nil)
(defvar *zip-code* nil)

(defparameter *from-address* "plan@stevelosh.com")
(defparameter *display-name* "Plan")
(defparameter *to-address* "steve@stevelosh.com")
(defparameter *smtp-server* "smtp.fastmail.com")

(defun safely-read-1 (stream packages)
  (handler-case
      (loop :for value = (safe-read:safe-read stream packages)
            :when value :do (return (values value t)))
    (end-of-file ()
      (values nil nil))))

(defun load-config ()
  (let* ((all-config-paths (uiop:xdg-config-pathnames "planner/config.sexp"))
         (config-paths (reverse (remove-if-not #'probe-file all-config-paths))))
    (dolist (config-path config-paths)
      (with-open-file (f config-path)
        (let ((config (safely-read-1 f (list :planner/conf))))
          (setf
            *zip-code* (getf config 'planner/conf:zip-code *zip-code*)
            *smtp-user-name* (getf config 'planner/conf:smtp-user-name *smtp-user-name*)
            *smtp-api-token* (getf config 'planner/conf:smtp-api-token *smtp-api-token*)))))
    (assert (not (null *zip-code*))       () "zip-code not configured in any of ~{~A~^ ~}" all-config-paths)
    (assert (not (null *smtp-user-name*)) () "smtp-user-name not configured in any of ~{~A~^ ~}" all-config-paths)
    (assert (not (null *smtp-api-token*)) () "smtp-api-token not configured in any of ~{~A~^ ~}" all-config-paths)))


;;;; Date ---------------------------------------------------------------------
(defun date-iso ()
  (local-time:format-timestring
    nil (local-time:now)
    :format '((:year 4) #\- (:month 2) #\- (:day 2))))

(defun date-human ()
  (local-time:format-timestring
    nil (local-time:now)
    :format '(:long-weekday ", " :long-month " " :day ", " :year)))


;;;; Weather ------------------------------------------------------------------
(defun weather ()
  (sh `("weather" "--hours" "20" ,*zip-code*) :result-type 'string))


;;;; Main ---------------------------------------------------------------------
(defun build-subject ()
  (format nil "[plan/~A] Plan for ~A" (date-iso) (date-human)))

(defun header (string &key (width 60))
  (if (>= (length string) (1- width))
    string
    (format nil "~A ~v,,,'=@A" string (- width (length string) 1) "")))

(defun build-content ()
  (format nil
          "Plan for ~A.~2%~
           ~
           ~A~2%~A"
           (date-human)
           (header "Weather") (weather)))

(defun build-email ()
  (values (build-subject) (build-content)))

(defun print-email (subject content)
  (format t "From: ~A~%~
             To: ~A~%~
             Subject: ~A~2%~
             ~
             ~A~%"
             *from-address*
             *to-address*
             subject
             content))

(defun send-email (subject content)
  (cl-smtp:send-email
    *smtp-server*
    *from-address*
    *to-address*
    subject
    content
    :ssl :tls
    :port 465
    :display-name "Plan"
    :authentication (list *smtp-user-name* *smtp-api-token*)
    :html-message (format nil "<pre>~A</pre>" content)))

(defun run (&key (dry-run t))
  (load-config)
  (multiple-value-bind (subject content) (build-email)
    (if dry-run
      (print-email subject content)
      (send-email subject content))
    (values)))


;;;; UI -----------------------------------------------------------------------
(adopt:define-string *documentation*
  "Planner sends planning emails.")

(defparameter *o/help*
  (adopt:make-option 'help
    :help "display help and exit"
    :long "help"
    :short #\h
    :reduce (constantly t)))

(defparameter *o/dry-run*
  (adopt:make-option 'dry-run
    :help "print email to stdout instead of sending it"
    :long "dry-run"
    :short #\n
    :reduce (constantly t)))

(defparameter *ui*
   (adopt:make-interface
     :name "planner"
     :usage "[OPTIONS]"
     :summary "A Common Lisp bot for sending emails to help me plan."
     :help *documentation*
     :contents
     (list *o/help*
           *o/dry-run*)))


(defun toplevel ()
  (adopt::quit-on-ctrl-c ()
    (multiple-value-bind (arguments options) (adopt:parse-options *ui*)
      (when (gethash 'help options)
        (adopt:print-help-and-exit *ui*))
      (unless (null arguments)
        (adopt:print-error-and-exit "No arguments supported."))
      (run :dry-run (gethash 'dry-run options)))))