Christopher Baines
75d5e4b9d5
Flip the inequality and order, as this was picking the first revision after the datetime, rather than the last revision before it, which was the intention, as this should give you the revision on the branch, at the datetime.
99 lines
3 KiB
Scheme
99 lines
3 KiB
Scheme
(define-module (guix-data-service model guix-revision)
|
|
#:use-module (srfi srfi-1)
|
|
#:use-module (srfi srfi-19)
|
|
#:use-module (ice-9 match)
|
|
#:use-module (squee)
|
|
#:export (count-guix-revisions
|
|
most-recent-n-guix-revisions
|
|
commit->revision-id
|
|
insert-guix-revision
|
|
guix-commit-exists?
|
|
guix-revision-exists?
|
|
select-guix-revision-for-branch-and-datetime
|
|
guix-revisions-cgit-url-bases))
|
|
|
|
(define (count-guix-revisions conn)
|
|
(first
|
|
(exec-query
|
|
conn
|
|
"SELECT COUNT(*) FROM guix_revisions")))
|
|
|
|
(define (most-recent-n-guix-revisions conn n)
|
|
(exec-query conn "SELECT * FROM guix_revisions ORDER BY id DESC LIMIT 10"))
|
|
|
|
(define (commit->revision-id conn commit)
|
|
(match (exec-query
|
|
conn "SELECT id FROM guix_revisions WHERE commit = $1 LIMIT 1"
|
|
(list commit))
|
|
(((id))
|
|
id)
|
|
(() #f)))
|
|
|
|
(define (insert-guix-revision conn git-repository-id commit store_path)
|
|
(define insert
|
|
(string-append "INSERT INTO guix_revisions "
|
|
"(git_repository_id, commit, store_path) VALUES "
|
|
"(" git-repository-id ", '"
|
|
commit "', '"
|
|
store_path "') "
|
|
"RETURNING id;"))
|
|
|
|
(match (exec-query conn insert)
|
|
(((id)) id)))
|
|
|
|
(define (guix-commit-exists? conn commit)
|
|
(define query
|
|
"SELECT EXISTS(SELECT 1 FROM guix_revisions WHERE commit = $1)")
|
|
|
|
(let ((result (caar
|
|
(exec-query conn query (list commit)))))
|
|
(string=? result "t")))
|
|
|
|
(define (guix-revision-exists? conn git-repository-id commit)
|
|
(define query
|
|
(string-append "SELECT EXISTS("
|
|
"SELECT 1 FROM guix_revisions WHERE "
|
|
"git_repository_id = '" git-repository-id "' "
|
|
"AND commit = '" commit "')"
|
|
";"))
|
|
|
|
(let ((result (caar
|
|
(exec-query conn query))))
|
|
(string=? result "t")))
|
|
|
|
(define (select-guix-revision-for-branch-and-datetime conn branch datetime)
|
|
(define query
|
|
"
|
|
SELECT guix_revisions.id,
|
|
guix_revisions.commit,
|
|
guix_revisions.store_path,
|
|
guix_revisions.git_repository_id
|
|
FROM guix_revisions
|
|
INNER JOIN git_branches
|
|
ON git_branches.commit = guix_revisions.commit
|
|
AND git_branches.git_repository_id = guix_revisions.git_repository_id
|
|
WHERE git_branches.name = $1 AND git_branches.datetime <= $2
|
|
ORDER BY git_branches.datetime DESC
|
|
LIMIT 1")
|
|
|
|
(car
|
|
(exec-query conn query (list branch
|
|
(date->string datetime "~1 ~3")))))
|
|
|
|
(define (guix-revisions-cgit-url-bases conn guix-revision-ids)
|
|
(map
|
|
car
|
|
(exec-query
|
|
conn
|
|
(simple-format #f "
|
|
SELECT cgit_url_base
|
|
FROM git_repositories
|
|
WHERE cgit_url_base IS NOT NULL AND id IN (
|
|
SELECT git_repository_id
|
|
FROM guix_revisions
|
|
WHERE id IN (VALUES ~A));"
|
|
(string-join
|
|
(map (lambda (id)
|
|
(string-append "(" id ")"))
|
|
guix-revision-ids)
|
|
",")))))
|