diff options
Diffstat (limited to 'guix-data-service')
| -rw-r--r-- | guix-data-service/model/package-metadata.scm | 127 |
1 files changed, 68 insertions, 59 deletions
diff --git a/guix-data-service/model/package-metadata.scm b/guix-data-service/model/package-metadata.scm index 496b920..a2bf286 100644 --- a/guix-data-service/model/package-metadata.scm +++ b/guix-data-service/model/package-metadata.scm @@ -18,6 +18,7 @@ (define-module (guix-data-service model package-metadata) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) + #:use-module (srfi srfi-43) #:use-module (ice-9 vlist) #:use-module (ice-9 match) #:use-module (squee) @@ -275,8 +276,13 @@ WHERE packages.id IN ( (define (inferior-packages->package-metadata-ids conn package-metadata license-set-ids) - (define package-metadata-list - (vector->list package-metadata)) + (define (vector-zip . vecs) + (let ((result (make-vector (vector-length (first vecs))))) + (apply vector-map! + (lambda (i . vals) + (cdr vals)) + (cons result vecs)) + result)) (insert-missing-data-and-return-all-ids conn @@ -287,63 +293,66 @@ WHERE packages.id IN ( package_description_set_id package_synopsis_set_id) - (list->vector - (zip - (map (match-lambda - ((home-page rest ...) - (if (string? home-page) - home-page - NULL))) - package-metadata-list) - (with-time-logging "preparing location ids" - (map (match-lambda - ((_ location rest ...) - (if location - (location->location-id - conn - location) - NULL))) - package-metadata-list)) - (vector->list license-set-ids) - (with-time-logging "preparing package description set ids" - (map (lambda (package-description-ids) - (insert-and-return-id - conn - "package_description_sets" - '(description_ids) - (list (sort package-description-ids <)))) - (with-time-logging "preparing package description ids" - (map (match-lambda - ((_ _ package-description-data _) - (insert-missing-data-and-return-all-ids - conn - "package_descriptions" - '(locale description) - (list->vector - (map (match-lambda - ((locale . description) - (list locale description))) - package-description-data))))) - package-metadata-list)))) - (with-time-logging "preparing package synopsis set ids" - (map (lambda (package-synopsis-ids) - (insert-and-return-id - conn - "package_synopsis_sets" - '(synopsis_ids) - (list (sort package-synopsis-ids <)))) - (map (match-lambda - ((_ _ _ package-synopsis-data) - (insert-missing-data-and-return-all-ids - conn - "package_synopsis" - '(locale synopsis) - (list->vector - (map (match-lambda - ((locale . synopsis) - (list locale synopsis))) - package-synopsis-data))))) - package-metadata-list))))))) + (vector-zip + (vector-map (match-lambda* + ((_ (home-page rest ...)) + (if (string? home-page) + home-page + NULL))) + package-metadata) + (with-time-logging "preparing location ids" + (vector-map (match-lambda* + ((_ (_ location rest ...)) + (if location + (location->location-id + conn + location) + NULL))) + package-metadata)) + license-set-ids + (with-time-logging "preparing package description set ids" + (vector-map (match-lambda* + ((_ (_ _ package-description-data _)) + (let ((package-description-ids + (insert-missing-data-and-return-all-ids + conn + "package_descriptions" + '(locale description) + (let ((vec (list->vector package-description-data))) + (vector-map! + (match-lambda* + ((_ (locale . description)) + (list locale description))) + vec) + vec)))) + (insert-and-return-id + conn + "package_description_sets" + '(description_ids) + (list (sort! package-description-ids <)))))) + package-metadata)) + (with-time-logging "preparing package synopsis set ids" + (vector-map (match-lambda* + ((_ (_ _ _ package-synopsis-data)) + (let ((package-synopsis-ids + (insert-missing-data-and-return-all-ids + conn + "package_synopsis" + '(locale synopsis) + (let ((vec + (list->vector package-synopsis-data))) + (vector-map! + (match-lambda* + ((_ (locale . synopsis)) + (list locale synopsis))) + vec) + vec)))) + (insert-and-return-id + conn + "package_synopsis_sets" + '(synopsis_ids) + (list (sort! package-synopsis-ids <)))))) + package-metadata))))) (define (package-description-and-synopsis-locale-options-guix-revision conn revision-id) |