2019-05-05 14:35:48 +02:00
|
|
|
(define-module (guix-data-service model git-repository)
|
|
|
|
#:use-module (ice-9 match)
|
2019-06-20 00:12:20 +02:00
|
|
|
#:use-module (json)
|
2019-05-05 14:35:48 +02:00
|
|
|
#:use-module (squee)
|
|
|
|
#:export (all-git-repositories
|
2019-07-19 22:22:15 +02:00
|
|
|
select-git-repository
|
2019-05-05 14:35:48 +02:00
|
|
|
git-repository-id->url
|
|
|
|
git-repository-url->git-repository-id
|
2019-05-13 22:02:53 +02:00
|
|
|
git-repositories-containing-commit
|
2019-05-05 14:35:48 +02:00
|
|
|
|
|
|
|
guix-revisions-and-jobs-for-git-repository))
|
|
|
|
|
|
|
|
(define (all-git-repositories conn)
|
2019-09-05 16:40:39 +02:00
|
|
|
(map
|
|
|
|
(match-lambda
|
|
|
|
((id label url cgit-base-url)
|
|
|
|
(list (string->number id)
|
|
|
|
label
|
|
|
|
url
|
|
|
|
cgit-base-url)))
|
|
|
|
(exec-query
|
|
|
|
conn
|
|
|
|
(string-append
|
|
|
|
"SELECT id, label, url, cgit_url_base FROM git_repositories ORDER BY id ASC"))))
|
2019-05-05 14:35:48 +02:00
|
|
|
|
2019-07-19 22:22:15 +02:00
|
|
|
(define (select-git-repository conn id)
|
|
|
|
(match (exec-query
|
|
|
|
conn
|
|
|
|
"SELECT label, url, cgit_url_base FROM git_repositories WHERE id = $1"
|
|
|
|
(list id))
|
|
|
|
(()
|
|
|
|
#f)
|
|
|
|
((result)
|
|
|
|
result)))
|
|
|
|
|
2019-05-05 14:35:48 +02:00
|
|
|
(define (git-repository-id->url conn id)
|
|
|
|
(match
|
|
|
|
(exec-query
|
|
|
|
conn
|
|
|
|
(string-append
|
|
|
|
"SELECT url FROM git_repositories WHERE id = $1;")
|
|
|
|
(list id))
|
|
|
|
(((url)) url)))
|
|
|
|
|
|
|
|
(define (git-repository-url->git-repository-id conn url)
|
|
|
|
(let ((existing-id
|
|
|
|
(exec-query
|
|
|
|
conn
|
|
|
|
(string-append
|
|
|
|
"SELECT id FROM git_repositories WHERE url = '" url "'"))))
|
2019-09-04 19:24:22 +02:00
|
|
|
(string->number
|
|
|
|
(match existing-id
|
|
|
|
(((id)) id)
|
|
|
|
(()
|
|
|
|
(caar
|
|
|
|
(exec-query conn
|
|
|
|
(string-append
|
|
|
|
"INSERT INTO git_repositories "
|
|
|
|
"(url) "
|
|
|
|
"VALUES "
|
|
|
|
"('" url "') "
|
|
|
|
"RETURNING id"))))))))
|
2019-05-05 14:35:48 +02:00
|
|
|
|
|
|
|
(define (guix-revisions-and-jobs-for-git-repository conn git-repository-id)
|
|
|
|
(define query
|
|
|
|
"
|
2019-06-20 00:12:20 +02:00
|
|
|
SELECT NULL AS id, load_new_guix_revision_jobs.id AS job_id,
|
|
|
|
(
|
|
|
|
SELECT json_agg(event)
|
|
|
|
FROM load_new_guix_revision_job_events
|
|
|
|
WHERE load_new_guix_revision_jobs.id = load_new_guix_revision_job_events.job_id
|
|
|
|
) AS job_events, commit, source
|
2019-05-05 14:35:48 +02:00
|
|
|
FROM load_new_guix_revision_jobs
|
2019-06-13 20:19:04 +02:00
|
|
|
WHERE git_repository_id = $1 AND succeeded_at IS NULL AND NOT EXISTS (
|
|
|
|
SELECT 1 FROM load_new_guix_revision_job_events
|
|
|
|
WHERE event = 'failure' AND job_id = load_new_guix_revision_jobs.id
|
|
|
|
)
|
2019-06-20 00:12:20 +02:00
|
|
|
UNION ALL
|
|
|
|
SELECT id, NULL, NULL, commit, NULL
|
2019-05-05 14:35:48 +02:00
|
|
|
FROM guix_revisions
|
|
|
|
WHERE git_repository_id = $1
|
|
|
|
ORDER BY 1 DESC NULLS FIRST, 2 DESC LIMIT 10;")
|
|
|
|
|
2019-06-20 00:12:20 +02:00
|
|
|
(map
|
|
|
|
(match-lambda
|
|
|
|
((id job_id job_events commit source)
|
|
|
|
(list id
|
|
|
|
job_id
|
|
|
|
(if (string=? "" job_events)
|
|
|
|
'()
|
|
|
|
(vector->list (json-string->scm job_events)))
|
|
|
|
commit source)))
|
|
|
|
(exec-query
|
|
|
|
conn
|
|
|
|
query
|
|
|
|
(list git-repository-id))))
|
2019-05-13 22:02:53 +02:00
|
|
|
|
|
|
|
(define (git-repositories-containing-commit conn commit)
|
|
|
|
(define query
|
|
|
|
"
|
|
|
|
SELECT id, label, url, cgit_url_base
|
|
|
|
FROM git_repositories WHERE id IN (
|
|
|
|
SELECT git_repository_id
|
|
|
|
FROM git_branches
|
|
|
|
WHERE commit = $1
|
|
|
|
)")
|
|
|
|
|
|
|
|
(exec-query conn query (list commit)))
|