;; Helper utilities to replace a list of bytevectors in a string.
;; Used for e.g. resolving placeholders, or swapping out store paths.
(define-library (zilch lib rewrite)
 (import (scheme base) (srfi 207))

 (export rewrite-bytevector-or-string)

 (begin
  ;; Rewrites a bytevector.
  ;; `with-rewrites` is a list of `(from . to)` bytevector pairs.
  ;; All `from` values are assumed to start with a forward slash.
  (define (rewrite-bytevector str with-rewrites)
   (define parts '())
   (define shortest-rewrite #f)
   (define longest-rewrite #f)
   (for-each
    (lambda (kv)
     (define len (bytevector-length (car kv)))
     (unless (and shortest-rewrite (> shortest-rewrite len)) (set! shortest-rewrite len))
     (unless (and longest-rewrite (< longest-rewrite len)) (set! longest-rewrite len)))
    with-rewrites)
   (define (matches i key)
     (define key-len (bytevector-length key))
     (if (> i (- (bytevector-length str) key-len))
      #f
      (let loop ((j 0))
        (cond
         ((>= j key-len) #t)
         ((= (bytevector-u8-ref key j) (bytevector-u8-ref str (+ i j))) (loop (+ 1 j)))
         (else #f)))))
   (define (find-match-at i)
    (let loop ((l with-rewrites))
     (cond
      ((null? l) #f)
      ((matches i (caar l)) (car l))
      (else (loop (cdr l))))))
   (when shortest-rewrite
    (let find-part ((i 0) (last-i 0))
     (let ((next-slash (bytestring-index str (lambda (c) (= c #x2F)) i)))
      (if (or (not next-slash) (> next-slash (- (bytevector-length str) shortest-rewrite)))
       (if (= last-i 0)
        (set! parts #f)
        (set! parts (cons (bytevector-copy str last-i) parts)))
       (let ((mapping-pair (find-match-at next-slash)))
        (if mapping-pair
         (let* ((len (bytevector-length (car mapping-pair)))
                (next-start (+ next-slash len)))
           (set! parts (cons (cdr mapping-pair) (cons (bytevector-copy str last-i next-slash) parts)))
           (find-part next-start next-start))
         (find-part (+ next-slash 1) last-i)))))))
   (if (pair? parts)
    (apply bytevector-append (reverse parts))
    #f))

  ;; Rewrites a bytevector or string.
  ;; `with-rewrites` is a list of `(from . to)` bytevector pairs.
  ;; All `from` values are assumed to start with a forward slash.
  (define (rewrite-bytevector-or-string str with-rewrites)
   (define result
    (if (string? str)
      (rewrite-bytevector (string->utf8 str) with-rewrites)
      (rewrite-bytevector str with-rewrites)))
   (if (and (string? str) result)
     (utf8->string result)
     (or result str)))))