--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/.ffignore Thu Jun 12 16:07:13 2025 -0400
@@ -0,0 +1,1 @@
+build/
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/.hgignore Thu Jun 12 16:07:13 2025 -0400
@@ -0,0 +1,4 @@
+syntax: glob
+
+scratch.lisp
+build
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/LICENSE.markdown Thu Jun 12 16:07:13 2025 -0400
@@ -0,0 +1,19 @@
+Copyright (c) 2025 Steve Losh and contributors
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Makefile Thu Jun 12 16:07:13 2025 -0400
@@ -0,0 +1,17 @@
+.PHONY: all
+
+all: build/planner
+
+# Build -----------------------------------------------------------------------
+lisps := $(shell ffind '\.(asd|lisp)$$')
+
+build/planner: $(lisps) Makefile
+ mkdir -p build/
+ sbcl --disable-debugger --load "src/build-binary.lisp"
+
+build/planner.1: $(lisps) Makefile
+ mkdir -p build/
+ sbcl --disable-debugger --load "src/build-manual.lisp" --quit
+
+clean:
+ rm -r build/
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/README.markdown Thu Jun 12 16:07:13 2025 -0400
@@ -0,0 +1,7 @@
+`planner` is a little Common Lisp bot I use to send myself emails each morning
+that help me plan my day.
+
+* **License:** MIT
+* **Mercurial:** <https://hg.stevelosh.com/planner/>
+
+Works in SBCL. Other implementations are untested, but should hopefully work too.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/planner.asd Thu Jun 12 16:07:13 2025 -0400
@@ -0,0 +1,13 @@
+(asdf:defsystem :planner
+ :description "Planner helps me plan life"
+ :author "Steve Losh <steve@stevelosh.com>"
+
+ :license "MIT/X11"
+ :version "0.0.1"
+
+ :depends-on (:losh :adopt :cl-smtp :uiop :alexandria :safe-read :local-time)
+
+ :serial t
+ :components ((:module "src" :serial t
+ :components ((:file "package")
+ (:file "main")))))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/build-binary.lisp Thu Jun 12 16:07:13 2025 -0400
@@ -0,0 +1,12 @@
+(require :asdf)
+(require :uiop)
+(asdf:load-system :planner)
+
+(progn
+ (sb-ext:gc :full t)
+ (sb-ext:save-lisp-and-die
+ "build/planner"
+ :executable t
+ :compression t
+ :toplevel #'planner:toplevel
+ :save-runtime-options t))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/build-manual.lisp Thu Jun 12 16:07:13 2025 -0400
@@ -0,0 +1,4 @@
+(ql:quickload :planner)
+
+(with-open-file (stream "build/planner.1" :direction :output :if-exists :supersede)
+ (adopt:print-manual planner:*ui* :stream stream))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/main.lisp Thu Jun 12 16:07:13 2025 -0400
@@ -0,0 +1,142 @@
+(in-package :planner)
+
+;;;; Config -------------------------------------------------------------------
+(defparameter *credentials-path*
+ "/")
+
+(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)))
+
+;;;; Command Line -------------------------------------------------------------
+(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)))))
+
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/package.lisp Thu Jun 12 16:07:13 2025 -0400
@@ -0,0 +1,9 @@
+(defpackage :planner
+ (:use :cl :losh :iterate)
+ (:export :*ui* :toplevel))
+
+(defpackage :planner/conf
+ (:use)
+ (:export :smtp-user-name
+ :smtp-api-token
+ :zip-code))