feat(users/sterni/mblog): implement mblog executable r/3752

This change finally sort of puts the parts together: We take a maildir,
render all its note messages as standalone HTML, extract the attachments
alongside and finally generate a global index page linking all notes.

The new executable and mnote-html are both contained in the same image
and we dispatch the right functionality based on argv[0].

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

1 files changed, 67 insertions, 14 deletions

diff --git a/users/sterni/mblog/cli.lisp b/users/sterni/mblog/cli.lisp
index 14c7adda28ed..9bc0681df0f5 100644
--- a/users/sterni/mblog/cli.lisp
+++ b/users/sterni/mblog/cli.lisp
@@ -1,18 +1,71 @@
-(in-package :mblog)
+(in-package :cli)
 (declaim (optimize (safety 3)))
 
-(defparameter +synopsis+ "mnote-html FILE [FILE [ ... ]]")
+;; TODO(sterni): nicer messages for various errors signaled?
+
+(defun partition-by (f seq)
+  "Split SEQ into two lists, returned as multiple values. The first list
+  contains all elements for which F returns T, the second one the remaining
+  elements."
+  (loop for x in seq
+        if (funcall f x)
+          collecting x into yes
+        else
+          collecting x into no
+        finally (return (values yes no))))
+
+(defparameter +help+ '(("mnote-html" . "FILE [FILE [ ... ]]")
+                       ("mblog"      . "MAILDIR OUT")))
+
+(defun mnote-html (name flags &rest args)
+  "Convert all note mime messages given as ARGS to HTML fragments."
+  (declare (ignore name flags))
+  (loop for arg in args
+        do (note:apple-note-html-fragment
+            (note:make-apple-note (mime:mime-message (pathname arg)))
+            *standard-output*)))
+
+(defun mblog (name flags maildir outdir)
+  "Read a MAILDIR and build an mblog in OUTDIR "
+  (declare (ignore name flags))
+  (build-mblog (pathname maildir) (pathname outdir)))
+
+(defun display-help (name flags &rest args)
+  "Print help message for current executable."
+  (declare (ignore args flags))
+  (format *error-output* "Usage: ~A ~A~%"
+          name
+          (or (cdr (assoc name +help+ :test #'string=))
+              (concatenate 'string "Unknown executable: " name))))
+
+(defun usage-error (name flags &rest args)
+  "Print help and exit with a non-zero exit code."
+  (format *error-output* "~A: usage error~%" name)
+  (display-help name args flags)
+  (uiop:quit 100))
 
-;; TODO(sterni): handle relevant conditions
 (defun main ()
-  (let* ((args (uiop:command-line-arguments))
-         (help-p (or (not args)
-                     (find-if (lambda (x)
-                                (member x '("-h" "--help" "--usage")
-                                        :test #'string=))
-                              args))))
-    (if help-p (format *error-output* "Usage: ~A~%" +synopsis+)
-      (loop for arg in args
-            do (note:apple-note-html-fragment
-                (note:make-apple-note (mime:mime-message (pathname arg)))
-                *standard-output*)))))
+  "Dispatch to correct main function based on arguments and UIOP:ARGV0."
+  (multiple-value-bind (flags args)
+      (partition-by (lambda (x) (starts-with #\- x))
+                    (uiop:command-line-arguments))
+
+    (let ((prog-name (pathname-name (pathname (uiop:argv0))))
+          (help-requested-p (find-if (lambda (x)
+                                       (member x '("-h" "--help" "--usage")
+                                               :test #'string=))
+                                     args)))
+      (apply
+       (if help-requested-p
+           #'display-help
+           (cond
+             ((and (string= prog-name "mnote-html")
+                   (null flags))
+              #'mnote-html)
+             ((and (string= prog-name "mblog")
+                   (null flags)
+                   (= 2 (length args)))
+              #'mblog)
+             (t #'usage-error)))
+       (append (list prog-name flags)
+               args)))))