refactor(sterni/mblog): add (sub)class for apple note messages

* Upon creation of an apple-note object we can check if certain fields
  we are interested in are present and of the right type etc.

  These currently are:

  - UUID (for links later)
  - Subject (title)
  - Time
  - Text part with supported MIME type

  These are then put into their own shortcut fields in the apple-note
  subclass which allows for easier access and forces us to make sure
  they are present.

* Split out everything note related into its own package. Using the new
  type, we can expose an interface which sort of makes sense.

Change-Id: Ic9d67518354e61a3cc8388bb0e566fce661e90d0
Reviewed-on: https://cl.tvl.fyi/c/depot/+/5072
Tested-by: BuildkiteCI
Reviewed-by: sterni <sternenseemann@systemli.org>

users/sterni/mblog/cli.lisp

@@ -13,5 +13,6 @@
                               args))))
     (if help-p (format *error-output* "Usage: ~A~%" +synopsis+)
       (loop for arg in args
-            do (apple-note-html-fragment
+            do (note:apple-note-html-fragment
-                (mime:mime-message (pathname arg)) *standard-output*)))))
+                (note:make-apple-note (mime:mime-message (pathname arg)))
+                *standard-output*)))))

users/sterni/mblog/default.nix

@@ -18,6 +18,7 @@ depot.nix.buildLisp.program {
     }
     depot.third_party.lisp.alexandria
     depot.third_party.lisp.closure-html
+    depot.third_party.lisp.cl-date-time-parser
     depot.third_party.lisp.cl-who
     depot.third_party.lisp.mime4cl
   ];

users/sterni/mblog/note.lisp

@@ -1,4 +1,4 @@
-(in-package :mblog)
+(in-package :note)
 (declaim (optimize (safety 3)))
 
 ;;; util
