add some hashline patch validation

1 files changed, 126 insertions, 58 deletions

diff --git a/llm-tools-hl.el b/llm-tools-hl.el
index 808b837..61c4919 100644
--- a/llm-tools-hl.el
+++ b/llm-tools-hl.el
@@ -99,6 +99,129 @@ Each element is a line number and two-character hash, like `1vx'."
   (let ((lines (llm-tools--hl-file-lines file)))
     (llm-tools--hl-hash (elt lines (1- n)))))
 
+;;;; Diff Validation
+;; TODO this should also validate the operators (e.g. any invalid
+;; op-chars, payload given before all other operations, no payload
+;; after +/< or payload given to -, or anchors without line
+;; number). it should return a string saying it's a malformed patch
+;; and what went wrong.
+(cl-defstruct hl-verify-op
+  (type nil)     ; 'insert-after 'insert-before 'delete 'replace
+  (anchor nil)   ; string like "4ei" or "EOF" for +/-/<
+  (payload nil)  ; list of strings (nil is no payload)
+  (raw nil))     ; raw op line text for error messages
+
+(defun llm-tools--hl-parse-section-ops (section-body)
+  "Parse SECTION-BODY into a list of `hl-verify-op' structs.
+Skips comment lines and blank lines."
+  (let (ops op)
+    (dolist (line (string-lines section-body))
+      (when (string-match-p "\\S-" line)
+        (let ((ch (substring line 0 1)))
+          (pcase ch
+            ("#" nil)
+            ("~"
+             (when op
+               (setf (hl-verify-op-payload op)
+                     (append (hl-verify-op-payload op) (list (substring line 1))))))
+            (_
+             (when op (push op ops))
+             (setq op (make-hl-verify-op
+                       :type (pcase ch
+                               ("+" 'insert-after)
+                               ("<" 'insert-before)
+                               ("-" 'delete)
+                               ("=" 'replace))
+                       :anchor (substring line 2)
+                       :raw line))))))
+    (when op (push op ops))
+    (nreverse ops))))
+
+(defun llm-tools--hl-validate-no-payload-before-op (ops)
+  "Check that no payload lines appear before the first op."
+  (when-let ((first (car-safe ops)))
+    (if (hl-verify-op-payload first)
+        (list "Payload line (~) appears before any operation")
+      '())))
+
+(defun llm-tools--hl-validate-insert-has-payload (ops)
+  "Check that all insert ops have at least one payload line."
+  (let (errors)
+    (dolist (op ops)
+      (when (and (memq (hl-verify-op-type op) '(insert-after insert-before))
+                 (not (hl-verify-op-payload op)))
+        (push (format "Insert operation (%s) has no payload lines following it"
+                      (hl-verify-op-type op))
+              errors)))
+    (nreverse errors)))
+
+(defun llm-tools--hl-validate-delete-no-payload (ops)
+  "Check that delete ops have no payload lines."
+  (let (errors)
+    (dolist (op ops)
+      (when (and (eq (hl-verify-op-type op) 'delete)
+                 (hl-verify-op-payload op))
+        (push "Delete operation (-) must not have payload lines" errors)))
+    errors))
+
+(defun llm-tools--hl-validate-anchors (ops)
+  "Check that all anchors are well-formed."
+  (let (errors)
+    (dolist (op ops)
+      (let ((anchor (hl-verify-op-anchor op)))
+        (pcase (hl-verify-op-type op)
+          ((or 'insert-after 'insert-before)
+           (when (and anchor
+                      (not (string= anchor "EOF"))
+                      (not (string= anchor "BOF")))
+             (unless (and (>= (length anchor) 3)
+                          (string-match-p "\\`[0-9]" anchor))
+               (push (format "Invalid anchor %S (expected LINEHASH or EOF/BOF)" anchor)
+                     errors))))
+          ((or 'delete 'replace)
+           (let ((parts (split-string anchor "\\.\\.")))
+             (unless (= (length parts) 2)
+               (push (format "Invalid range %S (expected A..B)" anchor)
+                     errors))
+             (dolist (part parts)
+               (unless (and (>= (length part) 3)
+                            (string-match-p "\\`[0-9]" part))
+                 (push (format "Invalid anchor %S in range (expected numeric line anchor)" part)
+                       errors)))))))
+    errors)))
+
+(defun llm-tools--hl-verify-section (section)
+  "Validate a single SECTION. Returns a list of error strings."
+  (let ((ops (llm-tools--hl-parse-section-ops (cdr section))))
+    (append
+     (llm-tools--hl-validate-no-payload-before-op ops)
+     (llm-tools--hl-validate-insert-has-payload ops)
+     (llm-tools--hl-validate-delete-no-payload ops)
+     (llm-tools--hl-validate-anchors ops))))
+
+(defun llm-tools--hl-verify-structure (patch)
+  "Validate the structural integrity of PATCH.
+Returns a list of error strings describing each structural violation found.
+An empty list means the patch is well-formed."
+  (mapcan #'llm-tools--hl-verify-section
+          (llm-tools--split-patch-sections patch)))
+
+(defun llm-tools--hl-verify (patch)
+  "Verify PATCH is structurally valid and all anchors match current files.
+Returns a string with error messages, or an empty string if clean."
+  (let ((struct-errors (llm-tools--hl-verify-structure patch)))
+    (if struct-errors
+        (string-join struct-errors "\n")
+      (string-join
+       (delete-dups
+        (remq nil
+              (mapcar (lambda (elem)
+                        (unless (cdr elem)
+                          (format "%s had incorrect anchors. Use the 'read_file' tool to get correct anchors."
+                                  (car elem))))
+                      (llm-tools--hl-verify-anchors patch))))
+       "\n"))))
+
 ;;;; Diff Parsing
 (defun llm-tools--split-patch-sections (patch)
   "Return a list of (FILENAME . REST) cons cells from PATCH.
@@ -157,25 +280,6 @@ line in the on-disk file."
                 (cons file (cl-subsetp anchors hl :test #'equal))))
             patch-anchors)))
 
-;; TODO this should also validate the operators (e.g. any invalid
-;; op-chars, payload given before all other operations, no payload
-;; after +/< or payload given to -, or anchors without line
-;; number). it should return a string saying it's a malformed patch
-;; and what went wrong.
-(defun llm-tools--hl-verify (patch)
-  "Verify if the files in PATCH need to be re-read.
-Returns a string message that states which files need to be re-read.
-Empty string means no files need to be re-read."
-  (string-join
-   (delete-dups
-    (remq nil
-          (mapcar (lambda (elem)
-                    (unless (cdr elem)
-                      (format "%s had incorrect anchors. Use the 'read_file' tool to get correct anchors."
-                              (car elem))))
-                  (llm-tools--hl-verify-anchors patch))))
-   "\n"))
-
 (cl-defstruct hl-op
   (type nil)     ; 'insert-after 'insert-before 'delete 'replace
   (anchor nil)   ; string like "4ei" or "EOF" for +/-/<
@@ -219,9 +323,9 @@ Skips comment lines (starting with `#`) and blank lines."
             ("#" nil)
             (_
              (when op (push op ops))
-             (setq op (llm-tools--hl-parse-op-line line))))))
-      (when op (push op ops))
-      (nreverse ops))))
+             (setq op (llm-tools--hl-parse-op-line line)))))))
+    (when op (push op ops))
+    (nreverse ops)))
 
 (defun llm-tools--hl-group-by-file (sections)
   "Group SECTIONS by file path.
@@ -335,40 +439,4 @@ if verification failed."
           (format "Finished applying patch."))
       (format "%s" msg))))
 
-(let* ((patch "\
-# Replace one line (the payload must re-emit the original indentation)
-@@ mod.ts
-= 1vx..1vx
-~const TITLE = \"Mrs\";
-
-# Replace a full multiline statement (widen to a self-contained boundary)
-@@ mod.ts
-= 3gv..6be
-~       return [
-~               \"Mrs\",
-~               name?.trim() || \"guest\",
-~       ].join(\" \");
-
-# Insert AFTER/BEFORE a line
-@@ mod.ts
-+ 4ei
-~               \"Dr\",
-< 5ff
-~               \"Dr\",
-
-# Append to file
-@@ mod.ts
-+ EOF
-~export const done = true;
-
-# Delete a line
-@@ mod.ts
-- 5ff..5ff
-
-# Blank a line (replace with LF)
-@@ mod.ts
-= 5ff..5ff
-"))
-  (llm-tools--hl-apply patch))
-
 (provide 'llm-tools-hl)