(zilch lib rewrite): introduce bytevector/string rewrite helper

Change-Id: I6a6a69645a253c8bc0cfd0919c280c20a6404c1e

core/src/lib/rewrite.sld

@@ -0,0 +1,65 @@
+;; 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)))))