@@ -15,46 +15,107 @@
   surrounds them with angle brackets for a MIME header"
   (concatenate 'string "<" cid ">"))
 
+;; TODO(sterni): move into mime4cl
+(defun find-mime-message-header (header-name message)
+  (when-let ((header (assoc header-name
+                            (mime:mime-message-headers message)
+                            :test #'string-equal)))
+    (cdr header)))
+
+(defun find-mime-message-date (message)
+  (when-let ((date-string (find-mime-message-header "Date" message)))
+    (date-time-parser:parse-date-time date-string)))
+
 ;;; main implementation
 
-;; TODO(sterni): make this a “parser” instead of a predicate
+(defun apple-note-mime-subtype-p (x)
+  (member x '("plain" "html") :test #'string-equal))
+
+(deftype apple-note-mime-subtype ()
+  '(satisfies apple-note-mime-subtype-p))
+
+(defclass apple-note (mime:mime-message)
+  ((text-part
+    :type mime:mime-text
+    :initarg :text-part
+    :reader apple-note-text-part)
+   (subject
+    :type string
+    :initarg :subject
+    :reader apple-note-subject)
+   (uuid
+    :type string
+    :initarg :uuid
+    :reader apple-note-uuid)
+   (time
+    :type integer
+    :initarg :time
+    :reader apple-note-time)
+   (mime-subtype
+    :type apple-note-mime-subtype
+    :initarg :mime-subtype
+    :reader apple-note-mime-subtype))
+  (:documentation
+   "Representation of a Note created using Apple's Notes using the IMAP backend"))
+
 (defun apple-note-p (msg)
   "Checks X-Uniform-Type-Identifier of a MIME:MIME-MESSAGE
-  to determine if a given mime message is an Apple Note."
+  to determine if a given mime message claims to be an Apple Note."
   (when-let (uniform-id (assoc "X-Uniform-Type-Identifier"
                                (mime:mime-message-headers msg)
                                :test #'string-equal))
     (string-equal (cdr uniform-id) "com.apple.mail-note")))
 
-(defun apple-note-html-fragment (msg out)
+(defun make-apple-note (msg)
-  "Takes a MIME:MIME-MESSAGE and writes its text content as HTML to
+  (check-type msg mime-message)
+
+  (unless (apple-note-p msg)
+    (error "Passed message is not an Apple Note according to headers"))
+
+  (let ((text-part (mime:find-mime-text-part msg))
+        (subject (find-mime-message-header "Subject" msg))
+        (uuid (when-let ((val (find-mime-message-header
+                               "X-Universally-Unique-Identifier"
+                               msg)))
+                (string-downcase val)))
+        (time (find-mime-message-date msg)))
+    ;; The idea here is that we don't need to check a lot manually, instead
+    ;; the type annotation are going to do this for us (with sufficient safety?)
+    (change-class msg 'apple-note
+                  :text-part text-part
+                  :subject subject
+                  :uuid uuid
+                  :time time
+                  :mime-subtype (mime:mime-subtype text-part))))
+
+(defgeneric apple-note-html-fragment (note out)
+  (:documentation
+   "Takes an APPLE-NOTE and writes its text content as HTML to
    the OUT stream. The <object> tags are resolved to <img> which
    refer to the respective attachment's filename as a relative path,
    but extraction of the attachments must be done separately. The
    surrounding <html> and <body> tags are stripped and <head>
    discarded completely, so only a fragment which can be included
-  in custom templates remains."
+   in custom templates remains."))
-  (let ((text (find-mime-text-part msg)))
+
+(defmethod apple-note-html-fragment ((note apple-note) (out stream))
+  (let ((text (apple-note-text-part note)))
     (cond
-      ;; Sanity checking of the note
-      ((not (apple-note-p msg))
-       (error "Unsupported or missing X-Uniform-Type-Identifier"))
-      ((not text) (error "Malformed Apple Note: no text part"))
       ;; notemap creates text/plain notes we need to handle properly.
       ;; Additionally we *could* check X-Mailer which notemap sets
-      ((string-equal (mime:mime-subtype text) "plain")
+      ((string-equal (apple-note-mime-subtype note) "plain")
        (html-escape-stream (mime:mime-body-stream text :binary nil) out))
       ;; Notes.app creates text/html parts
-      ((string-equal (mime:mime-subtype text) "html")
+      ((string-equal (apple-note-mime-subtype note) "html")
        (closure-html:parse
         (mime:mime-body-stream text)
         (make-instance
          'apple-note-transformer
          :cid-lookup
          (lambda (cid)
-           (when-let* ((part (mime:find-mime-part-by-id msg (cid-header-value cid)))
+           (when-let* ((part (mime:find-mime-part-by-id note (cid-header-value cid)))
                        (file (mime:mime-part-file-name part)))
              file))
          :next-handler
          (closure-html:make-character-stream-sink out))))
-      (t (error "Malformed Apple Note: unknown mime type")))))
+      (t (error "Internal error: unexpected MIME subtype")))))

users/sterni/mblog/packages.lisp

@@ -5,18 +5,33 @@
   (:documentation
    "Very incomplete package for dealing with maildir(5)."))
 
-(defpackage :mblog
+(defpackage :note
   (:use
    :common-lisp
-   :mime4cl
    :closure-html
    :who
-   :uiop)
+   :cl-date-time-parser
-  (:shadow :with-html-output) ; conflict between closure-html and who
+   :mime4cl
+   :who)
   (:import-from
    :alexandria
    :when-let*
    :when-let
    :starts-with-subseq
    :ends-with-subseq)
+  (:shadow :with-html-output) ; conflict between closure-html and who
+  (:export
+   :apple-note
+   :apple-note-uuid
+   :apple-note-subject
+   :apple-note-time
+   :apple-note-text-part
+   :make-apple-note
+   :apple-note-html-fragment))
+
+(defpackage :mblog
+  (:use
+   :common-lisp
+   :uiop
+   :note)
   (:export :main))

users/sterni/mblog/transformer.lisp

@@ -1,4 +1,4 @@
-(in-package :mblog)
+(in-package :note)
 (declaim (optimize (safety 3)))
 
 ;; Throw away these tags and all of their children