# HG changeset patch # User Steve Losh # Date 1749758833 14400 # Node ID da9138afa986f614c278fb6e638db7903447f1cb Initial commit diff -r 000000000000 -r da9138afa986 .ffignore --- /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/ diff -r 000000000000 -r da9138afa986 .hgignore --- /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 diff -r 000000000000 -r da9138afa986 .lispwords diff -r 000000000000 -r da9138afa986 LICENSE.markdown --- /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. diff -r 000000000000 -r da9138afa986 Makefile --- /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/ diff -r 000000000000 -r da9138afa986 README.markdown --- /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:** + +Works in SBCL. Other implementations are untested, but should hopefully work too. diff -r 000000000000 -r da9138afa986 planner.asd --- /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 " + + :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"))))) diff -r 000000000000 -r da9138afa986 src/build-binary.lisp --- /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)) diff -r 000000000000 -r da9138afa986 src/build-manual.lisp --- /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)) diff -r 000000000000 -r da9138afa986 src/main.lisp --- /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 "
~A
" 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))))) + + diff -r 000000000000 -r da9138afa986 src/package.lisp --- /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))