path: root/llm-tools-hl.el

(defvar llm-tools--hl-bigrams
  (list "aa" "ab" "ac" "ad" "ae" "af" "ag" "ah" "ai" "aj" "ak" "al" "am" "an"
	"ao" "ap" "aq" "ar" "as" "at" "au" "av" "aw" "ax" "ay" "az" "ba" "bb"
	"bc" "bd" "be" "bf" "bg" "bh" "bi" "bj" "bk" "bl" "bm" "bn" "bo" "bp"
	"br" "bs" "bt" "bu" "bv" "bw" "bx" "by" "bz" "ca" "cb" "cc" "cd" "ce"
	"cf" "cg" "ch" "ci" "cj" "ck" "cl" "cm" "cn" "co" "cp" "cq" "cr" "cs"
	"ct" "cu" "cv" "cw" "cx" "cy" "cz" "da" "db" "dc" "dd" "de" "df" "dg"
	"dh" "di" "dj" "dk" "dl" "dm" "dn" "do" "dp" "dq" "dr" "ds" "dt" "du"
	"dv" "dw" "dx" "dy" "dz" "ea" "eb" "ec" "ed" "ee" "ef" "eg" "eh" "ei"
	"ej" "ek" "el" "em" "en" "eo" "ep" "eq" "er" "es" "et" "eu" "ev" "ew"
	"ex" "ey" "ez" "fa" "fb" "fc" "fd" "fe" "ff" "fg" "fh" "fi" "fj" "fk"
	"fl" "fm" "fn" "fo" "fp" "fq" "fr" "fs" "ft" "fu" "fv" "fw" "fx" "fy"
	"fz" "ga" "gb" "gc" "gd" "ge" "gf" "gg" "gh" "gi" "gj" "gl" "gm" "gn"
	"go" "gp" "gr" "gs" "gt" "gu" "gv" "gw" "gx" "gy" "gz" "ha" "hb" "hc"
	"hd" "he" "hf" "hg" "hh" "hi" "hj" "hk" "hl" "hm" "hn" "ho" "hp" "hq"
	"hr" "hs" "ht" "hu" "hv" "hw" "hx" "hy" "hz" "ia" "ib" "ic" "id" "ie"
	"if" "ig" "ih" "ii" "ij" "ik" "il" "im" "in" "io" "ip" "iq" "ir" "is"
	"it" "iu" "iv" "iw" "ix" "iy" "iz" "ja" "jb" "jc" "jd" "je" "jf" "jg"
	"jh" "ji" "jj" "jk" "jl" "jm" "jn" "jo" "jp" "jq" "jr" "js" "jt" "ju"
	"jw" "jx" "jy" "ka" "kb" "kc" "kd" "ke" "kf" "kg" "kh" "ki" "kj" "kk"
	"kl" "km" "kn" "ko" "kp" "kr" "ks" "kt" "ku" "kv" "kw" "kx" "ky" "la"
	"lb" "lc" "ld" "le" "lf" "lg" "lh" "li" "lj" "lk" "ll" "lm" "ln" "lo"
	"lp" "lr" "ls" "lt" "lu" "lv" "lw" "lx" "ly" "lz" "ma" "mb" "mc" "md"
	"me" "mf" "mg" "mh" "mi" "mj" "mk" "ml" "mm" "mn" "mo" "mp" "mq" "mr"
	"ms" "mt" "mu" "mv" "mw" "mx" "my" "mz" "na" "nb" "nc" "nd" "ne" "nf"
	"ng" "nh" "ni" "nj" "nk" "nl" "nm" "nn" "no" "np" "nr" "ns" "nt" "nu"
	"nv" "nw" "nx" "ny" "nz" "oa" "ob" "oc" "od" "oe" "of" "og" "oh" "oi"
	"oj" "ok" "ol" "om" "on" "oo" "op" "oq" "or" "os" "ot" "ou" "ov" "ow"
	"ox" "oy" "oz" "pa" "pb" "pc" "pd" "pe" "pf" "pg" "ph" "pi" "pj" "pk"
	"pl" "pm" "pn" "po" "pp" "pq" "pr" "ps" "pt" "pu" "pv" "pw" "px" "py"
	"pz" "qa" "qb" "qc" "qd" "qe" "qh" "qi" "ql" "qm" "qn" "qo" "qp" "qq"
	"qr" "qs" "qt" "qu" "qw" "qx" "qy" "ra" "rb" "rc" "rd" "re" "rf" "rg"
	"rh" "ri" "rk" "rl" "rm" "rn" "ro" "rp" "rq" "rr" "rs" "rt" "ru" "rv"
	"rw" "rx" "ry" "rz" "sa" "sb" "sc" "sd" "se" "sf" "sg" "sh" "si" "sj"
	"sk" "sl" "sm" "sn" "so" "sp" "sq" "sr" "ss" "st" "su" "sv" "sw" "sx"
	"sy" "sz" "ta" "tb" "tc" "td" "te" "tf" "tg" "th" "ti" "tj" "tk" "tl"
	"tm" "tn" "to" "tp" "tr" "ts" "tt" "tu" "tv" "tw" "tx" "ty" "tz" "ua"
	"ub" "uc" "ud" "ue" "uf" "ug" "uh" "ui" "uj" "uk" "ul" "um" "un" "uo"
	"up" "uq" "ur" "us" "ut" "uu" "uv" "uw" "ux" "uy" "uz" "va" "vb" "vc"
	"vd" "ve" "vf" "vg" "vh" "vi" "vj" "vk" "vl" "vm" "vn" "vo" "vp" "vq"
	"vr" "vs" "vt" "vu" "vv" "vw" "vx" "vy" "vz" "wa" "wb" "wc" "wd" "we"
	"wf" "wg" "wh" "wi" "wj" "wk" "wl" "wm" "wn" "wo" "wp" "wr" "ws" "wt"
	"wu" "wv" "ww" "wx" "wy" "xa" "xb" "xc" "xd" "xe" "xf" "xh" "xi" "xl"
	"xm" "xn" "xo" "xp" "xr" "xs" "xt" "xu" "xx" "xy" "xz" "ya" "yb" "yc"
	"yd" "ye" "yf" "yg" "yh" "yi" "yj" "yk" "yl" "ym" "yn" "yo" "yp" "yr"
	"ys" "yt" "yu" "yv" "yw" "yx" "yy" "yz" "za" "zb" "zc" "zd" "ze" "zf"
	"zg" "zh" "zi" "zk" "zl" "zm" "zn" "zo" "zp" "zr" "zs" "zt" "zu" "zw"
	"zx" "zy" "zz")
  "List of bigrams for use with hashline reads/writes.

Each of the bigrams resolve to a single token in standard LLM
vocabulary, unlike a hash's hex digits.

Taken from https://github.com/can1357/oh-my-pi.
Precisely: https://raw.githubusercontent.com/can1357/oh-my-pi/85003ca/packages/coding-agent/src/hashline/bigrams.json")

(defun llm-tools--hl-hash (line)
  ;; logand is to force unsigned number
  (elt llm-tools--hl-bigrams (% (logand (sxhash line) #xffffffff) 647)))

(defun llm-tools--hl-file-lines (file &optional beg end)
  "Return FILE contents as a list of strings.
With optional BEG and END (inclusive, 1-based), return the lines between that range."
  (with-temp-buffer
    (insert-file-contents-literally file)
    (let ((lines (string-lines (buffer-string))))
      (if beg
	  (cl-subseq lines (1- beg) end)
	lines))))

(defun llm-tools--hl-format-lines (lines &optional start include-content?)
  "Format LINES in hashline format.
START is 1-based (default 1).
If INCLUDE-CONTENT is non-nil, append `|LINE' after each hash."
  (string-join
   (cl-mapcar (lambda (line i)
		(if include-content?
		    (format "%d%2s|%s" i (llm-tools--hl-hash line) line)
		  (format "%d%2s" i (llm-tools--hl-hash line))))
	      lines
	      (number-sequence (or start 1) (+ (or start 1) (1- (length lines)))))
   "\n"))

(defun llm-tools--hl-file-read (file)
  "Return FILE contents in hashline format."
  (llm-tools--hl-format-lines (llm-tools--hl-file-lines file) nil t))

(defun llm-tools--hl-file-read-range (file beg end)
  "Return FILE contents in hashline format from lines BEG to END."
  (llm-tools--hl-format-lines (llm-tools--hl-file-lines file beg end) beg t))

(defun llm-tools--hl-file-read-hashes (file)
  "Return FILE contents as a list of hashline strings without line content.
Each element is a line number and two-character hash, like `1vx'."
  (string-lines (llm-tools--hl-format-lines (llm-tools--hl-file-lines file))))

(defun llm-tools--hl-file-line-hash (file n)
  "Return the hash of the Nth line in FILE."
  (let* ((lines (llm-tools--hl-file-lines file))
	 (bigram (llm-tools--hl-hash (elt lines (1- n)))))
    (format "%d%s" n bigram)))

;;;; 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-non-empty-non-comment-line-p (line)
  "Return t if LINE is not empty and not a comment (starts with #)."
  (let ((trimmed (string-trim line)))
    (and (not (string-empty-p trimmed))
         (not (string-prefix-p "#" trimmed)))))

(defun llm-tools--hl-parse-op-line-for-verify (line)
  "Parse a single operation LINE (e.g. \"+ 4ei\") into a `hl-verify-op`."
  (let* ((trimmed (string-trim line))
         (ch (substring trimmed 0 1)))
    (make-hl-verify-op
     :type (pcase ch
             ("+" 'insert-after)
             ("<" 'insert-before)
             ("-" 'delete)
             ("=" 'replace))
     :anchor (string-trim (substring trimmed 1))
     :raw trimmed)))

(defun llm-tools--hl-add-payload-to-verify-op (op payload-line)
  "Append PAYLOAD-LINE (without leading ~) to OP's payload list."
  (setf (hl-verify-op-payload op)
        (append (hl-verify-op-payload op) (list (substring (string-trim payload-line) 1)))))

(defun llm-tools--hl-parse-section-ops (section-body)
  "Parse SECTION-BODY into a list of `hl-verify-op' structs."
  (let (ops op)
    (dolist (line (string-lines section-body))
      (when (llm-tools--hl-non-empty-non-comment-line-p line)
        (let* ((trimmed (string-trim line))
               (ch (substring trimmed 0 1)))
          (if (string= ch "~")
              (when op (llm-tools--hl-add-payload-to-verify-op op trimmed))
            (when op (push op ops))
            (setq op (llm-tools--hl-parse-op-line-for-verify trimmed))))))
    (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))
                 (null (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")))
             (if (or (< (length anchor) 3)
                     (not (string-match-p "^[0-9]" anchor)))
                 (push (format "Invalid anchor %S (expected LINEHASH like '5ff' or EOF/BOF)" anchor)
                       errors))))
          ((or 'delete 'replace)
           (let ((parts (split-string anchor "\\.\\.")))
             (if (not (= (length parts) 2))
                 (push (format "Invalid range %S (expected A..B)" anchor) errors)
               (dolist (part parts)
                 (when (or (< (length part) 3)
                           (not (string-match-p "^[0-9]" part)))
                   (push (format "Invalid anchor %S in range (expected numeric line anchor like '5ff')" part)
                         errors))))))))
      errors)
    (nreverse 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))))
    (let (errors)
      ;; Inserts must have payload
      (dolist (op ops)
        (when (and (memq (hl-verify-op-type op) '(insert-after insert-before))
                   (null (hl-verify-op-payload op)))
          (push (format "Insert operation (%s) has no payload lines following it"
                        (hl-verify-op-type op))
                errors)))
      ;; Deletes must not have payload
      (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)))
      ;; Anchor validation
      (setq errors (append errors (llm-tools--hl-validate-anchors ops)))
      (nreverse errors))))

(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.
Each section starts with '@@ PATH' on the first line; the car is PATH
and the cdr is the remainder of that section."
  (let ((pos (string-match "^@@" patch)))
    (when pos
      (let (sections
            (start pos))
        (while (string-match "\n@@" patch (1+ pos))
          (let ((nl (match-beginning 0)))
            (push (substring patch start (1+ nl)) sections)
            (setq start (1+ nl)))
          (setq pos (match-end 0)))
        (push (substring patch start) sections)
        (mapcar (lambda (sec)
                  (let ((end (string-match "\n" sec)))
                    (cons (substring sec 3 end)
                          (substring sec end))))
                (nreverse sections))))))

(defun llm-tools--hl-get-anchors (patch)
  "Returns an alist of (FILENAME . ANCHORS) from PATCH.
ANCHORS is a sorted, deduplicated list of all line anchors referenced by
the operations in that file's sections.  Each anchor is a string like
\"5ff\" or a list of two strings from a range like
(\"3gv\" \"6be\")."
  (let ((sections (llm-tools--split-patch-sections patch)))
    (delete-dups
     (mapcar (lambda (patch)
	       (cons (car patch)
		     (delete-dups
		      (sort
		       (flatten-list
			(mapcar (lambda (line)
				  (if (length> line 0)
				      (let ((op (char-to-string (elt line 0)))
					    (anchor (substring line 2)))
					(pcase op
					  ((or "+" "<") anchor)
					  ((or "-" "=") (split-string anchor "\\.\\."))))))
				(string-lines (cdr patch))))))))
	     sections))))

(defun llm-tools--hl-verify-anchors (patch)
  "Verify that all anchors in PATCH match the current file contents.
Returns a list of booleans, one per file, indicating whether every
anchor in that file's patch sections still matches the corresponding
line in the on-disk file."
  (let ((patch-anchors (llm-tools--hl-get-anchors patch)))
    (mapcar (lambda (section)
	      (let* ((file (car section))
		     (anchors (delete "BOF" (delete "EOF" (cdr section))))
		     (hl (llm-tools--hl-file-read-hashes file)))
		;; cl-subsetp uses eql by default which compares by identity and not content
		(cons file (cl-subsetp anchors hl :test #'equal))))
	    patch-anchors)))

(cl-defstruct hl-op
  (type nil)     ; 'insert-after 'insert-before 'delete 'replace
  (anchor nil)	 ; string like "4ei" or "EOF" for +/-/<
  (range nil)	 ; (start . end) strings for - and =
  (payload nil)) ; list of strings (nil is no payload)

(defun llm-tools--hl-anchor-to-line-num (anchor)
  "Extract the line number from ANCHOR like \"5ff\"."
  (string-to-number (substring anchor 0 (- (length anchor) 2))))

(defun llm-tools--hl-parse-op-line (line)
  "Parse a single operation LINE into a `hl-op` struct.
LINE should start with `+`, `<`, `-`, or `=`."
  (pcase (substring line 0 1)
    ("+"
     (make-hl-op :type 'insert-after
                 :anchor (substring line 2)))
    ("<"
     (make-hl-op :type 'insert-before
                 :anchor (substring line 2)))
    ("-"
     (make-hl-op :type 'delete
                 :range (split-string (substring line 2) "\\.\\.")))
    ("="
     (make-hl-op :type 'replace
                 :range (split-string (substring line 2) "\\.\\.")))))

(defun llm-tools--hl-parse-section (section)
  "Parse SECTION (body after `@@ PATH`) into a list of `hl-op` structs.
Skips comment lines (starting with `#`) and blank lines."
  (let (ops op)
    (dolist (line (string-lines section))
      (when (string-match "\\S-" line)
        (let ((op-char (substring line 0 1)))
          (pcase op-char
            ("~"
             (when op
               (setf (hl-op-payload op)
                     (append (hl-op-payload op)
                             (list (substring line 1))))))
            ("#" nil)
            (_
             (when op (push op 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.
Returns an alist of (FILENAME . SECTION-LIST) where SECTION-LIST
contains all (PATH . REST) cons cells from SECTIONS that target
FILENAME."
  (let (grouped)
    (dolist (sec sections)
      (let ((existing (assoc (car sec) grouped)))
        (if existing
            (push sec (cdr existing))
          (push (cons (car sec) (list sec)) grouped))))
    grouped))

(defun llm-tools--hl-apply-insert-after (anchor payload content offset)
  "Insert PAYLOAD after the line identified by ANCHOR (or EOF)."
  (let* ((line-num (if (string= anchor "EOF")
                       (length content)
                     (+ (llm-tools--hl-anchor-to-line-num anchor) offset)))
         (idx (1- line-num)))
    (cons (append (cl-subseq content 0 (1+ idx))
                  payload
                  (cl-subseq content (1+ idx)))
          (+ offset (length payload)))))

(defun llm-tools--hl-apply-insert-before (anchor payload content offset)
  "Insert PAYLOAD before the line identified by ANCHOR (or BOF)."
  (let* ((line-num (if (string= anchor "BOF") 1
                     (+ (llm-tools--hl-anchor-to-line-num anchor) offset)))
         (idx (1- line-num)))
    (cons (append (cl-subseq content 0 idx)
                  payload
                  (cl-subseq content idx))
          (+ offset (length payload)))))

(defun llm-tools--hl-apply-delete (range content offset)
  "Delete lines from (car RANGE) to (cadr RANGE)."
  (let ((a (+ (llm-tools--hl-anchor-to-line-num (car range)) offset))
        (b (+ (llm-tools--hl-anchor-to-line-num (cadr range)) offset)))
    (cons (append (cl-subseq content 0 (1- a))
                  (cl-subseq content b))
          (- offset (- b a 1)))))

(defun llm-tools--hl-apply-replace (range payload content offset)
  "Replace lines from (car RANGE) to (cadr RANGE) with PAYLOAD (nil → '(\"\"))"
  (let ((a (+ (llm-tools--hl-anchor-to-line-num (car range)) offset))
        (b (+ (llm-tools--hl-anchor-to-line-num (cadr range)) offset))
        (payload (or payload '(""))))
    (cons (append (cl-subseq content 0 (1- a))
                  payload
                  (cl-subseq content b))
          (+ offset (- (length payload) (- b a 1))))))

(defun llm-tools--hl-apply-one-op (op content offset)
  "Apply a single OP to CONTENT (list of strings) at the given OFFSET.
Returns a cons cell (NEW-CONTENT . NEW-OFFSET)."
  (pcase (hl-op-type op)
    ('insert-after (llm-tools--hl-apply-insert-after
		    (hl-op-anchor op)
		    (hl-op-payload op)
		    content offset))
    ('insert-before (llm-tools--hl-apply-insert-before
		     (hl-op-anchor op)
		     (hl-op-payload op)
		     content
		     offset))
    ('delete (llm-tools--hl-apply-delete
	      (hl-op-range op)
	      content
	      offset))
    ('replace (llm-tools--hl-apply-replace
	       (hl-op-range op)
	       (hl-op-payload op)
	       content
	       offset))))

(defun llm-tools--hl-apply-ops (ops content)
  "Apply a list of OPS to CONTENT (list of strings).
Returns the modified list of strings."
  (let ((offset 0))
    (dolist (op ops content)
      (let ((result (llm-tools--hl-apply-one-op op content offset)))
        (setq content (car result))
        (setq offset (cdr result))))))

(defun llm-tools--hl-apply (patch)
  "Apply all operations in PATCH to their respective files.
Operations within a file are applied sequentially, with line numbers
adjusted for prior insertions/deletions via a running offset."
  (dolist (file-group (llm-tools--hl-group-by-file
                       (llm-tools--split-patch-sections patch)))
    (let* ((file (car file-group))
           (ops (mapcan (lambda (sec)
                          (llm-tools--hl-parse-section (cdr sec)))
                        (cdr file-group)))
           (content (llm-tools--hl-apply-ops
                     ops
                     (llm-tools--hl-file-lines file))))
      (with-temp-buffer
        (insert (string-join content "\n"))
        (write-region (point-min) (point-max) file)))))

(defun llm-tools--hl-edit (patch)
  "Apply a hashline PATCH to the files it references.

PATCH is a string containing one or more sections, each starting with
`@@ FILEPATH' followed by operations:
  + ANCHOR    Insert lines after ANCHOR (or `EOF' to append)
  < ANCHOR    Insert lines before ANCHOR (or `BOF' to prepend)
  - A..B      Delete lines from A to B
  = A..B      Replace lines from A to B with the following payload
  ~TEXT       Payload line for the preceding operation

ANCHOR is a hashline string like `5ff' (line number + 2-char hash) or
`BOF' / `EOF'. Lines are written directly to disk.

Before applying, verifies that every anchor in PATCH still matches the
current file contents. If any file has drifted, the entire operation is
aborted and an error message is returned identifying the affected files.

Returns a success message if all operations applied, or an error string
if verification failed."
  (let ((msg (llm-tools--hl-verify patch)))
    (if (string= msg "")
	(progn
	  (llm-tools--hl-apply patch)
	  (format "Finished applying patch."))
      (format "%s" msg))))

(provide 'llm-tools-hl)