diff options
| -rw-r--r-- | guix-data-service/model/derivation.scm | 149 |
1 files changed, 69 insertions, 80 deletions
diff --git a/guix-data-service/model/derivation.scm b/guix-data-service/model/derivation.scm index 02fd175..7023eef 100644 --- a/guix-data-service/model/derivation.scm +++ b/guix-data-service/model/derivation.scm @@ -1806,46 +1806,42 @@ WHERE " criteria ";")) (exec-query conn (select-existing-derivations chunk)))) (chunk! missing-file-names 1000))))) -(define (derivation-file-names->derivation-ids conn derivation-file-names) - (define derivations-count - (vector-length derivation-file-names)) - - (define (insert-source-files-missing-nars derivation-ids) - (define (derivation-ids->next-related-derivation-ids! ids seen-ids) - (delete-duplicates/sort! - (append-map! - (lambda (ids-chunk) - (let ((query - (string-append - " +(define (insert-source-files-missing-nars conn derivation-ids) + (define (derivation-ids->next-related-derivation-ids! ids seen-ids) + (delete-duplicates/sort! + (append-map! + (lambda (ids-chunk) + (let ((query + (string-append + " SELECT derivation_outputs.derivation_id FROM derivation_inputs INNER JOIN derivation_outputs ON derivation_outputs.id = derivation_inputs.derivation_output_id WHERE derivation_inputs.derivation_id IN (" - (string-join (map number->string ids) ",") - ")"))) - - (filter-map - (lambda (row) - (let ((number - (string->number - (car row)))) - (if (hash-ref seen-ids number) - #f - (begin - (hash-set! seen-ids number #t) - - number)))) - (exec-query conn query)))) - (chunk! ids 500)) - < - =)) - - (define (derivation-ids->missing-sources ids) - (define query - (string-append - " + (string-join (map number->string ids) ",") + ")"))) + + (filter-map + (lambda (row) + (let ((number + (string->number + (car row)))) + (if (hash-ref seen-ids number) + #f + (begin + (hash-set! seen-ids number #t) + + number)))) + (exec-query conn query)))) + (chunk! ids 500)) + < + =)) + + (define (derivation-ids->missing-sources ids) + (define query + (string-append + " SELECT derivation_sources.derivation_source_file_id, derivation_source_files.store_path FROM derivation_sources LEFT JOIN derivation_source_file_nars @@ -1855,42 +1851,46 @@ INNER JOIN derivation_source_files ON derivation_sources.derivation_source_file_id = derivation_source_files.id WHERE derivation_sources.derivation_id IN (" - (string-join (map number->string ids) ", ") - ") + (string-join (map number->string ids) ", ") + ") AND derivation_source_file_nars.derivation_source_file_id IS NULL")) - (map (lambda (row) - (list (string->number (first row)) - (second row))) - (exec-query conn query))) - - (let ((seen-ids (make-hash-table))) - (let loop ((next-related-derivation-ids - (derivation-ids->next-related-derivation-ids! - (list-copy derivation-ids) - seen-ids))) - (unless (null? next-related-derivation-ids) - (let ((missing-sources - (append-map! derivation-ids->missing-sources - (chunk next-related-derivation-ids - 10000)))) - - (unless (null? missing-sources) - (with-time-logging - (simple-format #f "inserting ~A missing source files" - (length missing-sources)) - (for-each (match-lambda - ((derivation-source-file-id store-path) - (insert-derivation-source-file-nar - conn - derivation-source-file-id - store-path))) - missing-sources)))) - - (loop - (derivation-ids->next-related-derivation-ids! - next-related-derivation-ids - seen-ids)))))) + (map (lambda (row) + (list (string->number (first row)) + (second row))) + (exec-query conn query))) + + (let ((seen-ids (make-hash-table))) + (let loop ((next-related-derivation-ids + (derivation-ids->next-related-derivation-ids! + (list-copy derivation-ids) + seen-ids))) + (unless (null? next-related-derivation-ids) + (let ((missing-sources + (append-map! derivation-ids->missing-sources + (chunk next-related-derivation-ids + 10000)))) + + (unless (null? missing-sources) + (with-time-logging + (simple-format #f "inserting ~A missing source files" + (length missing-sources)) + (for-each (match-lambda + ((derivation-source-file-id store-path) + (insert-derivation-source-file-nar + conn + derivation-source-file-id + store-path))) + missing-sources)))) + + (loop + (derivation-ids->next-related-derivation-ids! + next-related-derivation-ids + seen-ids)))))) + +(define (derivation-file-names->derivation-ids conn derivation-file-names) + (define derivations-count + (vector-length derivation-file-names)) (if (= 0 derivations-count) #() @@ -1951,17 +1951,6 @@ INNER JOIN derivation_source_files #f)) derivation-file-names))) - (with-time-logging "insert-source-files-missing-nars" - (insert-source-files-missing-nars - ;; TODO Avoid this conversion - (vector-fold - (lambda (_ result x) - (if x - (cons x result) - result)) - '() - all-ids))) - all-ids))))) (define (update-derivation-inputs-statistics conn) |