2019-12-26 11:16:55 +01:00
|
|
|
;;; Guix Data Service -- Information about Guix over time
|
|
|
|
;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
|
|
|
|
;;;
|
|
|
|
;;; This program is free software: you can redistribute it and/or
|
|
|
|
;;; modify it under the terms of the GNU Affero General Public License
|
|
|
|
;;; as published by the Free Software Foundation, either version 3 of
|
|
|
|
;;; the License, or (at your option) any later version.
|
|
|
|
;;;
|
|
|
|
;;; This program is distributed in the hope that it will be useful,
|
|
|
|
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
|
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
|
;;; Affero General Public License for more details.
|
|
|
|
;;;
|
|
|
|
;;; You should have received a copy of the GNU Affero General Public
|
|
|
|
;;; License along with this program. If not, see
|
|
|
|
;;; <http://www.gnu.org/licenses/>.
|
|
|
|
|
2019-05-05 21:06:28 +02:00
|
|
|
(define-module (guix-data-service model git-branch)
|
2019-06-14 00:14:04 +02:00
|
|
|
#:use-module (ice-9 match)
|
2019-06-19 23:49:57 +02:00
|
|
|
#:use-module (json)
|
2019-05-05 21:06:28 +02:00
|
|
|
#:use-module (squee)
|
2019-05-11 17:49:18 +02:00
|
|
|
#:use-module (srfi srfi-19)
|
2019-05-18 13:35:17 +02:00
|
|
|
#:use-module (guix-data-service model utils)
|
2019-05-05 21:06:28 +02:00
|
|
|
#:export (insert-git-branch-entry
|
|
|
|
git-branches-for-commit
|
2019-05-18 13:35:17 +02:00
|
|
|
git-branches-with-repository-details-for-commit
|
2019-05-11 17:49:18 +02:00
|
|
|
most-recent-commits-for-branch
|
2019-06-14 00:14:04 +02:00
|
|
|
latest-processed-commit-for-branch
|
2019-05-05 21:06:28 +02:00
|
|
|
all-branches-with-most-recent-commit))
|
|
|
|
|
|
|
|
(define (insert-git-branch-entry conn
|
|
|
|
name commit
|
|
|
|
git-repository-id datetime)
|
|
|
|
(exec-query
|
|
|
|
conn
|
|
|
|
(string-append
|
|
|
|
"INSERT INTO git_branches (name, commit, git_repository_id, datetime) "
|
2019-05-16 01:03:06 +02:00
|
|
|
"VALUES ($1, $2, $3, to_timestamp($4)) "
|
2019-05-05 21:06:28 +02:00
|
|
|
"ON CONFLICT DO NOTHING")
|
|
|
|
(list name
|
|
|
|
commit
|
2019-09-04 19:24:22 +02:00
|
|
|
(number->string git-repository-id)
|
2019-05-16 01:03:06 +02:00
|
|
|
(date->string datetime "~s"))))
|
2019-05-05 21:06:28 +02:00
|
|
|
|
|
|
|
(define (git-branches-for-commit conn commit)
|
|
|
|
(define query
|
|
|
|
"
|
|
|
|
SELECT name, datetime FROM git_branches WHERE commit = $1
|
|
|
|
ORDER BY datetime DESC")
|
|
|
|
|
|
|
|
(exec-query conn query (list commit)))
|
|
|
|
|
2019-05-18 13:35:17 +02:00
|
|
|
(define (git-branches-with-repository-details-for-commit conn commit)
|
|
|
|
(define query
|
|
|
|
"
|
2019-07-19 22:29:56 +02:00
|
|
|
SELECT git_repositories.id, git_repositories.label,
|
|
|
|
git_repositories.url, git_repositories.cgit_url_base,
|
2019-05-18 13:35:17 +02:00
|
|
|
git_branches.name, git_branches.datetime
|
|
|
|
FROM git_branches
|
|
|
|
INNER JOIN git_repositories
|
|
|
|
ON git_branches.git_repository_id = git_repositories.id
|
|
|
|
WHERE git_branches.commit = $1")
|
|
|
|
|
|
|
|
(group-list-by-first-n-fields
|
2019-07-19 22:29:56 +02:00
|
|
|
4
|
2019-05-18 13:35:17 +02:00
|
|
|
(exec-query conn query (list commit))))
|
|
|
|
|
2019-07-19 22:22:15 +02:00
|
|
|
(define* (most-recent-commits-for-branch conn git-repository-id
|
|
|
|
branch-name
|
2019-05-11 17:49:18 +02:00
|
|
|
#:key
|
|
|
|
(limit 100)
|
|
|
|
after-date
|
|
|
|
before-date)
|
2019-05-05 21:06:28 +02:00
|
|
|
(define query
|
|
|
|
(string-append
|
|
|
|
"SELECT git_branches.commit, datetime, "
|
2019-06-19 23:49:57 +02:00
|
|
|
"(guix_revisions.id IS NOT NULL) as guix_revision_exists, "
|
|
|
|
"(
|
|
|
|
SELECT json_agg(event)
|
|
|
|
FROM load_new_guix_revision_job_events
|
|
|
|
INNER JOIN load_new_guix_revision_jobs ON
|
|
|
|
load_new_guix_revision_jobs.id = load_new_guix_revision_job_events.job_id
|
|
|
|
WHERE load_new_guix_revision_jobs.commit = git_branches.commit AND
|
|
|
|
git_branches.git_repository_id = load_new_guix_revision_jobs.git_repository_id
|
|
|
|
) AS job_events "
|
2019-05-05 21:06:28 +02:00
|
|
|
"FROM git_branches "
|
|
|
|
"LEFT OUTER JOIN guix_revisions ON git_branches.commit = guix_revisions.commit "
|
2019-07-19 22:22:15 +02:00
|
|
|
"WHERE name = $1 AND git_branches.git_repository_id = $2"
|
2019-05-11 17:49:18 +02:00
|
|
|
(if after-date
|
|
|
|
(simple-format #f " AND datetime > '~A'"
|
|
|
|
(date->string after-date "~1 ~3"))
|
|
|
|
"")
|
|
|
|
(if before-date
|
|
|
|
(simple-format #f " AND datetime < '~A'"
|
|
|
|
(date->string before-date "~1 ~3"))
|
|
|
|
"")
|
|
|
|
"ORDER BY datetime DESC"
|
|
|
|
(if limit
|
|
|
|
(simple-format #f " LIMIT ~A;" limit)
|
|
|
|
"")))
|
2019-05-05 21:06:28 +02:00
|
|
|
|
2019-06-19 23:49:57 +02:00
|
|
|
(map
|
|
|
|
(match-lambda
|
|
|
|
((commit datetime guix_revision_exists job_events)
|
|
|
|
(list commit
|
|
|
|
datetime
|
|
|
|
(string=? guix_revision_exists "t")
|
|
|
|
(if (string=? job_events "")
|
|
|
|
'()
|
|
|
|
(vector->list (json-string->scm job_events))))))
|
|
|
|
(exec-query
|
|
|
|
conn
|
|
|
|
query
|
2019-09-04 19:24:22 +02:00
|
|
|
(list branch-name
|
|
|
|
(number->string git-repository-id)))))
|
2019-05-05 21:06:28 +02:00
|
|
|
|
2019-07-27 10:12:25 +02:00
|
|
|
(define* (latest-processed-commit-for-branch conn repository-id branch-name)
|
2019-06-14 00:14:04 +02:00
|
|
|
(define query
|
|
|
|
(string-append
|
|
|
|
"SELECT git_branches.commit "
|
|
|
|
"FROM git_branches "
|
|
|
|
"INNER JOIN guix_revisions ON git_branches.commit = guix_revisions.commit "
|
2019-07-27 10:12:25 +02:00
|
|
|
"WHERE guix_revisions.git_repository_id = $1 AND "
|
|
|
|
"git_branches.git_repository_id = $1 AND git_branches.name = $2 "
|
2019-06-14 00:14:04 +02:00
|
|
|
"ORDER BY datetime DESC "
|
|
|
|
"LIMIT 1"))
|
|
|
|
|
|
|
|
(match (exec-query
|
|
|
|
conn
|
|
|
|
query
|
2019-07-27 10:12:25 +02:00
|
|
|
(list repository-id branch-name))
|
2019-06-14 00:14:04 +02:00
|
|
|
(((commit-hash))
|
|
|
|
commit-hash)
|
|
|
|
('()
|
|
|
|
#f)))
|
|
|
|
|
2019-07-19 22:22:15 +02:00
|
|
|
(define (all-branches-with-most-recent-commit conn git-repository-id)
|
2019-05-05 21:06:28 +02:00
|
|
|
(define query
|
|
|
|
(string-append
|
2019-06-19 23:49:57 +02:00
|
|
|
"
|
|
|
|
SELECT DISTINCT ON (name)
|
|
|
|
name, git_branches.commit,
|
|
|
|
datetime, (guix_revisions.id IS NOT NULL) guix_revision_exists,
|
|
|
|
(
|
|
|
|
SELECT json_agg(event)
|
|
|
|
FROM load_new_guix_revision_job_events
|
|
|
|
INNER JOIN load_new_guix_revision_jobs ON
|
|
|
|
load_new_guix_revision_jobs.id = load_new_guix_revision_job_events.job_id
|
|
|
|
WHERE load_new_guix_revision_jobs.commit = git_branches.commit AND
|
|
|
|
git_branches.git_repository_id = load_new_guix_revision_jobs.git_repository_id
|
|
|
|
) AS job_events
|
|
|
|
FROM git_branches
|
|
|
|
LEFT OUTER JOIN guix_revisions ON git_branches.commit = guix_revisions.commit
|
2019-09-29 18:12:20 +02:00
|
|
|
WHERE git_branches.git_repository_id = $1
|
2019-07-19 22:22:15 +02:00
|
|
|
ORDER BY name, datetime DESC"))
|
2019-05-05 21:06:28 +02:00
|
|
|
|
2019-06-19 23:49:57 +02:00
|
|
|
(map
|
|
|
|
(match-lambda
|
|
|
|
((name commit datetime guix_revision_exists job_events)
|
|
|
|
(list name
|
|
|
|
commit
|
|
|
|
datetime
|
|
|
|
(string=? guix_revision_exists "t")
|
|
|
|
(if (string=? job_events "")
|
|
|
|
'()
|
|
|
|
(vector->list (json-string->scm job_events))))))
|
|
|
|
(exec-query
|
|
|
|
conn
|
2019-07-19 22:22:15 +02:00
|
|
|
query
|
2019-09-04 19:24:22 +02:00
|
|
|
(list (number->string git-repository-id)))))
|
2019-05-05 21:06:28 +02:00
|
|
|
|