perf: linear-time pagination accumulation and attachment rewriting
ober
baa63cf7ce91f6ed20a6b7747e5d8f3e17411e23
--- a/lib/jgl/client.ss +++ b/lib/jgl/client.ss @@ -308,9 +308,9 @@ [data (gl-get c p)] [items (if (list? data) data '())] [n (length items)] - [acc* (append acc items)]) + [acc* (append (reverse items) acc)]) (if (or (= n 0) (< n per-page) (>= page 1000)) - acc* + (reverse acc*) (loop (+ page 1) acc*)))))) (def (download-content c url) --- a/lib/jgl/issues.ss +++ b/lib/jgl/issues.ss @@ -143,7 +143,8 @@ ;; Collect distinct "/uploads/..." paths referenced in `text`. (def (extract-upload-paths text) - (let ([n (string-length text)] [needle "/uploads/"]) + (let ([n (string-length text)] [needle "/uploads/"] + [seen (make-hashtable string-hash string=?)]) (let loop ([i 0] [acc '()]) (cond [(>= i n) (reverse acc)] @@ -151,19 +152,31 @@ (let scan ([j i]) (if (or (>= j n) (terminator? (string-ref text j))) (let ([p (substring text i j)]) - (loop j (if (member p acc) acc (cons p acc)))) + (if (hashtable-ref seen p #f) + (loop j acc) + (begin (hashtable-set! seen p #t) + (loop j (cons p acc))))) (scan (+ j 1))))] [else (loop (+ i 1) acc)])))) - (def (replace-all text old new) - (let ([no (string-length old)] [n (string-length text)] [out (open-output-string)]) - (if (= no 0) - text - (let loop ([i 0]) - (cond - [(>= i n) (get-output-string out)] - [(match-at? text i old) (display new out) (loop (+ i no))] - [else (write-char (string-ref text i) out) (loop (+ i 1))]))))) + ;; Replace every (old . new) pair in `repls` in a single scan of `text`, + ;; building the output once instead of re-scanning per replacement. Keys are + ;; non-empty "/uploads/..." paths, so a match always advances the cursor. + (def (replace-all-multi text repls) + (let ([n (string-length text)] [out (open-output-string)]) + (let loop ([i 0]) + (cond + [(>= i n) (get-output-string out)] + [else + (let scan ([rs repls]) + (cond + [(null? rs) + (write-char (string-ref text i) out) + (loop (+ i 1))] + [(match-at? text i (caar rs)) + (display (cdar rs) out) + (loop (+ i (string-length (caar rs))))] + [else (scan (cdr rs))]))])))) ;; Download referenced uploads into <issue-dir>/attachments and rewrite the ;; markdown to point at them. project-web is "<base>/<project-path>" used to @@ -176,9 +189,9 @@ (dynamic-wind (lambda () (void)) (lambda () - (let loop ([us uploads] [text content] [index 1]) + (let loop ([us uploads] [repls '()] [index 1]) (if (null? us) - text + (replace-all-multi content (reverse repls)) (let* ([up (car us)] [fname (string-append (number->string index) @@ -189,8 +202,8 @@ (gl-download-at c url attach-fd fname))]) (loop (cdr us) (if ok - (replace-all text up (string-append "attachments/" fname)) - text) + (cons (cons up (string-append "attachments/" fname)) repls) + repls) (+ index 1)))))) (lambda () (secure-close-fd attach-fd)))))))