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>
		
			
				
	
	
		
			71 lines
		
	
	
	
		
			2.5 KiB
		
	
	
	
		
			Common Lisp
		
	
	
	
	
	
			
		
		
	
	
			71 lines
		
	
	
	
		
			2.5 KiB
		
	
	
	
		
			Common 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)))))
 |