diff options
Diffstat (limited to 'guix-data-service/model/derivation.scm')
| -rw-r--r-- | guix-data-service/model/derivation.scm | 83 |
1 files changed, 83 insertions, 0 deletions
diff --git a/guix-data-service/model/derivation.scm b/guix-data-service/model/derivation.scm index 3d96fee..5b950e3 100644 --- a/guix-data-service/model/derivation.scm +++ b/guix-data-service/model/derivation.scm @@ -24,6 +24,7 @@ fix-derivation-output-details-hash-encoding select-derivations-by-revision-name-and-version select-derivation-inputs-by-derivation-id + select-serialized-derivation-by-file-name select-existing-derivations select-derivations-by-id select-derivations-and-build-status @@ -699,6 +700,88 @@ WHERE store_path = $1") (map car (exec-query conn query (list store-path)))) +(define (select-serialized-derivation-by-file-name conn derivation-file-name) + (define (double-quote s) + (string-append + "\"" s "\"")) + + (define (round-brackets-list items) + (string-append + "(" + (string-join items ",") + ")")) + + (define (square-brackets-list items) + (string-append + "[" + (string-join items ",") + "]")) + + (let ((derivation (select-derivation-by-file-name conn + derivation-file-name))) + (if derivation + (let ((derivation-inputs (select-derivation-inputs-by-derivation-id + conn + (first derivation))) + (derivation-outputs (select-derivation-outputs-by-derivation-id + conn + (first derivation))) + (derivation-sources (select-derivation-sources-by-derivation-id + conn + (first derivation)))) + (string-append + "Derive" + (round-brackets-list + `(;; Outputs + ,(square-brackets-list + (map (match-lambda + ((output-name path hash-algorithm hash recursive?) + (round-brackets-list + (list + (double-quote output-name) + (double-quote path) + (double-quote + (string-append + (if recursive? "r:" "") + hash-algorithm)) + (double-quote hash))))) + derivation-outputs)) + ;; Inputs + ,(square-brackets-list + (map (match-lambda + ((file-name outputs) + (round-brackets-list + (list + (double-quote file-name) + (square-brackets-list + (map (lambda (output) + (double-quote + (assoc-ref output "output_name"))) + (vector->list outputs))))))) + derivation-inputs)) + ;; Sources + ,(square-brackets-list + (map double-quote derivation-sources)) + ;; Other parts + ,@(match derivation + ((id file-name builder args env-vars system) + (list + (double-quote system) + (double-quote builder) + (square-brackets-list + (map double-quote args)) + (square-brackets-list + (map (lambda (env-var) + (round-brackets-list + (list (with-output-to-string + (lambda () + (write (assq-ref env-var 'key)))) + (with-output-to-string + (lambda () + (write (assq-ref env-var 'value))))))) + env-vars))))))))) + #f))) + (define (insert-derivation-inputs conn derivation-id derivation-inputs) (define (insert-into-derivation-inputs output-ids) (string-append "INSERT INTO derivation_inputs " |