1 files changed, 71 insertions, 0 deletions
diff --git a/users/sterni/mblog/cli.lisp b/users/sterni/mblog/cli.lisp
new file mode 100644
index 000000000000..9bc0681df0f5
--- /dev/null
+++ b/users/sterni/mblog/cli.lisp
@@ -0,0 +1,71 @@
+(in-package :cli)
+(declaim (optimize (safety 3)))
+
+;; 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))
+
+(defun main ()
+  "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)))))