tvl-depot/users/sterni/mblog/cli.lisp

(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)))))