cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Clean up some time logging code

Browse source
This commit is contained in:
Christopher Baines 2020-02-24 22:03:09 +00:00
parent 2f41fe79be
commit 30dd62f000
2 changed files with 39 additions and 59 deletions
Download patch file Download diff file Expand all files Collapse all files

61
guix-data-service/model/package-derivation-by-guix-revision-range.scm
View file

@ -19,18 +19,10 @@
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (squee) #:use-module (squee)
#:use-module (guix-data-service database) #:use-module (guix-data-service database)
#:use-module (guix-data-service utils)
#:export (update-package-derivations-table #:export (update-package-derivations-table
rebuild-package-derivations-table)) rebuild-package-derivations-table))
(define (log-time action f)
(simple-format #t "debug: Starting ~A\n" action)
(let* ((start-time (current-time))
(result (f))
(time-taken (- (current-time) start-time)))
(simple-format #t "debug: Finished ~A, took ~A seconds\n"
action time-taken)
result))
(define (delete-guix-revision-package-derivation-entries conn (define (delete-guix-revision-package-derivation-entries conn
git-repository-id git-repository-id
guix-revision-id guix-revision-id
@ -128,21 +120,21 @@ LOCK TABLE ONLY package_derivations_by_guix_revision_range
(for-each (for-each
(match-lambda (match-lambda
((branch-name) ((branch-name)
(log-time (with-time-logging
(simple-format #f "deleting package derivation entries for ~A" branch-name) (simple-format #f "deleting package derivation entries for ~A"
(lambda () branch-name)
(delete-guix-revision-package-derivation-entries conn (delete-guix-revision-package-derivation-entries conn
git-repository-id git-repository-id
guix-revision-id guix-revision-id
branch-name))) branch-name))
(log-time (with-time-logging
(simple-format #f "inserting package derivation entries for ~A" branch-name) (simple-format #f "inserting package derivation entries for ~A"
(lambda () branch-name)
(insert-guix-revision-package-derivation-entries (insert-guix-revision-package-derivation-entries
conn conn
git-repository-id git-repository-id
branch-name branch-name
#:guix-revision-id guix-revision-id))))) #:guix-revision-id guix-revision-id))))
(exec-query (exec-query
conn conn
"SELECT name FROM git_branches WHERE commit = $1 AND git_repository_id = $2" "SELECT name FROM git_branches WHERE commit = $1 AND git_repository_id = $2"
@ -162,10 +154,9 @@ LOCK TABLE ONLY package_derivations_by_guix_revision_range
LOCK TABLE ONLY package_derivations_by_guix_revision_range LOCK TABLE ONLY package_derivations_by_guix_revision_range
IN SHARE ROW EXCLUSIVE MODE") IN SHARE ROW EXCLUSIVE MODE")
(log-time (with-time-logging
(simple-format #f "deleting all package derivation entries") (simple-format #f "deleting all package derivation entries")
(lambda () (exec-query conn "DELETE FROM package_derivations_by_guix_revision_range"))
(exec-query conn "DELETE FROM package_derivations_by_guix_revision_range")))
(let ((git-branches-and-repository-ids (let ((git-branches-and-repository-ids
(exec-query (exec-query
@ -174,11 +165,11 @@ LOCK TABLE ONLY package_derivations_by_guix_revision_range
(for-each (for-each
(match-lambda (match-lambda
((branch-name git-repository-id) ((branch-name git-repository-id)
(log-time (with-time-logging
(simple-format #f "inserting package derivation entries for ~A" branch-name) (simple-format #f "inserting package derivation entries for ~A"
(lambda () branch-name)
(insert-guix-revision-package-derivation-entries (insert-guix-revision-package-derivation-entries
conn conn
git-repository-id git-repository-id
branch-name))))) branch-name))))
git-branches-and-repository-ids))))) git-branches-and-repository-ids)))))

37
guix-data-service/model/utils.scm
View file

@ -22,6 +22,7 @@
#:use-module (ice-9 receive) #:use-module (ice-9 receive)
#:use-module (squee) #:use-module (squee)
#:use-module (guix-data-service database) #:use-module (guix-data-service database)
#:use-module (guix-data-service utils)
#:export (NULL #:export (NULL
quote-string quote-string
value->quoted-string-or-null value->quoted-string-or-null
@ -248,15 +249,6 @@
(error (simple-format #f "normalise-values: error: ~A\n" unknown)))) (error (simple-format #f "normalise-values: error: ~A\n" unknown))))
data)) data))
(define (log-time action f)
(simple-format #t "debug: Starting ~A\n" action)
(let* ((start-time (current-time))
(result (f))
(time-taken (- (current-time) start-time)))
(simple-format #t "debug: Finished ~A, took ~A seconds\n"
action time-taken)
result))
(let* ((existing-entries (let* ((existing-entries
(if use-temporary-table? (if use-temporary-table?
(let ((temp-table-name (let ((temp-table-name
@ -281,23 +273,20 @@
"ANALYZE " temp-table-name)) "ANALYZE " temp-table-name))
;; Populate the temporary table ;; Populate the temporary table
(log-time (with-time-logging (string-append "populating " temp-table-name)
(string-append "populating " temp-table-name) (exec-query conn
(lambda () (insert-sql data
(exec-query conn #:table-name temp-table-name)))
(insert-sql data
#:table-name temp-table-name))))
;; Use the temporary table to find the existing values ;; Use the temporary table to find the existing values
(let ((result (let ((result
(log-time (with-time-logging
(string-append "querying the " temp-table-name) (string-append "querying the " temp-table-name)
(lambda () (exec-query->vhash
(exec-query->vhash conn
conn (temp-table-select-query temp-table-name)
(temp-table-select-query temp-table-name) cdr
cdr (lambda (result)
(lambda (result) (string->number (first result)))))))
(string->number (first result))))))))
(exec-query conn (string-append "DROP TABLE " temp-table-name)) (exec-query conn (string-append "DROP TABLE " temp-table-name))
result)) result))