diff options
| -rw-r--r-- | nar-herder/storage.scm | 46 |
1 files changed, 22 insertions, 24 deletions
diff --git a/nar-herder/storage.scm b/nar-herder/storage.scm index 4c1a9df..5a9a2f6 100644 --- a/nar-herder/storage.scm +++ b/nar-herder/storage.scm @@ -70,30 +70,28 @@ (define (index-storage database storage-root) (define (get-files-hash) - (define (get-file-strings prefix children) - (append-map - (match-lambda - ((name stat) - (list (string-append prefix "/" name))) - ((name stat children ...) - (get-file-strings (string-append prefix "/" name) - children))) - children)) - - (let* ((lst - (match (file-system-tree storage-root) - ((_ _ (name stat children ...)) - (get-file-strings (string-append "/" name) - children)) - ((_ _) '()))) ; empty directory - (hash-table - (make-hash-table (length lst)))) - - (for-each (lambda (s) - (hash-set! hash-table s #t)) - lst) - - hash-table)) + (define storage-root-length + (string-length storage-root)) + + (define enter? (const #t)) + (define (leaf name stat result) + (hash-set! result + (peek (string-drop name storage-root-length)) + #t) + result) + + (define (down name stat result) result) + (define (up name stat result) result) + (define (skip name stat result) result) + + (define (error name stat errno result) + (format (current-error-port) "warning: ~a: ~a~%" + name (strerror errno)) + result) + + (file-system-fold enter? leaf down up skip error + (make-hash-table (expt 2 19)) + storage-root)) (let* ((files-hash (get-files-hash)) |