blob: 8bb20da43d2e0250968d651b1ffaddcea5284565 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
|
;;; 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/>.
(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
git-repository-id-and-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)
(match (exec-query
conn
"SELECT COUNT(*) FROM guix_revisions")
(((x)) (string->number x))))
(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 (git-repository-id-and-commit->revision-id conn git-repository-id commit)
(match (exec-query
conn
"
SELECT id
FROM guix_revisions
WHERE commit = $1
AND git_repository_id = $2"
(list commit git-repository-id))
(((id))
id)
(() #f)))
(define (insert-guix-revision conn git-repository-id commit)
(define insert
"
INSERT INTO guix_revisions (git_repository_id, commit)
VALUES ($1, $2) RETURNING id")
(match (exec-query conn insert (list git-repository-id commit))
(((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.git_repository_id,
git_commits.datetime
FROM guix_revisions
INNER JOIN git_branches
ON git_branches.git_repository_id = guix_revisions.git_repository_id
AND git_branches.name = $1
INNER JOIN git_commits
ON git_commits.commit = guix_revisions.commit
AND git_commits.git_branch_id = git_branches.id
AND git_commits.datetime <= $2
INNER JOIN load_new_guix_revision_jobs
ON load_new_guix_revision_jobs.commit = guix_revisions.commit
WHERE load_new_guix_revision_jobs.succeeded_at IS NOT NULL
ORDER BY git_commits.datetime DESC
LIMIT 1")
(match (exec-query conn query
(list branch
(date->string datetime "~1 ~3")))
(() #f)
((result) result)))
(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)
",")))))
|