Something went wrong. Try again.
Runabout is a long-term agent harness.
Something went wrong. Try again.
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129(in-package #:runabout.repl)
(defun update-or-write-file (path new &key check) "Write NEW to the file at PATH, creating or replacing it; return a diff.NEW is text, a list of lines, or a function from existing text to new text:(update-or-write-file \"notes.md\" #>END# NotesEND)(update-or-write-file \"a.lisp\" (lambda (s) (replace-text s \"foo\" \"bar\" :all t)))Use REPLACE-IN-FILE for one exact replacement: it refuses an ambiguous match.Create missing directories. Publish atomically after checking the originaltext; concurrent edits after that check can still be overwritten. Return thediff and a changed flag. :CHECK T previews without writing." (let* ((existing (probe-file path)) (path (namestring (or existing (merge-pathnames path)))) (text (if existing (text-file path) "")) (body (without-bom text)) (result (typecase new (null (tool-fail "NEW is NIL; pass \"\" for an empty file")) ((or string list) (text-content new)) (t (unless existing (tool-fail "~a does not exist" path)) (let ((result (funcall new body))) (if (stringp result) result (tool-fail "NEW returned ~a, not a string" (print-limited result 80))))))) (whole (restore-bom text result)) (changed (not (and existing (string= whole text))))) (when (and changed (not check)) (atomic-text-write path whole (and existing text))) (values (text-diff body result (if existing path "/dev/null") path) changed)))
(defun replace-in-file (path old new &key all regex ignore-case check) "Replace the text OLD with NEW in the file at PATH; return a diff and a count.OLD must occur exactly once unless :ALL T; NEW NIL deletes it. A nonempty NEWends in a newline exactly when OLD does. :REGEX T makes OLD a PCRE2 pattern(^ and $ match at line ends) and NEW a template taking $1 or ${name}, neitherwith a final newline. :IGNORE-CASE T ignores case. :CHECK T previews without writing.Use UPDATE-OR-WRITE-FILE for a rewrite that is not one exact replacement.(replace-in-file \"a.lisp\" #>OLD (format t \"hi~%\")OLD #>NEW (format t \"hello~%\")NEW)" (let ((count 0)) (values (update-or-write-file path (lambda (text) (multiple-value-bind (result n) (replace-text text old new :all all :regex regex :ignore-case ignore-case) (setf count n) result)) :check check) count)))
(defun replace-text (text old new &key all regex ignore-case) "Replace OLD with NEW in the string TEXT; return (values new-text count).The rules are REPLACE-IN-FILE's." (let ((old (text-content old)) (new (text-content new)))
(cond (regex (setf old (chomp old) new (chomp new))) ((plusp (length new)) (setf new (if (ends-with (string #\Newline) old) (format nil "~a~%" (chomp new)) (chomp new))))) (when (string= old "") (tool-fail "OLD is empty; to insert, put a neighbouring line in both OLD and NEW")) (if regex (multiple-value-bind (result count) (regex-substitute old text new :ignore-case ignore-case) (cond ((zerop count) (tool-fail "The pattern matches nothing")) ((and (> count 1) (not all)) (tool-fail "The pattern matches ~d times~@[, on lines ~12{~d~^, ~}~]; ~ make it match once, or pass :ALL T" count (call-with-regex old ignore-case (lambda (matches) (loop for (line) in (file-lines text) for n from 1 when (funcall matches line) collect n))))) (t (values result count)))) (let* ((test (if ignore-case #'char-equal #'char=)) (hits (loop for at = (search old text :test test) then (search old text :test test :start2 (+ at (length old))) while at collect at))) (cond ((null hits) (tool-fail "~a" (missing-text old text))) ((and (rest hits) (not all)) (tool-fail "OLD occurs ~d times, on lines ~12{~d~^, ~}; extend it to one, or pass :ALL T" (length hits) (remove-duplicates (mapcar (lambda (at) (1+ (count #\Newline text :end at))) hits)))) (t (values (with-output-to-string (out) (let ((start 0)) (dolist (at hits) (write-string text out :start start :end at) (write-string new out) (setf start (+ at (length old)))) (write-string text out :start start))) (length hits))))))))
(defun squash (text) "TEXT with each run of whitespace one space, and none at the ends." (format nil "~{~a~^ ~}" (remove-if #'blank-p (split #\Space (substitute-if #\Space #'lisp-space-p text)))))
(defun missing-text (old text) (let* ((lines (coerce (file-lines text) 'vector)) (have (coerce (loop for (line) across lines for n from 1 for squashed = (squash line) unless (blank-p squashed) collect (cons n squashed)) 'vector)) (want (remove-if #'blank-p (mapcar (lambda (line) (squash (car line))) (file-lines old)))) (k (length want)) (partial (and (ends-with (string #\Newline) old) (search (chomp old) text)))
(near (when want (loop for i from 0 to (- (length have) k) when (loop for w in want for j from i for line = (cdr (aref have j)) always (cond ((= k 1) (search w line)) ((= j i) (ends-with w line)) ((= j (+ i k -1)) (starts-with w line)) (t (string= w line)))) return (list (car (aref have i)) (car (aref have (+ i k -1))))))) (stale (loop for (line) in (file-lines old) for n from 1 for squashed = (squash line) unless (or (blank-p squashed) (find squashed have :key #'cdr :test #'search)) return (list n (trim line))))) (cond (partial (format nil "OLD matches line ~d only without its final newline; for part of a line, ~ use a \"string\", not #> text" (1+ (count #\Newline text :end partial)))) (near (destructuring-bind (lo hi) near (format nil "OLD matches ~:[lines ~d-~d~;line ~d~*~] only if whitespace is ignored. ~ Copy from:~%~20{~a~%~}" (= lo hi) lo hi (map 'list #'car (subseq lines (1- lo) hi))))) (stale (format nil "Line ~d of OLD matches nothing: ~a" (first stale) (second stale))) (t "OLD matches nothing, though each of its lines does"))))