git.fiddlerwoaroof.com
Raw Blame History
(in-package :co.fwoar.awkish)

(defmacro with-command-output ((s command &rest args &key (output nil output-p)
                                &allow-other-keys)
                               &body body)
  (declare (ignore output))
  (when output-p
    (error "can't override :output"))
  `(let ((,s (uiop:process-info-output
              (uiop:launch-program ,command :output :stream ,@args))))
     ,@body))


(defvar *client*)
(defvar *record*)
(defvar *nr*)
(defvar *nf*)
(defmacro do-lines ((line s &optional (client :lines)) &body body)
  (multiple-value-bind (body decls)
      (alexandria:parse-body body)
    (alexandria:with-gensyms (client-instance)
      (alexandria:once-only (s)
        `(let* ((,client-instance (make-client ,client ,s))
                (*client* ,client-instance))
           (loop for ,line = (next-record *client* ,s)
                 until (eql ,line *eof-sentinel*)
                 do ((lambda (,line)
                       ,@decls
                       (let ((*client* ,client-instance))
                         ,@body))
                     ,line)))))))

(defvar *pattern-binds* nil)
(defmacro awk ((s &key (args nil args-p) (client :lines)) &body pattern-actions)
  (let* ((begin (when (eql (caar pattern-actions) :begin)
                  (car pattern-actions)))
         (end (when (eql (caar (last pattern-actions)) :end)
                (car (last pattern-actions))))
         (pattern-actions (if begin
                              (cdr pattern-actions)
                              pattern-actions))
         (pattern-actions (if end
                              (butlast pattern-actions)
                              pattern-actions))
         (binders (when args-p
                    (mapcar (lambda (n)
                              (intern (format nil "$~d" n)))
                            (alexandria:iota args :start 1)))))
    `(block nil
       ,@(cdr begin)
       (let ((*nr* 0))
         (do-lines ($0 ,s ,client)
           (declare (ignorable $0))
           (let* (($* (parse-record *client* $0))
                  (*record* $*)
                  (*nf* (field-count *client* $*)))
             (declare (ignorable $*))
             (destructuring-bind (&optional ,@binders &rest $@)
                 (unpack-binders *client* $*)
               (declare (ignorable $@ ,@binders))
               ,@(mapcar (lambda (it)
                           (if (= 1 (length it))
                               (alexandria:with-gensyms (v)
                                 `(let ((,v ,(car it)))
                                    (when ,v
                                      (princ $0)
                                      (terpri))))
                               (let ((pattern (car it))
                                     (rest (cdr it)))
                                 (alexandria:with-gensyms (result binds)
                                   `(multiple-value-bind (,result ,binds) ,pattern
                                      (let ((*pattern-binds* (list* ,result (coerce ,binds 'list))))
                                        (when ,result
                                          ,@rest)))))))
                         pattern-actions)))
           (incf *nr*)))
       ,@(cdr end)
       (values))))

(defun ~ (regex thing)
  (cl-ppcre:scan-to-strings regex (string thing)))

(defmacro defawk (name (s args) &body body)
  `(defun ,name (,s)
     (awk (,s :args ,args)
       ,@body)))

#+(or)
(
 (defun preview-html (s)
   (alexandria:with-output-to-file (o "/tmp/out.html" :if-exists :supersede)
     (uiop:vomit-output-stream s o)
     (uiop:run-program (list "/usr/bin/open" "-a" "Safari" (namestring o)))
     #+(or)
     (uiop:run-program (list "/usr/bin/open" "-a" "Emacs" (namestring o)))))


 (spinneret:with-html
   (:table
    (with-input-from-string (s (format nil "a b~%c d~% e f"))
      (awk (s :args 2)
        (:begin (:thead (:th "first") (:th "second")))
        (t (:tr (mapc (lambda (cell)
                        (:td $1 cell))
                      $*)))
        (:end (:tfoot (:td "end first") (:td "end second")))))))

 (spinneret:with-html
   (:table
    (awk ((format nil "a b~%c d~% e f~%g") :args 2)
      (t (:tr (mapc (lambda (cell)
                      (:td $1 cell))
                    $*)))
      (:end (:tfoot (:td "end first") (:td "end second"))))))

 (spinneret:with-html
   (:table
    (with-command-output (s "ps aux")
      (awk (s :args 9)
        (:begin (:thead (:th "first") (:th "second")))
        (t (:tr (:td $1) (:td $2) (:td $3 "%") (:td $4)
                (:td (serapeum:string-join $@ " "))))
        (:end (:tfoot (:td "end first") (:td "end second")))))))

 (serapeum:with-collector (c)
   (with-command-output (s "ps aux")
     (awk (s :args 10)
       ((> *nf* 30) (c *nf* (car $@))))))

 )