(defpackage :git-pick-patch
(:use :cl :alexandria :serapeum)
(:export ))
(in-package :git-pick-patch)
(defun read-header (inp)
(string-join (loop for line = (read-line inp nil)
while line
collect line
until (eql #\@ (peek-char nil inp nil)))
#\newline))
(defun read-hunk (inp)
(when (eql #\@
(peek-char nil inp nil))
(string-join (loop for line = (read-line inp nil)
while line
collect line
until (member (peek-char nil inp nil) '(#\@ #\d)))
#\newline)))
(defun read-hunks (inp)
(loop for hunk = (read-hunk inp)
while hunk
collect hunk))
(defun get-file-patch (inp)
(list (read-header inp)
(read-hunks inp)))
(defun get-all-patches (inp)
(loop for patch = (get-file-patch inp)
for (header data) = patch
while (and (string/= header "")
(not (null data)))
collect patch))
(defun filter-hunks (hunks predicate)
(remove-if-not predicate hunks))
(defun filter-file-hunks (file-data predicate)
(let ((results (filter-hunks (cadr file-data)
predicate)))
(when results
(list (car file-data)
results))))
(defun filter-patch (patch-data predicate)
(remove-if #'null (mapcar (lambda (x)
(filter-file-hunks x predicate))
patch-data)))
(defun combine-hunks (hunks)
(string-join hunks #\newline))
(defun rebuild-file-patch (file-data)
(destructuring-bind (header hunks) file-data
(format nil "~a~%~a" header (combine-hunks hunks))))
(defun rebuild-patch (patch-data)
(string-join (mapcar #'rebuild-file-patch patch-data)
#\newline))
(defun main ()
(if (null (cadr sb-ext:*posix-argv*))
(format t "~&Must provide a pattern!")
(let* ((pattern (cadr sb-ext:*posix-argv*)))
(loop for patch = (get-file-patch *standard-input*)
for filtered = (when patch (filter-file-hunks patch
(op (cl-ppcre:scan pattern _))))
until (equal patch '("" nil))
when filtered do
(format t "~&~a~&" (rebuild-file-patch filtered))))))
|